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         my $elem = newMatch("search" => '^\\\\font_' . $ff . '\s+',
 200                              "filetype" => "replace_only",
 201                              "result" => ["\\font_$ff ", $rFont->{$ff}]);
 202         push(@rElems, $elem);
 203       }
 204     }
 205     my $elemntf = newMatch("search" => '^\\\\use_non_tex_fonts\s+(false|true)',
 206                             "filetype" => "replace_only",
 207                             "result" => ["\\use_non_tex_fonts $useNonTexFont"]);
 208     push(@rElems, $elemntf);
 209     setMatching(\@rElems);
 210     return(1);
 211   }
 212   return(0);
 213 }
 214
 215 sub checkForPreamble($)
 216 {
 217   my ($l) = @_;
 218
 219   if ($l =~ /^\\begin_preamble\s*$/) {
 220     my %selem = ();
 221     $selem{type} = "preamble";
 222     $selem{name} = $1;
 223     unshift(@stack, \%selem);
 224     my $rElem = newMatch("ext" => [".eps", ".png"],
 225                           "search" => '^\\\\(photo|ecvpicture)(.*\{)(.*)\}',
 226                           "fileidx" => 3,
 227                           "result" => ["\\", "1", "2", "3", "}"]);
 228     setMatching([$rElem]);
 229     return(1);
 230   }
 231   return(0);
 232 }
 233
 234 sub checkForLayoutStart($)
 235 {
 236   my ($l) = @_;
 237
 238   if ($l =~ /^\\begin_layout\s+(.*)$/) {
 239     #print "started layout\n";
 240     my %selem = ();
 241     $selem{type} = "layout";
 242     $selem{name} = $1;
 243     unshift(@stack, \%selem);
 244     if ($selem{name} =~ /^(Picture|Photo)$/ ) {
 245       my $rElem = newMatch("ext" => [".eps", ".png"],
 246                             "search" => '^(.+)',
 247                             "result" => ["", "", ""]);
 248       setMatching([$rElem]);
 249     }
 250     return(1);
 251   }
 252   return(0);
 253 }
 254
 255 sub checkForInsetStart($)
 256 {
 257   my ($l) = @_;
 258
 259   if ($l =~ /^\\begin_inset\s+(.*)$/) {
 260     #print "started inset\n";
 261     my %selem = ();
 262     $selem{type} = "inset";
 263     $selem{name} = $1;
 264     unshift(@stack, \%selem);
 265     if ($selem{name} =~ /^(Graphics|External)$/) {
 266       my $rElem = newMatch("search" => '^\s+filename\s+(.+)$',
 267                             "filetype" => "copy_only",
 268                             "result" => ["\tfilename ", "", ""]);
 269       setMatching([$rElem]);
 270     }
 271     return(1);
 272   }
 273   return(0);
 274 }
 275
 276 sub checkForLatexCommand($)
 277 {
 278   my ($l) = @_;
 279
 280   if ($stack[0]->{type} eq "inset") {
 281     if ($l =~ /^LatexCommand\s+([^\s]+)\s*$/) {
 282       my $param = $1;
 283       if ($stack[0]->{name} =~ /^CommandInset\s+bibtex$/) {
 284         if ($param eq "bibtex") {
 285           my $rElem1 = newMatch("ext" => ".bib",
 286                                  "filetype" => "prefix_for_list",
 287                                  "search" => '^bibfiles\s+\"(.+)\"',
 288                                  "result" => ["bibfiles \"", "1", "\""]);
 289           my $rElem2 = newMatch("ext" => ".bst",
 290                                  "filetype" => "prefix_for_list",
 291                                  "search" => '^options\s+\"(.+)\"',
 292                                  "result" => ["options \"", "1", "\""]);
 293           setMatching([$rElem1, $rElem2]);
 294         }
 295       }
 296       elsif ($stack[0]->{name} =~ /^CommandInset\s+include$/) {
 297         if ($param =~ /^(verbatiminput\*?|lstinputlisting)$/) {
 298           my $rElem = newMatch("search" => '^filename\s+\"(.+)\"',
 299                                 "filetype" => "copy_only",
 300                                 "result" => ["filename \"", "", "\""]);
 301           setMatching([$rElem]);
 302         }
 303         elsif ($param =~ /^(include|input)$/) {
 304           my $rElem = newMatch("search" => '^filename\s+\"(.+)\"',
 305                                 "filetype" => "interpret",
 306                                 "result" => ["filename \"", "", "\""]);
 307           setMatching([$rElem]);
 308         }
 309       }
 310     }
 311   }
 312   return(0);
 313 }
 314
 315 #
 316 # parse the given line
 317 # returns a hash with folloving values
 318 #    found:  1 if line matched some regex
 319 #    fileidx: index into result
 320 #    ext: list of possible extensions to use for a valid file
 321 #    filelist: list of found file-pathes (may be more then one, e.g. in bibfiles spec)
 322 #    separator: to be used while concatenating the filenames
 323 #    filetype: prefix_only,replace_only,copy_only,interpret
 324 #              same as before, but without 'prefix_for_list'
 325 sub checkLyxLine($)
 326 {
 327   my ($l) = @_;
 328
 329   return({"found" => 0}) if (checkForHeader($l));
 330   return({"found" => 0}) if (checkForPreamble($l));
 331   return({"found" => 0}) if (checkForEndBlock($l));
 332   return({"found" => 0}) if (checkForLayoutStart($l));
 333   return({"found" => 0}) if (checkForInsetStart($l));
 334   return({"found" => 0}) if (checkForLatexCommand($l));
 335   if (defined($stack[0])) {
 336     my $rMatch = getMatching();
 337     for my $m ( @{$rMatch}) {
 338       my $search = getSearch($m);
 339       if ($l =~ /$search/) {
 340         my @matches = ($1, $2, $3, $4);
 341         my $filetype = getFileType($m);
 342         my @result2 = @{getResult($m)};
 343
 344         for my $r (@result2) {
 345           if ($r =~ /^\d$/) {
 346             $r = $matches[$r-1];
 347           }
 348         }
 349         if ($filetype eq "replace_only") {
 350           # No filename needed
 351           my %result = ("found" => 1,
 352                         "filetype" => $filetype,
 353                         "result" => \@result2);
 354           return(\%result);
 355         }
 356         else {
 357           my $fileidx = getFileIdx($m);
 358           my $filename = $matches[$fileidx-1];
 359           if ($filename !~ /^\.*$/) {
 360             my %result = ("found" => 1,
 361                           "fileidx" => $fileidx,
 362                           "ext" => getExt($m),
 363                           "result" => \@result2);
 364             if ($filetype eq "prefix_for_list") {
 365               # bibfiles|options in CommandInset bibtex
 366               my @filenames = split(',', $filename);
 367               $result{"separator"} = ",";
 368               $result{"filelist"} = \@filenames;
 369               $result{"filetype"} = "prefix_only";
 370             }
 371             else {
 372               $result{"separator"} = "";
 373               $result{"filelist"} = [$filename];
 374               $result{"filetype"} = $filetype;
 375             }
 376             return(\%result);
 377           }
 378         }
 379       }
 380     }
 381   }
 382   return({"found" => 0});
 383 }
 384
 385 1;