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