lib/scripts/prefTest.pl.in

   1 #! /usr/bin/env perl
   2 # -*- mode: perl; -*-
   3
   4 use strict;
   5 use warnings;
   6
   7 # Syntax: prefTest.pl [<var1>=<Subst1> [<var2>=<Subst> ...]] [[ctest parameters]]
   8
   9 my $bindir = "@CMAKE_BINARY_DIR@";
  10
  11 my $userdir = "$bindir/Testing/.lyx";
  12
  13 sub createConvLine($);
  14 sub getConverters($);
  15 sub getConverter($);
  16 sub getNext($);
  17
  18 my %allowedKeys = (
  19   "use_converter_needauth_forbidden" => ["true", "false"],
  20   "use_converter_needauth" => ["true", "false"],
  21   "allow_geometry_session" => ["false"],
  22     );
  23
  24 my %Converter = ();
  25
  26 chdir($bindir);
  27
  28 # Parse Arguments for strings to substitute
  29
  30 my %Subst = ();
  31
  32 my $ctestparams = 0;
  33 my @ctestpars = ();
  34
  35 &getConverters($userdir);
  36
  37 for my $arg ("allow_geometry_session=false", @ARGV) {
  38   if ($ctestparams) {
  39     push(@ctestpars, $arg);
  40   }
  41   else {
  42     if ($arg =~ /^([^=]+)=(.*)$/) {
  43       my $key = $1;
  44       my $value = $2;
  45       my $valid = 0;
  46       if (defined($allowedKeys{$key})) {
  47         for my $val (@{$allowedKeys{$key}}) {
  48           if ($val eq $value) {
  49             $valid = 1;
  50             last;
  51           }
  52         }
  53       }
  54       if ($valid) {
  55         $Subst{$key} = [$value, 0];
  56       }
  57       else {
  58         die("invalid key or value specified in \"$arg\"");
  59       }
  60     }
  61     else {
  62       $ctestparams = 1;
  63       push(@ctestpars, $arg);
  64     }
  65   }
  66 }
  67
  68 if (%Subst) { # Try to do something only if a substitute is requested
  69   if (open(FO, '>', "$userdir/preferences.tmp")) {
  70     if (open(FI, "$userdir/preferences")) {
  71       while (my $l = <FI>) {
  72         for my $k (keys %Subst) {
  73           if ($l =~ /^\\$k\b/) {
  74             $l = "\\$k $Subst{$k}->[0]\n";
  75             $Subst{$k}->[1] = 1;
  76           }
  77           elsif ($l =~ /^\\converter\s+(.*)$/) {
  78             my $entry = &getConverter($1);
  79             if (defined($entry)) {
  80               my $key = $entry->[0];
  81               if (defined($Converter{$key})) {
  82                 if (defined($Converter{$key}->[2])) {
  83                   $l = "";
  84                 }
  85                 else {
  86                   $Converter{$key}->[2] = 1;
  87                   $l = &createConvLine($key);
  88                 }
  89               }
  90             }
  91           }
  92         }
  93         print FO $l;
  94       }
  95     }
  96     for my $k (keys %Subst) {
  97       if ($Subst{$k}->[1] == 0) {
  98         print FO "\\$k $Subst{$k}->[0]\n";
  99       }
 100     }
 101     for my $key (keys %Converter) {
 102       if (! defined($Converter{$key}->[2])) {
 103         $Converter{$key}->[2] = 1;
 104         my $l = &createConvLine($key);
 105         print FO $l;
 106       }
 107     }
 108     rename("$userdir/preferences.tmp", "$userdir/preferences");
 109   }
 110 }
 111
 112 my $res = 0;
 113 if (@ctestpars) {
 114   $res = system("ctest", @ctestpars);
 115 }
 116
 117 exit($res);
 118
 119 sub createConvLine($)
 120 {
 121   my ($key) = @_;
 122   my $l = "\\converter $key \"$Converter{$key}->[0]\" \"$Converter{$key}->[1]\"\n";
 123   return($l);
 124 }
 125
 126 sub getConverters($)
 127 {
 128   my ($userdir) = @_;
 129
 130   if (open(FI, "$userdir/lyxrc.defaults")) {
 131     while (my $l = <FI>) {
 132       if ($l =~ s/^\s*\\converter\s+//) {
 133         my $entry = &getConverter($l);
 134         if (defined($entry)) {
 135           $Converter{$entry->[0]} = $entry->[1];
 136         }
 137       }
 138     }
 139   }
 140 }
 141
 142 sub getConverter($)
 143 {
 144   my ($l) = @_;
 145   chomp($l);
 146   my ($from, $to, $cmd, $par);
 147   ($l, $from) = getNext($l);
 148   return undef if ($from !~ /tex$/);
 149   ($l, $to) = getNext($l);
 150   return undef if ($to !~ /^(dvi|dvi3|pdf|pdf[23456])$/);
 151   ($l, $cmd) = getNext($l);
 152   if ($cmd !~ /\-shell-escape/) {
 153     if ($cmd =~ /^(\S+)\s*(.*)$/) {
 154       $cmd = "$1 -shell-escape $2";
 155       $cmd =~ s/\s+$//;
 156     }
 157   }
 158   ($l, $par) = getNext($l);
 159   return undef if ($par !~ /^latex/);
 160   my $key = "\"$from\" \"$to\"";
 161   return([$key, [$cmd, $par]]);
 162 }
 163
 164 sub getNext($)
 165 {
 166   my ($l) = @_;
 167   my $val = undef;
 168
 169   if ($l =~ /^\s*\"([^\"]*)\"\s*(.*)$/) {
 170     $val = $1;
 171     $l = $2;
 172   }
 173   elsif ($l =~ /^\s*(\S+)\s*(.*)$/) {
 174     $val = $1;
 175     $l = $2;
 176   }
 177   else {
 178     exit(7);
 179   }
 180   return($l, $val);
 181 }