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