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 !~ /(tex|dvi)$/);
  91   ($l, $to) = getNext($l);
  92   return undef if ($to !~ /^((dvi3?|pdf[23456]?)(log)?)$/);
  93   my ($checkfor, $substitute);
  94   if ($from =~ /tex/) {
  95     $checkfor = qr/\s+\-shell\-(escape|restricted)/;
  96     $substitute = "-shell-escape";
  97   }
  98   else {
  99     $checkfor = qr/\s+-i\s+dvipdfmx-unsafe.cfg/;
 100     $substitute = "-i dvipdfmx-unsafe.cfg";
 101   }
 102   ($l, $cmd) = getNext($l);
 103   if ($add) {
 104     if ($cmd !~ $checkfor) {
 105       if ($cmd =~ /^(\S+)\s*(.*)$/) {
 106         $cmd = "$1 $substitute $2";
 107         $cmd =~ s/\s+$//;
 108       }
 109     }
 110   }
 111   else {
 112     $cmd =~ s/$checkfor//;
 113   }
 114   ($l, $par) = getNext($l);
 115   return undef if ($par !~ /^(latex|hyperref-driver=dvipdfm)/);
 116   my $key = "\"$from\" \"$to\"";
 117   if ($add) {
 118     return([$key, [$cmd, $par]]);
 119   }
 120   else {
 121     # Removes entry from prefs
 122     return([$key, [$cmd, $par, 1]]);
 123   }
 124 }
 125
 126 sub getNext($)
 127 {
 128   my ($l) = @_;
 129   my $val = undef;
 130
 131   if ($l =~ /^\s*\"([^\"]*)\"\s*(.*)$/) {
 132     $val = $1;
 133     $l = $2;
 134   }
 135   elsif ($l =~ /^\s*(\S+)\s*(.*)$/) {
 136     $val = $1;
 137     $l = $2;
 138   }
 139   else {
 140     exit(7);
 141   }
 142   return($l, $val);
 143 }
 144
 145 sub writeConverters($$)
 146 {
 147   my ($fo, $rConverter) = @_;
 148   for my $key (sort keys %{$rConverter}) {
 149     if (! defined($rConverter->{$key}->[2])) {
 150       $rConverter->{$key}->[2] = 1;
 151       my $l = &createConvLine($key, $rConverter);
 152       print $fo $l;
 153     }
 154   }
 155 }
 156
 157 sub createConvLine($$)
 158 {
 159   my ($key, $rConverter) = @_;
 160   my $l = "\\converter $key \"$rConverter->{$key}->[0]\" \"$rConverter->{$key}->[1]\"\n";
 161   return($l);
 162 }
 163
 164 sub applyChanges($$$$)
 165 {
 166   my ($userdir, $rSubst, $rConverter, $add) = @_;
 167
 168   if (open(FO, '>', "$userdir/preferences.tmp")) {
 169     if (open(FI, "$userdir/preferences")) {
 170       my $conv_section = -1;
 171       while (my $l = <FI>) {
 172         if ($conv_section-- == 0) {
 173           &writeConverters(*FO, $rConverter);
 174         }
 175         if ($l =~ /^\# CONVERTERS SECTION/) {
 176           $conv_section = 2;    # converters begin 2 lines later
 177         }
 178         if ($l =~ /^\\converter\s+(.*)$/) {
 179           my $entry = &getConverter($1, $add);
 180           if (defined($entry)) {
 181             my $key = $entry->[0];
 182             if (defined($rConverter->{$key})) {
 183               if (defined($rConverter->{$key}->[2])) {
 184                 $l = "";
 185               }
 186               else {
 187                 $rConverter->{$key}->[2] = 1;
 188                 $l = &createConvLine($key, $rConverter);
 189               }
 190             }
 191             else {
 192               # Converter defined only in preferences
 193               $rConverter->{$key} = $entry->[1];
 194               $rConverter->{$key}->[2] = 1;
 195               $l = &createConvLine($key, $rConverter);
 196             }
 197           }
 198         }
 199         else {
 200           for my $k (keys %{$rSubst}) {
 201             if ($l =~ /^\\$k\b/) {
 202               $l = "\\$k $rSubst->{$k}->[0]\n";
 203               $rSubst->{$k}->[1] = 1;
 204             }
 205           }
 206         }
 207         print FO $l;
 208       }
 209       close(FI);
 210     }
 211     for my $k (keys %{$rSubst}) {
 212       if ($rSubst->{$k}->[1] == 0) {
 213         print FO "\\$k $rSubst->{$k}->[0]\n";
 214       }
 215     }
 216     &writeConverters(*FO, $rConverter);
 217     close(FO);
 218     rename("$userdir/preferences.tmp", "$userdir/preferences");
 219   }
 220 }
 221
 222 return 1;