development/autotests/lyxStatus.pm

   1 #! /usr/bin/env perl
   2 # -*- mode: perl; -*-
   3
   4 package lyxStatus;
   5
   6 use strict;
   7
   8 our(@EXPORT, @ISA);
   9
  10 BEGIN {
  11   use Exporter   ();
  12   @ISA       = qw(Exporter);
  13   @EXPORT    = qw(initLyxStack checkLyxLine closeLyxStack diestack);
  14 }
  15
  16 # Prototypes
  17 sub initLyxStack($$$);
  18 sub diestack($);
  19 sub closeLyxStack();
  20 sub setMatching($);
  21 sub getMatching();
  22 sub checkForEndBlock($);
  23 sub newMatch(%);
  24 sub getSearch($);
  25 sub getFileType($);
  26 sub getFileIdx($);
  27 sub getExt($);
  28 sub getResult($);
  29 sub checkForHeader($$);
  30 sub checkForPreamble($);
  31 sub checkForLayoutStart($);
  32 sub checkForInsetStart($);
  33 sub checkForLatexCommand($);
  34 sub checkLyxLine($$);
  35
  36 my @stack = ();                 # list of HASH-Arrays
  37 my $rFont = {};
  38 my $useNonTexFont = "true";
  39 my $inputEncoding = undef;
  40 my $sysdir = undef;
  41
  42 # The elements are:
  43 # type (layout, inset, header, preamble, ...)
  44 # name
  45 # matching list of matching spes
  46 #      search: regular expression
  47 #      ext: list of extensions needed for the full path of the file spec
  48 #      filetype: one of prefix_only,replace_only,copy_only,prefix_for_list,interpret
  49 #      fileidx: index into the resulting array, defining the filename
  50 #      result: conatenation of the elements should reflect the parsed line
  51 #              but first set the modified value into $result->[$fileidx]
  52 #              numerical value will be replaced with appropriate matching group value
  53
  54 sub initLyxStack($$$)
  55 {
  56   use Cwd 'abs_path';
  57
  58   $rFont = $_[0];
  59   if ($_[1] eq "systemF") {
  60     $useNonTexFont = "true";
  61   }
  62   elsif ($_[1] eq "dontChange") {
  63     $useNonTexFont = "dontChange";
  64   }
  65   else {
  66     $useNonTexFont = "false";
  67     $inputEncoding = $_[2];
  68   }
  69   $stack[0] = { type => "Starting"};
  70   my $p = abs_path( __FILE__ );
  71   $p =~ s/\/development\/autotests\/.*$/\/lib/;
  72   # Save the value to be used as replacement for systemlyxdir in \origin statements
  73   $sysdir = $p;
  74   # print "Sysdir set to $sysdir\n";
  75 }
  76
  77 sub diestack($)
  78 {
  79   my ($msg) = @_;
  80   # Print stack
  81   print "Called stack\n";
  82   my @call_stack = ();
  83   for my $depth ( 0 .. 100) {
  84     #my ($pkg, $file, $line, $subname, $hasargs, $wantarray) = caller($depth)
  85     my @stack = caller($depth);
  86     last if ($stack[0] ne "main");
  87     push(@call_stack, \@stack);
  88   }
  89   for my $depth ( 0 .. 100) {
  90     last if (! defined($call_stack[$depth]));
  91     my $subname = $call_stack[$depth]->[3];
  92     my $line = $call_stack[$depth]->[2];
  93     print "($depth) $subname()";
  94     if ($depth > 0) {
  95       my $oldline = $call_stack[$depth-1]->[2];
  96       print ":$oldline";
  97     }
  98     print " called from ";
  99     if (defined($call_stack[$depth+1])) {
 100       my $parent = $call_stack[$depth+1]->[3];
 101       print "$parent():$line\n";
 102     }
 103     else {
 104       my $file = $call_stack[$depth]->[1];
 105       print "\"$file\":$line\n";
 106     }
 107   }
 108   die($msg);
 109 }
 110
 111 sub closeLyxStack()
 112 {
 113   diestack("Stack not OK") if ($stack[0]->{type} ne "Starting");
 114 }
 115
 116 sub setMatching($)
 117 {
 118   my ($match) = @_;
 119
 120   $stack[0]->{"matching"} = $match;
 121 }
 122
 123 sub getMatching()
 124 {
 125   return($stack[0]->{"matching"});
 126 }
 127
 128 ###########################################################
 129 #
 130 sub checkForEndBlock($)
 131 {
 132   my ($l) = @_;
 133
 134   for my $et ( qw( layout inset preamble header)) {
 135     if ($l =~ /^\\end_$et$/) {
 136       diestack("Not in $et") if ($stack[0]->{type} ne "$et");
 137       #print "End $et\n";
 138       shift(@stack);
 139       return(1);
 140     }
 141   }
 142   return(0);
 143 }
 144
 145 sub newMatch(%)
 146 {
 147   my %elem = @_;
 148
 149   if (! defined($elem{"ext"})) {
 150     $elem{"ext"} = "";
 151   }
 152   if (! defined($elem{"filetype"})) {
 153     $elem{"filetype"} = "prefix_only";
 154   }
 155   if (! defined($elem{"fileidx"})) {
 156     $elem{"fileidx"} = 1;
 157   }
 158   if (exists($elem{"search"})) {
 159     my $ref = ref($elem{"search"});
 160     diestack("Wrong or invalid regex (ref == $ref) specified") if ($ref ne "Regexp");
 161   }
 162   else {
 163     diestack("No search defined");
 164   }
 165   diestack("No result defined") if (! defined($elem{"result"}));
 166   return(\%elem);
 167 }
 168
 169 sub getSearch($)
 170 {
 171   my ($m) = @_;
 172
 173   return($m->{"search"});
 174 }
 175
 176 sub getFileType($)
 177 {
 178   my ($m) = @_;
 179
 180   return($m->{"filetype"});
 181 }
 182
 183 sub getFileIdx($)
 184 {
 185   my ($m) = @_;
 186
 187   return($m->{"fileidx"});
 188 }
 189
 190 sub getExt($)
 191 {
 192   my ($m) = @_;
 193
 194   return($m->{"ext"});
 195 }
 196
 197 sub getResult($)
 198 {
 199   my ($m) = @_;
 200
 201   return($m->{"result"});
 202 }
 203
 204 sub checkForHeader($$)
 205 {
 206   my ($l, $sourcedir) = @_;
 207
 208   if ($l =~ /^\\begin_header\s*$/) {
 209     my %selem = ();
 210     $selem{type} = "header";
 211     $selem{name} = $1;
 212     unshift(@stack, \%selem);
 213     my @rElems = ();
 214     $rElems[0] = newMatch("search" => qr/^\\master\s+(.*\.lyx)/,
 215                            "filetype" => "prefix_only",
 216                            "result" => ["\\master ", ""]);
 217     if (keys %{$rFont}) {
 218       for my $ff ( keys %{$rFont}) {
 219         # fontentry of type '\font_roman default'
 220         my $elem = newMatch("search" => qr/^\\font_$ff\s+[^\"]*\s*$/,
 221                              "filetype" => "replace_only",
 222                              "result" => ["\\font_$ff ", $rFont->{$ff}]);
 223         # fontentry of type '\font_roman "default"'
 224         my $elem1 = newMatch("search" => qr/^\\font_$ff\s+\"[^\"]*\"\s*$/,
 225                              "filetype" => "replace_only",
 226                              "result" => ["\\font_$ff \"", $rFont->{$ff}, '"']);
 227         # fontentry of type '\font_roman "default" "default"'
 228         my $elem2 = newMatch("search" => qr/^\\font_$ff\s+\"(.*)\"\s+\"default\"\s*$/,
 229                              "filetype" => "replace_only",
 230                              "result" => ["\\font_$ff ", '"', "1", '" "', $rFont->{$ff}, '"']);
 231         push(@rElems, $elem, $elem1, $elem2);
 232       }
 233     }
 234     if ($useNonTexFont ne "dontChange") {
 235       my $elemntf = newMatch("search" => qr/^\\use_non_tex_fonts\s+(false|true)/,
 236                               "filetype" => "replace_only",
 237                               "result" => ["\\use_non_tex_fonts $useNonTexFont"]);
 238       push(@rElems, $elemntf);
 239     }
 240     if (defined($inputEncoding)) {
 241       my $inputenc = newMatch("search" =>  qr/^\\inputencoding\s+($inputEncoding->{search})/,
 242                               "filetype" => "replace_only",
 243                               "result" => ["\\inputencoding " . $inputEncoding->{out}]);
 244       push(@rElems, $inputenc);
 245     }
 246     my $origin = newMatch("search" => qr/^\\origin\s+(\/systemlyxdir)(.*)$/,
 247                           "filetype" => "replace_only",
 248                           "result" => ["\\origin $sysdir", "2"]);
 249     push(@rElems, $origin);
 250     my $originu = newMatch("search" => qr/^\\origin\s+unavailable/,
 251                           "filetype" => "replace_only",
 252                           "result" => ["\\origin $sourcedir"]);
 253     push(@rElems, $originu);
 254     setMatching(\@rElems);
 255     return(1);
 256   }
 257   return(0);
 258 }
 259
 260 sub checkForPreamble($)
 261 {
 262   my ($l) = @_;
 263
 264   if ($l =~ /^\\begin_preamble\s*$/) {
 265     my %selem = ();
 266     $selem{type} = "preamble";
 267     $selem{name} = $1;
 268     unshift(@stack, \%selem);
 269     my $rElem = newMatch("ext" => [".eps", ".png"],
 270                           "search" => qr/^\\(photo|ecvpicture)(.*\{)(.*)\}/,
 271                           "fileidx" => 3,
 272                           "result" => ["\\", "1", "2", "3", "}"]);
 273     #
 274     # Remove comments from preamble
 275     my $comments = newMatch("search" => qr/^([^%]*)([%]+)([^%]*)$/,
 276                             "filetype" => "replace_only",
 277                             "result" => ["1", "2"]);
 278     setMatching([$rElem, $comments]);
 279     return(1);
 280   }
 281   return(0);
 282 }
 283
 284 sub checkForLayoutStart($)
 285 {
 286   my ($l) = @_;
 287
 288   if ($l =~ /^\\begin_layout\s+(.*)$/) {
 289     #print "started layout\n";
 290     my %selem = ();
 291     $selem{type} = "layout";
 292     $selem{name} = $1;
 293     unshift(@stack, \%selem);
 294     if ($selem{name} =~ /^(Picture|Photo)$/ ) {
 295       my $rElem = newMatch("ext" => [".eps", ".png", ""],
 296                             "filetype" => "copy_only",
 297                             "search" => qr/^(.+)/,
 298                             "result" => ["", "", ""]);
 299       setMatching([$rElem]);
 300     }
 301     return(1);
 302   }
 303   return(0);
 304 }
 305
 306 sub checkForInsetStart($)
 307 {
 308   my ($l) = @_;
 309
 310   if ($l =~ /^\\begin_inset\s+(.*)$/) {
 311     #print "started inset\n";
 312     my %selem = ();
 313     $selem{type} = "inset";
 314     $selem{name} = $1;
 315     unshift(@stack, \%selem);
 316     if ($selem{name} =~ /^(Graphics|External)$/) {
 317       my $rElem = newMatch("search" => qr/^\s+filename\s+(.+)$/,
 318                             "filetype" => "copy_only",
 319                             "result" => ["\tfilename ", "", ""]);
 320       setMatching([$rElem]);
 321     }
 322     return(1);
 323   }
 324   return(0);
 325 }
 326
 327 sub checkForLatexCommand($)
 328 {
 329   my ($l) = @_;
 330
 331   if ($stack[0]->{type} eq "inset") {
 332     if ($l =~ /^LatexCommand\s+([^\s]+)\s*$/) {
 333       my $param = $1;
 334       if ($stack[0]->{name} =~ /^CommandInset\s+bibtex$/) {
 335         if ($param eq "bibtex") {
 336           my $rElem1 = newMatch("ext" => ".bib",
 337                                  "filetype" => "prefix_for_list",
 338                                  "search" => qr/^bibfiles\s+\"([^\"]+)\"/,
 339                                  "result" => ["bibfiles \"", "1", "\""]);
 340           my $rElem2 = newMatch("ext" => ".bst",
 341                                  "filetype" => "prefix_for_list",
 342                                  "search" => qr/^options\s+\"(.+)\"/,
 343                                  "result" => ["options \"", "1", "\""]);
 344           setMatching([$rElem1, $rElem2]);
 345         }
 346       }
 347       elsif ($stack[0]->{name} =~ /^CommandInset\s+include$/) {
 348         if ($param =~ /^(verbatiminput\*?|lstinputlisting|inputminted)$/) {
 349           my $rElem = newMatch("search" => qr/^filename\s+\"(.+)\"/,
 350                                 "filetype" => "copy_only",
 351                                 "result" => ["filename \"", "", "\""]);
 352           setMatching([$rElem]);
 353         }
 354         elsif ($param =~ /^(include|input)$/) {
 355           my $rElem = newMatch("search" => qr/^filename\s+\"(.+)\"/,
 356                                 "filetype" => "interpret",
 357                                 "result" => ["filename \"", "", "\""]);
 358           setMatching([$rElem]);
 359         }
 360       }
 361     }
 362   }
 363   return(0);
 364 }
 365
 366 #
 367 # parse the given line
 368 # returns a hash with folloving values
 369 #    found:  1 if line matched some regex
 370 #    fileidx: index into result
 371 #    ext: list of possible extensions to use for a valid file
 372 #    filelist: list of found file-pathes (may be more then one, e.g. in bibfiles spec)
 373 #    separator: to be used while concatenating the filenames
 374 #    filetype: prefix_only,replace_only,copy_only,interpret
 375 #              same as before, but without 'prefix_for_list'
 376 sub checkLyxLine($$)
 377 {
 378   my ($l, $sourcedir) = @_;
 379
 380   return({"found" => 0}) if (checkForHeader($l, $sourcedir));
 381   return({"found" => 0}) if (checkForPreamble($l));
 382   return({"found" => 0}) if (checkForEndBlock($l));
 383   return({"found" => 0}) if (checkForLayoutStart($l));
 384   return({"found" => 0}) if (checkForInsetStart($l));
 385   return({"found" => 0}) if (checkForLatexCommand($l));
 386   if (defined($stack[0])) {
 387     my $rMatch = getMatching();
 388     for my $m ( @{$rMatch}) {
 389       my $search = getSearch($m);
 390       if ($l =~ $search) {
 391         my @matches = ($1, $2, $3, $4);
 392         my $filetype = getFileType($m);
 393         my @result2 = @{getResult($m)};
 394
 395         for my $r (@result2) {
 396           if ($r =~ /^\d$/) {
 397             $r = $matches[$r-1];
 398           }
 399         }
 400         if ($filetype eq "replace_only") {
 401           # No filename needed
 402           my %result = ("found" => 1,
 403                         "filetype" => $filetype,
 404                         "result" => \@result2);
 405           return(\%result);
 406         }
 407         else {
 408           my $fileidx = getFileIdx($m);
 409           my $filename = $matches[$fileidx-1];
 410           if ($filename !~ /^\.*$/) {
 411             my %result = ("found" => 1,
 412                           "fileidx" => $fileidx,
 413                           "ext" => getExt($m),
 414                           "result" => \@result2);
 415             if ($filetype eq "prefix_for_list") {
 416               # bibfiles|options in CommandInset bibtex
 417               my @filenames = split(',', $filename);
 418               $result{"separator"} = ",";
 419               $result{"filelist"} = \@filenames;
 420               $result{"filetype"} = "prefix_only";
 421             }
 422             else {
 423               $result{"separator"} = "";
 424               $result{"filelist"} = [$filename];
 425               $result{"filetype"} = $filetype;
 426             }
 427             return(\%result);
 428           }
 429         }
 430       }
 431     }
 432   }
 433   return({"found" => 0});
 434 }
 435
 436 1;