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