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