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) = @_;
 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     setMatching(\@rElems);
 251     return(1);
 252   }
 253   return(0);
 254 }
 255
 256 sub checkForPreamble($)
 257 {
 258   my ($l) = @_;
 259
 260   if ($l =~ /^\\begin_preamble\s*$/) {
 261     my %selem = ();
 262     $selem{type} = "preamble";
 263     $selem{name} = $1;
 264     unshift(@stack, \%selem);
 265     my $rElem = newMatch("ext" => [".eps", ".png"],
 266                           "search" => qr/^\\(photo|ecvpicture)(.*\{)(.*)\}/,
 267                           "fileidx" => 3,
 268                           "result" => ["\\", "1", "2", "3", "}"]);
 269     #
 270     # Remove comments from preamble
 271     my $comments = newMatch("search" => qr/^([^%]*)([%]+)([^%]*)$/,
 272                             "filetype" => "replace_only",
 273                             "result" => ["1", "2"]);
 274     setMatching([$rElem, $comments]);
 275     return(1);
 276   }
 277   return(0);
 278 }
 279
 280 sub checkForLayoutStart($)
 281 {
 282   my ($l) = @_;
 283
 284   if ($l =~ /^\\begin_layout\s+(.*)$/) {
 285     #print "started layout\n";
 286     my %selem = ();
 287     $selem{type} = "layout";
 288     $selem{name} = $1;
 289     unshift(@stack, \%selem);
 290     if ($selem{name} =~ /^(Picture|Photo)$/ ) {
 291       my $rElem = newMatch("ext" => [".eps", ".png", ""],
 292                             "filetype" => "copy_only",
 293                             "search" => qr/^(.+)/,
 294                             "result" => ["", "", ""]);
 295       setMatching([$rElem]);
 296     }
 297     return(1);
 298   }
 299   return(0);
 300 }
 301
 302 sub checkForInsetStart($)
 303 {
 304   my ($l) = @_;
 305
 306   if ($l =~ /^\\begin_inset\s+(.*)$/) {
 307     #print "started inset\n";
 308     my %selem = ();
 309     $selem{type} = "inset";
 310     $selem{name} = $1;
 311     unshift(@stack, \%selem);
 312     if ($selem{name} =~ /^(Graphics|External)$/) {
 313       my $rElem = newMatch("search" => qr/^\s+filename\s+(.+)$/,
 314                             "filetype" => "copy_only",
 315                             "result" => ["\tfilename ", "", ""]);
 316       setMatching([$rElem]);
 317     }
 318     return(1);
 319   }
 320   return(0);
 321 }
 322
 323 sub checkForLatexCommand($)
 324 {
 325   my ($l) = @_;
 326
 327   if ($stack[0]->{type} eq "inset") {
 328     if ($l =~ /^LatexCommand\s+([^\s]+)\s*$/) {
 329       my $param = $1;
 330       if ($stack[0]->{name} =~ /^CommandInset\s+bibtex$/) {
 331         if ($param eq "bibtex") {
 332           my $rElem1 = newMatch("ext" => ".bib",
 333                                  "filetype" => "prefix_for_list",
 334                                  "search" => qr/^bibfiles\s+\"(.+)\"/,
 335                                  "result" => ["bibfiles \"", "1", "\""]);
 336           my $rElem2 = newMatch("ext" => ".bst",
 337                                  "filetype" => "prefix_for_list",
 338                                  "search" => qr/^options\s+\"(.+)\"/,
 339                                  "result" => ["options \"", "1", "\""]);
 340           setMatching([$rElem1, $rElem2]);
 341         }
 342       }
 343       elsif ($stack[0]->{name} =~ /^CommandInset\s+include$/) {
 344         if ($param =~ /^(verbatiminput\*?|lstinputlisting|inputminted)$/) {
 345           my $rElem = newMatch("search" => qr/^filename\s+\"(.+)\"/,
 346                                 "filetype" => "copy_only",
 347                                 "result" => ["filename \"", "", "\""]);
 348           setMatching([$rElem]);
 349         }
 350         elsif ($param =~ /^(include|input)$/) {
 351           my $rElem = newMatch("search" => qr/^filename\s+\"(.+)\"/,
 352                                 "filetype" => "interpret",
 353                                 "result" => ["filename \"", "", "\""]);
 354           setMatching([$rElem]);
 355         }
 356       }
 357     }
 358   }
 359   return(0);
 360 }
 361
 362 #
 363 # parse the given line
 364 # returns a hash with folloving values
 365 #    found:  1 if line matched some regex
 366 #    fileidx: index into result
 367 #    ext: list of possible extensions to use for a valid file
 368 #    filelist: list of found file-pathes (may be more then one, e.g. in bibfiles spec)
 369 #    separator: to be used while concatenating the filenames
 370 #    filetype: prefix_only,replace_only,copy_only,interpret
 371 #              same as before, but without 'prefix_for_list'
 372 sub checkLyxLine($)
 373 {
 374   my ($l) = @_;
 375
 376   return({"found" => 0}) if (checkForHeader($l));
 377   return({"found" => 0}) if (checkForPreamble($l));
 378   return({"found" => 0}) if (checkForEndBlock($l));
 379   return({"found" => 0}) if (checkForLayoutStart($l));
 380   return({"found" => 0}) if (checkForInsetStart($l));
 381   return({"found" => 0}) if (checkForLatexCommand($l));
 382   if (defined($stack[0])) {
 383     my $rMatch = getMatching();
 384     for my $m ( @{$rMatch}) {
 385       my $search = getSearch($m);
 386       if ($l =~ $search) {
 387         my @matches = ($1, $2, $3, $4);
 388         my $filetype = getFileType($m);
 389         my @result2 = @{getResult($m)};
 390
 391         for my $r (@result2) {
 392           if ($r =~ /^\d$/) {
 393             $r = $matches[$r-1];
 394           }
 395         }
 396         if ($filetype eq "replace_only") {
 397           # No filename needed
 398           my %result = ("found" => 1,
 399                         "filetype" => $filetype,
 400                         "result" => \@result2);
 401           return(\%result);
 402         }
 403         else {
 404           my $fileidx = getFileIdx($m);
 405           my $filename = $matches[$fileidx-1];
 406           if ($filename !~ /^\.*$/) {
 407             my %result = ("found" => 1,
 408                           "fileidx" => $fileidx,
 409                           "ext" => getExt($m),
 410                           "result" => \@result2);
 411             if ($filetype eq "prefix_for_list") {
 412               # bibfiles|options in CommandInset bibtex
 413               my @filenames = split(',', $filename);
 414               $result{"separator"} = ",";
 415               $result{"filelist"} = \@filenames;
 416               $result{"filetype"} = "prefix_only";
 417             }
 418             else {
 419               $result{"separator"} = "";
 420               $result{"filelist"} = [$filename];
 421               $result{"filetype"} = $filetype;
 422             }
 423             return(\%result);
 424           }
 425         }
 426       }
 427     }
 428   }
 429   return({"found" => 0});
 430 }
 431
 432 1;