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