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           for my $val (@{$rAllowedKeys->{$key}}) {
  35             if ($val eq $value) {
  36               $valid = 1;
  37               last;
  38             }
  39           }
  40         }
  41         if ($valid) {
  42           $rSubst->{$key} = [$value, 0];
  43         }
  44         else {
  45           die("invalid key or value specified in \"$arg\"");
  46         }
  47       }
  48       else {
  49         $ctestparams = 1;
  50         push(@ctestpars, $arg);
  51       }
  52     }
  53   }
  54   return(@ctestpars);
  55 }
  56
  57 sub getConverters($$$)
  58 {
  59   my ($userdir, $rConverter, $add) = @_;
  60
  61   if (open(FI, "$userdir/lyxrc.defaults")) {
  62     while (my $l = <FI>) {
  63       if ($l =~ s/^\s*\\converter\s+//) {
  64         my $entry = &getConverter($l, $add);
  65         if (defined($entry)) {
  66           $rConverter->{$entry->[0]} = $entry->[1];
  67         }
  68       }
  69     }
  70     close(FI);
  71   }
  72 }
  73
  74 sub getConverter($$)
  75 {
  76   my ($l, $add) = @_;
  77   chomp($l);
  78   my ($from, $to, $cmd, $par);
  79   ($l, $from) = getNext($l);
  80   return undef if ($from !~ /tex$/);
  81   ($l, $to) = getNext($l);
  82   return undef if ($to !~ /^((dvi3?|pdf[23456]?)(log)?)$/);
  83   ($l, $cmd) = getNext($l);
  84   if ($add) {
  85     if ($cmd !~ /\-shell-escape/) {
  86       if ($cmd =~ /^(\S+)\s*(.*)$/) {
  87         $cmd = "$1 -shell-escape $2";
  88         $cmd =~ s/\s+$//;
  89       }
  90     }
  91   }
  92   else {
  93     $cmd =~ s/\s+\-shell\-escape//;
  94   }
  95   ($l, $par) = getNext($l);
  96   return undef if ($par !~ /^latex/);
  97   my $key = "\"$from\" \"$to\"";
  98   if ($add) {
  99     return([$key, [$cmd, $par]]);
 100   }
 101   else {
 102     # Removes entry from prefs
 103     return([$key, [$cmd, $par, 1]]);
 104   }
 105 }
 106
 107 sub getNext($)
 108 {
 109   my ($l) = @_;
 110   my $val = undef;
 111
 112   if ($l =~ /^\s*\"([^\"]*)\"\s*(.*)$/) {
 113     $val = $1;
 114     $l = $2;
 115   }
 116   elsif ($l =~ /^\s*(\S+)\s*(.*)$/) {
 117     $val = $1;
 118     $l = $2;
 119   }
 120   else {
 121     exit(7);
 122   }
 123   return($l, $val);
 124 }
 125
 126 sub writeConverters($$)
 127 {
 128   my ($fo, $rConverter) = @_;
 129   for my $key (sort keys %{$rConverter}) {
 130     if (! defined($rConverter->{$key}->[2])) {
 131       $rConverter->{$key}->[2] = 1;
 132       my $l = &createConvLine($key, $rConverter);
 133       print $fo $l;
 134     }
 135   }
 136 }
 137
 138 sub createConvLine($$)
 139 {
 140   my ($key, $rConverter) = @_;
 141   my $l = "\\converter $key \"$rConverter->{$key}->[0]\" \"$rConverter->{$key}->[1]\"\n";
 142   return($l);
 143 }
 144
 145 sub applyChanges($$$$)
 146 {
 147   my ($userdir, $rSubst, $rConverter, $add) = @_;
 148
 149   if (open(FO, '>', "$userdir/preferences.tmp")) {
 150     if (open(FI, "$userdir/preferences")) {
 151       my $conv_section = -1;
 152       while (my $l = <FI>) {
 153         if ($conv_section-- == 0) {
 154           &writeConverters(*FO, $rConverter);
 155         }
 156         if ($l =~ /^\# CONVERTERS SECTION/) {
 157           $conv_section = 2;    # converters begin 2 lines later
 158         }
 159         if ($l =~ /^\\converter\s+(.*)$/) {
 160           my $entry = &getConverter($1, $add);
 161           if (defined($entry)) {
 162             my $key = $entry->[0];
 163             if (defined($rConverter->{$key})) {
 164               if (defined($rConverter->{$key}->[2])) {
 165                 $l = "";
 166               }
 167               else {
 168                 $rConverter->{$key}->[2] = 1;
 169                 $l = &createConvLine($key, $rConverter);
 170               }
 171             }
 172             else {
 173               # Converter defined only in preferences
 174               $rConverter->{$key} = $entry->[1];
 175               $rConverter->{$key}->[2] = 1;
 176               $l = &createConvLine($key, $rConverter);
 177             }
 178           }
 179         }
 180         else {
 181           for my $k (keys %{$rSubst}) {
 182             if ($l =~ /^\\$k\b/) {
 183               $l = "\\$k $rSubst->{$k}->[0]\n";
 184               $rSubst->{$k}->[1] = 1;
 185             }
 186           }
 187         }
 188         print FO $l;
 189       }
 190       close(FI);
 191     }
 192     for my $k (keys %{$rSubst}) {
 193       if ($rSubst->{$k}->[1] == 0) {
 194         print FO "\\$k $rSubst->{$k}->[0]\n";
 195       }
 196     }
 197     &writeConverters(*FO, $rConverter);
 198     close(FO);
 199     rename("$userdir/preferences.tmp", "$userdir/preferences");
 200   }
 201 }
 202
 203 return 1;