lib/scripts/prefTest.pm

   1 # -*- mode: perl; -*-
   2 package prefTest;
   3
   4 our(@EXPORT, @ISA);
   5 BEGIN {
   6   use Exporter   ();
   7   @ISA        = qw(Exporter);
   8   @EXPORT     = qw(getSubstitutes getConverters applyChanges);
   9 }
  10
  11 sub getSubstitutes($$@);
  12 sub getConverters($$$);
  13 sub getConverter($$);
  14 sub getNext($);
  15 sub writeConverters($$);
  16 sub createConvLine($$);
  17
  18 sub getSubstitutes($$@)
  19 {
  20   my ($rAllowedKeys, $rSubst, @args) = @_;
  21
  22   my @ctestpars = ();
  23   my $ctestparams = 0;
  24   for my $arg (@args) {
  25     if ($ctestparams) {
  26       push(@ctestpars, $arg);
  27     }
  28     else {
  29       if ($arg =~ /^([^=]+)=(.*)$/) {
  30         my $key = $1;
  31         my $value = $2;
  32         my $valid = 0;
  33         if (defined($rAllowedKeys->{$key})) {
  34           if (ref($rAllowedKeys->{$key}) eq "ARRAY") {
  35             for my $val (@{$rAllowedKeys->{$key}}) {
  36               if ($val eq $value) {
  37                 $valid = 1;
  38                 last;
  39               }
  40             }
  41           }
  42           elsif ($rAllowedKeys->{$key} eq "integer") {
  43             if ($value =~ /^\d+$/) {
  44               $valid = 1;
  45             }
  46           }
  47           elsif ($rAllowedKeys->{$key} eq "string") {
  48             $valid = 1;
  49           }
  50         }
  51         if ($valid) {
  52           $rSubst->{$key} = [$value, 0];
  53         }
  54         else {
  55           die("invalid key or value specified in \"$arg\"");
  56         }
  57       }
  58       else {
  59         $ctestparams = 1;
  60         push(@ctestpars, $arg);
  61       }
  62     }
  63   }
  64   return(@ctestpars);
  65 }
  66
  67 sub getConverters($$$)
  68 {
  69   my ($userdir, $rConverter, $add) = @_;
  70
  71   if (open(FI, "$userdir/lyxrc.defaults")) {
  72     while (my $l = <FI>) {
  73       if ($l =~ s/^\s*\\converter\s+//) {
  74         my $entry = &getConverter($l, $add);
  75         if (defined($entry)) {
  76           $rConverter->{$entry->[0]} = $entry->[1];
  77         }
  78       }
  79     }
  80     close(FI);
  81   }
  82 }
  83
  84 sub getConverter($$)
  85 {
  86   my ($l, $add) = @_;
  87   chomp($l);
  88   my ($from, $to, $cmd, $par);
  89   ($l, $from) = getNext($l);
  90   return undef if ($from !~ /(ps|tex|dvi)$/);
  91   ($l, $to) = getNext($l);
  92   return undef if ($to !~ /^((dvi3?|pdf[23456]?)(log)?)$/);
  93   my ($checkfor, $substitute, $extrapar);
  94   if ($from =~ /tex/) {
  95     $checkfor = qr/\s+\-shell\-(escape|restricted)/;
  96     $substitute = "-shell-escape";
  97     $extrapar = qr/^latex/;
  98   }
  99   elsif ($from =~ /ps$/) {
 100     $checkfor = qr/\s+\-dALLOWPSTRANSPARENCY/;
 101     $substitute = "-dALLOWPSTRANSPARENCY";
 102     $extrapar = qr/hyperref-driver=dvips/;
 103   }
 104   else {
 105     $checkfor = qr/\s+-i\s+dvipdfmx-unsafe.cfg/;
 106     $substitute = "-i dvipdfmx-unsafe.cfg";
 107     $extrapar = qr/^hyperref-driver=dvipdfm/;
 108   }
 109   ($l, $cmd) = getNext($l);
 110   if ($add) {
 111     if ($cmd !~ $checkfor) {
 112       if ($cmd =~ /^(\S+)\s*(.*)$/) {
 113         $cmd = "$1 $substitute $2";
 114         $cmd =~ s/\s+$//;
 115       }
 116     }
 117   }
 118   else {
 119     $cmd =~ s/$checkfor//;
 120   }
 121   ($l, $par) = getNext($l);
 122   return undef if ($par !~ $extrapar);
 123   my $key = "\"$from\" \"$to\"";
 124   if ($add) {
 125     return([$key, [$cmd, $par]]);
 126   }
 127   else {
 128     # Removes entry from prefs
 129     return([$key, [$cmd, $par, 1]]);
 130   }
 131 }
 132
 133 sub getNext($)
 134 {
 135   my ($l) = @_;
 136   my $val = undef;
 137
 138   if ($l =~ /^\s*\"([^\"]*)\"\s*(.*)$/) {
 139     $val = $1;
 140     $l = $2;
 141   }
 142   elsif ($l =~ /^\s*(\S+)\s*(.*)$/) {
 143     $val = $1;
 144     $l = $2;
 145   }
 146   else {
 147     exit(7);
 148   }
 149   return($l, $val);
 150 }
 151
 152 sub writeConverters($$)
 153 {
 154   my ($fo, $rConverter) = @_;
 155   for my $key (sort keys %{$rConverter}) {
 156     if (! defined($rConverter->{$key}->[2])) {
 157       $rConverter->{$key}->[2] = 1;
 158       my $l = &createConvLine($key, $rConverter);
 159       print $fo $l;
 160     }
 161   }
 162 }
 163
 164 sub createConvLine($$)
 165 {
 166   my ($key, $rConverter) = @_;
 167   my $l = "\\converter $key \"$rConverter->{$key}->[0]\" \"$rConverter->{$key}->[1]\"\n";
 168   return($l);
 169 }
 170
 171 sub applyChanges($$$$)
 172 {
 173   my ($userdir, $rSubst, $rConverter, $add) = @_;
 174
 175   if (open(FO, '>', "$userdir/preferences.tmp")) {
 176     if (open(FI, "$userdir/preferences")) {
 177       my $conv_section = -1;
 178       while (my $l = <FI>) {
 179         if ($conv_section-- == 0) {
 180           &writeConverters(*FO, $rConverter);
 181         }
 182         if ($l =~ /^\# CONVERTERS SECTION/) {
 183           $conv_section = 2;    # converters begin 2 lines later
 184         }
 185         if ($l =~ /^\\converter\s+(.*)$/) {
 186           my $entry = &getConverter($1, $add);
 187           if (defined($entry)) {
 188             my $key = $entry->[0];
 189             if (defined($rConverter->{$key})) {
 190               if (defined($rConverter->{$key}->[2])) {
 191                 $l = "";
 192               }
 193               else {
 194                 $rConverter->{$key}->[2] = 1;
 195                 $l = &createConvLine($key, $rConverter);
 196               }
 197             }
 198             else {
 199               # Converter defined only in preferences
 200               $rConverter->{$key} = $entry->[1];
 201               $rConverter->{$key}->[2] = 1;
 202               $l = &createConvLine($key, $rConverter);
 203             }
 204           }
 205         }
 206         else {
 207           for my $k (keys %{$rSubst}) {
 208             if ($l =~ /^\\$k\b/) {
 209               $l = "\\$k $rSubst->{$k}->[0]\n";
 210               $rSubst->{$k}->[1] = 1;
 211             }
 212           }
 213         }
 214         print FO $l;
 215       }
 216       close(FI);
 217     }
 218     for my $k (keys %{$rSubst}) {
 219       if ($rSubst->{$k}->[1] == 0) {
 220         print FO "\\$k $rSubst->{$k}->[0]\n";
 221       }
 222     }
 223     &writeConverters(*FO, $rConverter);
 224     close(FO);
 225     rename("$userdir/preferences.tmp", "$userdir/preferences");
 226   }
 227 }
 228
 229 return 1;