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