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