SL/Template.pm

   1 #====================================================================
   2 # LX-Office ERP
   3 # Copyright (C) 2004
   4 # Based on SQL-Ledger Version 2.1.9
   5 # Web http://www.lx-office.org
   6 #
   7 #====================================================================
   8
   9 package SimpleTemplate;
  10
  11 # Parameters:
  12 #   1. The template's file name
  13 #   2. A reference to the Form object
  14 #   3. A reference to the myconfig hash
  15 #
  16 # Returns:
  17 #   A new template object
  18 sub new {
  19   my $type = shift;
  20   my $self = {};
  21
  22   bless($self, $type);
  23   $self->_init(@_);
  24
  25   return $self;
  26 }
  27
  28 sub _init {
  29   my $self = shift;
  30
  31   $self->{source}    = shift;
  32   $self->{form}      = shift;
  33   $self->{myconfig}  = shift;
  34   $self->{userspath} = shift;
  35
  36   $self->{error}     = undef;
  37
  38   $self->set_tag_style('<%', '%>');
  39 }
  40
  41 sub set_tag_style {
  42   my $self                    = shift;
  43   my $tag_start               = shift;
  44   my $tag_end                 = shift;
  45
  46   $self->{tag_start}          = $tag_start;
  47   $self->{tag_end}            = $tag_end;
  48   $self->{tag_start_qm}       = quotemeta $tag_start;
  49   $self->{tag_end_qm}         = quotemeta $tag_end;
  50
  51   $self->{substitute_vars_re} = "$self->{tag_start_qm}(.+?)$self->{tag_end_qm}";
  52 }
  53
  54 sub cleanup {
  55   my ($self) = @_;
  56 }
  57
  58 # Parameters:
  59 #   1. A typeglob for the file handle. The output will be written
  60 #      to this file handle.
  61 #
  62 # Returns:
  63 #   1 on success and undef or 0 if there was an error. In the latter case
  64 #   the calling function can retrieve the error message via $obj->get_error()
  65 sub parse {
  66   my $self = $_[0];
  67   local *OUT = $_[1];
  68
  69   print(OUT "Hallo!\n");
  70 }
  71
  72 sub get_error {
  73   my $self = shift;
  74
  75   return $self->{"error"};
  76 }
  77
  78 sub uses_temp_file {
  79   return 0;
  80 }
  81
  82 sub _get_loop_variable {
  83   my $self      = shift;
  84   my $var       = shift;
  85   my $get_array = shift;
  86   my @indices   = @_;
  87
  88   my $form      = $self->{form};
  89   my $value;
  90
  91   if (($get_array || @indices) && (ref $form->{TEMPLATE_ARRAYS} eq 'HASH') && (ref $form->{TEMPLATE_ARRAYS}->{$var} eq 'ARRAY')) {
  92     $value = $form->{TEMPLATE_ARRAYS}->{$var};
  93   } else {
  94     $value = $form->{$var};
  95   }
  96
  97   for (my $i = 0; $i < scalar(@indices); $i++) {
  98     last unless (ref($value) eq "ARRAY");
  99     $value = $value->[$indices[$i]];
 100   }
 101
 102   return $value;
 103 }
 104
 105 sub substitute_vars {
 106   my ($self, $text, @indices) = @_;
 107
 108   my $form = $self->{"form"};
 109
 110   while ($text =~ /$self->{substitute_vars_re}/) {
 111     my ($tag_pos, $tag_len) = ($-[0], $+[0] - $-[0]);
 112     my ($var, @options)     = split(/\s+/, $1);
 113
 114     my $value               = $self->_get_loop_variable($var, 0, @indices);
 115     $value                  = $self->format_string($value) unless (grep(/^NOESCAPE$/, @options));
 116
 117     substr($text, $tag_pos, $tag_len, $value);
 118   }
 119
 120   return $text;
 121 }
 122
 123 1;
 124
 125 ####
 126 #### LaTeXTemplate
 127 ####
 128
 129 package LaTeXTemplate;
 130
 131 use vars qw(@ISA);
 132
 133 @ISA = qw(SimpleTemplate);
 134
 135 sub new {
 136   my $type = shift;
 137
 138   my $self = $type->SUPER::new(@_);
 139
 140   return $self;
 141 }
 142
 143 sub format_string {
 144   my ($self, $variable) = @_;
 145   my $form = $self->{"form"};
 146
 147   $variable = $main::locale->quote_special_chars('Template/LaTeX', $variable);
 148
 149   # Allow some HTML markup to be converted into the output format's
 150   # corresponding markup code, e.g. bold or italic.
 151   my %markup_replace = ('b' => 'textbf',
 152                         'i' => 'textit',
 153                         'u' => 'underline');
 154
 155   foreach my $key (keys(%markup_replace)) {
 156     my $new = $markup_replace{$key};
 157     $variable =~ s/\$\<\$${key}\$\>\$(.*?)\$<\$\/${key}\$>\$/\\${new}\{$1\}/gi;
 158   }
 159
 160   $variable =~ s/[\x00-\x1f]//g;
 161
 162   return $variable;
 163 }
 164
 165 sub parse_foreach {
 166   my ($self, $var, $text, $start_tag, $end_tag, @indices) = @_;
 167
 168   my ($form, $new_contents) = ($self->{"form"}, "");
 169
 170   my $ary = $self->_get_loop_variable($var, 1, @indices);
 171
 172   my $sum                          = 0;
 173   my $current_page                 = 1;
 174   my ($current_line, $corrent_row) = (0, 1);
 175   my $description_array            = $self->_get_loop_variable("description",     1);
 176   my $longdescription_array        = $self->_get_loop_variable("longdescription", 1);
 177   my $linetotal_array              = $self->_get_loop_variable("linetotal",       1);
 178
 179   $form->{TEMPLATE_ARRAYS}->{cumulatelinetotal} = [];
 180
 181   for (my $i = 0; $i < scalar(@{$ary}); $i++) {
 182     $form->{"__first__"}   = $i == 1;
 183     $form->{"__last__"}    = ($i + 1) == scalar(@{$ary});
 184     $form->{"__odd__"}     = (($i + 1) % 2) == 1;
 185     $form->{"__counter__"} = $i + 1;
 186
 187     if (scalar @{$description_array} == scalar @{$ary} && $self->{"chars_per_line"} != 0) {
 188       my $lines = int(length($description_array->[$i]) / $self->{"chars_per_line"});
 189       my $lpp;
 190
 191       $description_array->[$i] =~ s/(\\newline\s?)*$//;
 192       my $_description = $description_array->[$i];
 193       while ($_description =~ /\\newline/) {
 194         $lines++;
 195         $_description =~ s/\\newline//;
 196       }
 197       $lines++;
 198
 199       if ($current_page == 1) {
 200         $lpp = $self->{"lines_on_first_page"};
 201       } else {
 202         $lpp = $self->{"lines_on_second_page"};
 203       }
 204
 205       # Yes we need a manual page break -- or the user has forced one
 206       if ((($current_line + $lines) > $lpp) || ($description_array->[$i] =~ /<pagebreak>/) || ($longdescription_array->[$i] =~ /<pagebreak>/)) {
 207         my $pb = $self->{"pagebreak_block"};
 208
 209         # replace the special variables <%sumcarriedforward%>
 210         # and <%lastpage%>
 211
 212         my $psum = $form->format_amount($self->{"myconfig"}, $sum, 2);
 213         $pb =~ s/$self->{tag_start_qm}sumcarriedforward$self->{tag_end_qm}/$psum/g;
 214         $pb =~ s/$self->{tag_start_qm}lastpage$self->{tag_end_qm}/$current_page/g;
 215
 216         my $new_text = $self->parse_block($pb, (@indices, $i));
 217         return undef unless (defined($new_text));
 218         $new_contents .= $new_text;
 219
 220         $current_page++;
 221         $current_line = 0;
 222       }
 223       $current_line += $lines;
 224     }
 225
 226     if ($i < scalar(@{$linetotal_array})) {
 227       $sum += $form->parse_amount($self->{"myconfig"}, $linetotal_array->[$i]);
 228     }
 229
 230     $form->{TEMPLATE_ARRAYS}->{cumulatelinetotal}->[$i] = $form->format_amount($self->{"myconfig"}, $sum, 2);
 231
 232     my $new_text = $self->parse_block($text, (@indices, $i));
 233     return undef unless (defined($new_text));
 234     $new_contents .= $start_tag . $new_text . $end_tag;
 235   }
 236   map({ delete($form->{"__${_}__"}); } qw(first last odd counter));
 237
 238   return $new_contents;
 239 }
 240
 241 sub find_end {
 242   my ($self, $text, $pos, $var, $not) = @_;
 243
 244   my $tag_start_len = length $self->{tag_start};
 245
 246   my $depth = 1;
 247   $pos = 0 unless ($pos);
 248
 249   while ($pos < length($text)) {
 250     $pos++;
 251
 252     next if (substr($text, $pos - 1, length($self->{tag_start})) ne $self->{tag_start});
 253
 254     my $keyword_pos = $pos - 1 + $tag_start_len;
 255
 256     if ((substr($text, $keyword_pos, 2) eq 'if') || (substr($text, $keyword_pos, 3) eq 'for')) {
 257       $depth++;
 258
 259     } elsif ((substr($text, $keyword_pos, 4) eq 'else') && (1 == $depth)) {
 260       if (!$var) {
 261         $self->{"error"} =
 262             "$self->{tag_start}else$self->{tag_end} outside of "
 263           . "$self->{tag_start}if$self->{tag_end} / "
 264           . "$self->{tag_start}ifnot$self->{tag_end}.";
 265         return undef;
 266       }
 267
 268       my $block = substr($text, 0, $pos - 1);
 269       substr($text, 0, $pos - 1) = "";
 270       $text =~ s!^$self->{tag_start_qm}.+?$self->{tag_end_qm}!!;
 271       $text =  $self->{tag_start} . 'if' . ($not ?  " " : "not ") . $var . $self->{tag_end} . $text;
 272
 273       return ($block, $text);
 274
 275     } elsif (substr($text, $keyword_pos, 3) eq 'end') {
 276       $depth--;
 277       if ($depth == 0) {
 278         my $block = substr($text, 0, $pos - 1);
 279         substr($text, 0, $pos - 1) = "";
 280         $text =~ s!^$self->{tag_start_qm}.+?$self->{tag_end_qm}!!;
 281
 282         return ($block, $text);
 283       }
 284     }
 285   }
 286
 287   return undef;
 288 }
 289
 290 sub parse_block {
 291   $main::lxdebug->enter_sub();
 292
 293   my ($self, $contents, @indices) = @_;
 294
 295   my $new_contents = "";
 296
 297   while ($contents ne "") {
 298     my $pos_if      = index($contents, $self->{tag_start} . 'if');
 299     my $pos_foreach = index($contents, $self->{tag_start} . 'foreach');
 300
 301     if ((-1 == $pos_if) && (-1 == $pos_foreach)) {
 302       $new_contents .= $self->substitute_vars($contents, @indices);
 303       last;
 304     }
 305
 306     if ((-1 == $pos_if) || ((-1 != $pos_foreach) && ($pos_if > $pos_foreach))) {
 307       $new_contents .= $self->substitute_vars(substr($contents, 0, $pos_foreach), @indices);
 308       substr($contents, 0, $pos_foreach) = "";
 309
 310       if ($contents !~ m|^$self->{tag_start_qm}foreach (.+?)$self->{tag_end_qm}|) {
 311         $self->{"error"} = "Malformed $self->{tag_start}foreach$self->{tag_end}.";
 312         $main::lxdebug->leave_sub();
 313         return undef;
 314       }
 315
 316       my $var = $1;
 317
 318       substr($contents, 0, length($&)) = "";
 319
 320       my $block;
 321       ($block, $contents) = $self->find_end($contents);
 322       if (!$block) {
 323         $self->{"error"} = "Unclosed $self->{tag_start}foreach$self->{tag_end}." unless ($self->{"error"});
 324         $main::lxdebug->leave_sub();
 325         return undef;
 326       }
 327
 328       my $new_text = $self->parse_foreach($var, $block, "", "", @indices);
 329       if (!defined($new_text)) {
 330         $main::lxdebug->leave_sub();
 331         return undef;
 332       }
 333       $new_contents .= $new_text;
 334
 335     } else {
 336       $new_contents .= $self->substitute_vars(substr($contents, 0, $pos_if), @indices);
 337       substr($contents, 0, $pos_if) = "";
 338
 339       if ($contents !~ m|^$self->{tag_start_qm}if\s*(not)?\s+(.*?)$self->{tag_end_qm}|) {
 340         $self->{"error"} = "Malformed $self->{tag_start}if$self->{tag_end}.";
 341         $main::lxdebug->leave_sub();
 342         return undef;
 343       }
 344
 345       my ($not, $var) = ($1, $2);
 346
 347       substr($contents, 0, length($&)) = "";
 348
 349       ($block, $contents) = $self->find_end($contents, 0, $var, $not);
 350       if (!$block) {
 351         $self->{"error"} = "Unclosed $self->{tag_start}if${not}$self->{tag_end}." unless ($self->{"error"});
 352         $main::lxdebug->leave_sub();
 353         return undef;
 354       }
 355
 356       my $form = $self->{form};
 357       $form = $form->{TEMPLATE_ARRAYS} if @indices
 358                                        && ref $form->{TEMPLATE_ARRAYS} eq 'HASH'
 359                                        && ref $form->{TEMPLATE_ARRAYS}->{$var} eq 'ARRAY';
 360       my $value = $form->{$var};
 361       for (my $i = 0; $i < scalar(@indices); $i++) {
 362         last unless (ref($value) eq "ARRAY");
 363         $value = $value->[$indices[$i]];
 364       }
 365
 366       if (($not && !$value) || (!$not && $value)) {
 367         my $new_text = $self->parse_block($block, @indices);
 368         if (!defined($new_text)) {
 369           $main::lxdebug->leave_sub();
 370           return undef;
 371         }
 372         $new_contents .= $new_text;
 373       }
 374     }
 375   }
 376
 377   $main::lxdebug->leave_sub();
 378
 379   return $new_contents;
 380 }
 381
 382 sub parse_first_line {
 383   my $self = shift;
 384   my $line = shift || "";
 385
 386   if ($line =~ m/([^\s]+)set-tag-style([^\s]+)/) {
 387     if ($1 eq $2) {
 388       $self->{error} = "The tag start and end markers must not be equal.";
 389       return 0;
 390     }
 391
 392     $self->set_tag_style($1, $2);
 393   }
 394
 395   return 1;
 396 }
 397
 398 sub _parse_config_option {
 399   my $self = shift;
 400   my $line = shift;
 401
 402   $line =~ s/^\s*//;
 403   $line =~ s/\s*$//;
 404
 405   my ($key, $value) = split m/\s*=\s*/, $line, 2;
 406
 407   if ($key eq 'tag-style') {
 408     $self->set_tag_style(split(m/\s+/, $value, 2));
 409   }
 410 }
 411
 412 sub _parse_config_lines {
 413   my $self  = shift;
 414   my $lines = shift;
 415
 416   my ($comment_start, $comment_end) = ("", "");
 417
 418   if (ref $self eq 'LaTeXTemplate') {
 419     $comment_start = '\s*%';
 420   } elsif (ref $self eq 'HTMLTemplate') {
 421     $comment_start = '\s*<!--';
 422     $comment_end   = '>\s*';
 423   } else {
 424     $comment_start = '\s*\#';
 425   }
 426
 427   my $num_lines = scalar @{ $lines };
 428   my $i         = 0;
 429
 430   while ($i < $num_lines) {
 431     my $line = $lines->[$i];
 432
 433     if ($line !~ m/^${comment_start}\s*config\s*:(.*)${comment_end}$/i) {
 434       $i++;
 435       next;
 436     }
 437
 438     $self->_parse_config_option($1);
 439     splice @{ $lines }, $i, 1;
 440     $num_lines--;
 441   }
 442 }
 443
 444 sub _force_mandatory_packages {
 445   my $self  = shift;
 446   my $lines = shift;
 447
 448   my (%used_packages, $document_start_line);
 449
 450   foreach my $i (0 .. scalar @{ $lines } - 1) {
 451     if ($lines->[$i] =~ m/\\usepackage[^{]*{(.*?)}/) {
 452       $used_packages{$1} = 1;
 453
 454     } elsif ($lines->[$i] =~ m/\\begin{document}/) {
 455       $document_start_line = $i;
 456       last;
 457
 458     }
 459   }
 460
 461   $document_start_line = scalar @{ $lines } - 1 if (!defined $document_start_line);
 462
 463   if (!$used_packages{textcomp}) {
 464     splice @{ $lines }, $document_start_line, 0, "\\usepackage{textcomp}\n";
 465     $document_start_line++;
 466   }
 467 }
 468
 469 sub parse {
 470   my $self = $_[0];
 471   local *OUT = $_[1];
 472   my $form = $self->{"form"};
 473
 474   if (!open(IN, "$form->{templates}/$form->{IN}")) {
 475     $self->{"error"} = "$!";
 476     return 0;
 477   }
 478   my @lines = <IN>;
 479   close(IN);
 480
 481   $self->_parse_config_lines(\@lines);
 482   $self->_force_mandatory_packages(\@lines) if (ref $self eq 'LaTeXTemplate');
 483
 484   my $contents = join("", @lines);
 485
 486   # detect pagebreak block and its parameters
 487   if ($contents =~ /$self->{tag_start_qm}pagebreak\s+(\d+)\s+(\d+)\s+(\d+)\s*$self->{tag_end_qm}(.*?)$self->{tag_start_qm}end(\s*pagebreak)?$self->{tag_end_qm}/s) {
 488     $self->{"chars_per_line"} = $1;
 489     $self->{"lines_on_first_page"} = $2;
 490     $self->{"lines_on_second_page"} = $3;
 491     $self->{"pagebreak_block"} = $4;
 492
 493     substr($contents, length($`), length($&)) = "";
 494   }
 495
 496   $self->{"forced_pagebreaks"} = [];
 497
 498   my $new_contents = $self->parse_block($contents);
 499   if (!defined($new_contents)) {
 500     $main::lxdebug->leave_sub();
 501     return 0;
 502   }
 503
 504   print(OUT $new_contents);
 505
 506   if ($form->{"format"} =~ /postscript/i) {
 507     return $self->convert_to_postscript();
 508   } elsif ($form->{"format"} =~ /pdf/i) {
 509     return $self->convert_to_pdf();
 510   } else {
 511     return 1;
 512   }
 513 }
 514
 515 sub convert_to_postscript {
 516   my ($self) = @_;
 517   my ($form, $userspath) = ($self->{"form"}, $self->{"userspath"});
 518
 519   # Convert the tex file to postscript
 520
 521   if (!chdir("$userspath")) {
 522     $self->{"error"} = "chdir : $!";
 523     $self->cleanup();
 524     return 0;
 525   }
 526
 527   $form->{tmpfile} =~ s/\Q$userspath\E\///g;
 528
 529   my $latex = $self->_get_latex_path();
 530
 531   for (my $run = 1; $run <= 2; $run++) {
 532     system("${latex} --interaction=nonstopmode $form->{tmpfile} " .
 533            "> $form->{tmpfile}.err");
 534     if ($?) {
 535       $self->{"error"} = $form->cleanup();
 536       $self->cleanup();
 537       return 0;
 538     }
 539   }
 540
 541   $form->{tmpfile} =~ s/tex$/dvi/;
 542
 543   system("dvips $form->{tmpfile} -o -q > /dev/null");
 544   if ($?) {
 545     $self->{"error"} = "dvips : $!";
 546     $self->cleanup();
 547     return 0;
 548   }
 549   $form->{tmpfile} =~ s/dvi$/ps/;
 550
 551   $self->cleanup();
 552
 553   return 1;
 554 }
 555
 556 sub convert_to_pdf {
 557   my ($self) = @_;
 558   my ($form, $userspath) = ($self->{"form"}, $self->{"userspath"});
 559
 560   # Convert the tex file to PDF
 561
 562   if (!chdir("$userspath")) {
 563     $self->{"error"} = "chdir : $!";
 564     $self->cleanup();
 565     return 0;
 566   }
 567
 568   $form->{tmpfile} =~ s/\Q$userspath\E\///g;
 569
 570   my $latex = $self->_get_latex_path();
 571
 572   for (my $run = 1; $run <= 2; $run++) {
 573     system("${latex} --interaction=nonstopmode $form->{tmpfile} " .
 574            "> $form->{tmpfile}.err");
 575     if ($?) {
 576       $self->{"error"} = $form->cleanup();
 577       $self->cleanup();
 578       return 0;
 579     }
 580   }
 581
 582   $form->{tmpfile} =~ s/tex$/pdf/;
 583
 584   $self->cleanup();
 585 }
 586
 587 sub _get_latex_path {
 588   return $main::latex_bin || 'pdflatex';
 589 }
 590
 591 sub get_mime_type() {
 592   my ($self) = @_;
 593
 594   if ($self->{"form"}->{"format"} =~ /postscript/i) {
 595     return "application/postscript";
 596   } else {
 597     return "application/pdf";
 598   }
 599 }
 600
 601 sub uses_temp_file {
 602   return 1;
 603 }
 604
 605
 606 ####
 607 #### HTMLTemplate
 608 ####
 609
 610 package HTMLTemplate;
 611
 612 use vars qw(@ISA);
 613
 614 @ISA = qw(LaTeXTemplate);
 615
 616 sub new {
 617   my $type = shift;
 618
 619   return $type->SUPER::new(@_);
 620 }
 621
 622 sub format_string {
 623   my ($self, $variable) = @_;
 624   my $form = $self->{"form"};
 625
 626   $variable = $main::locale->quote_special_chars('Template/HTML', $variable);
 627
 628   # Allow some HTML markup to be converted into the output format's
 629   # corresponding markup code, e.g. bold or italic.
 630   my @markup_replace = ('b', 'i', 's', 'u', 'sub', 'sup');
 631
 632   foreach my $key (@markup_replace) {
 633     $variable =~ s/\&lt;(\/?)${key}\&gt;/<$1${key}>/g;
 634   }
 635
 636   return $variable;
 637 }
 638
 639 sub get_mime_type() {
 640   my ($self) = @_;
 641
 642   if ($self->{"form"}->{"format"} =~ /postscript/i) {
 643     return "application/postscript";
 644   } elsif ($self->{"form"}->{"format"} =~ /pdf/i) {
 645     return "application/pdf";
 646   } else {
 647     return "text/html";
 648   }
 649 }
 650
 651 sub uses_temp_file {
 652   my ($self) = @_;
 653
 654   if ($self->{"form"}->{"format"} =~ /postscript/i) {
 655     return 1;
 656   } elsif ($self->{"form"}->{"format"} =~ /pdf/i) {
 657     return 1;
 658   } else {
 659     return 0;
 660   }
 661 }
 662
 663 sub convert_to_postscript {
 664   my ($self) = @_;
 665   my ($form, $userspath) = ($self->{"form"}, $self->{"userspath"});
 666
 667   # Convert the HTML file to postscript
 668
 669   if (!chdir("$userspath")) {
 670     $self->{"error"} = "chdir : $!";
 671     $self->cleanup();
 672     return 0;
 673   }
 674
 675   $form->{"tmpfile"} =~ s/\Q$userspath\E\///g;
 676   my $psfile = $form->{"tmpfile"};
 677   $psfile =~ s/.html/.ps/;
 678   if ($psfile eq $form->{"tmpfile"}) {
 679     $psfile .= ".ps";
 680   }
 681
 682   system("html2ps -f html2ps-config < $form->{tmpfile} > $psfile");
 683   if ($?) {
 684     $self->{"error"} = $form->cleanup();
 685     $self->cleanup();
 686     return 0;
 687   }
 688
 689   $form->{"tmpfile"} = $psfile;
 690
 691   $self->cleanup();
 692
 693   return 1;
 694 }
 695
 696 sub convert_to_pdf {
 697   my ($self) = @_;
 698   my ($form, $userspath) = ($self->{"form"}, $self->{"userspath"});
 699
 700   # Convert the HTML file to PDF
 701
 702   if (!chdir("$userspath")) {
 703     $self->{"error"} = "chdir : $!";
 704     $self->cleanup();
 705     return 0;
 706   }
 707
 708   $form->{"tmpfile"} =~ s/\Q$userspath\E\///g;
 709   my $pdffile = $form->{"tmpfile"};
 710   $pdffile =~ s/.html/.pdf/;
 711   if ($pdffile eq $form->{"tmpfile"}) {
 712     $pdffile .= ".pdf";
 713   }
 714
 715   system("html2ps -f html2ps-config < $form->{tmpfile} | ps2pdf - $pdffile");
 716   if ($?) {
 717     $self->{"error"} = $form->cleanup();
 718     $self->cleanup();
 719     return 0;
 720   }
 721
 722   $form->{"tmpfile"} = $pdffile;
 723
 724   $self->cleanup();
 725
 726   return 1;
 727 }
 728
 729
 730 ####
 731 #### PlainTextTemplate
 732 ####
 733
 734 package PlainTextTemplate;
 735
 736 use vars qw(@ISA);
 737
 738 @ISA = qw(LaTeXTemplate);
 739
 740 sub new {
 741   my $type = shift;
 742
 743   return $type->SUPER::new(@_);
 744 }
 745
 746 sub format_string {
 747   my ($self, $variable) = @_;
 748
 749   return $variable;
 750 }
 751
 752 sub get_mime_type {
 753   return "text/plain";
 754 }
 755
 756 sub parse {
 757 }
 758
 759 1;
 760
 761 ####
 762 #### OpenDocumentTemplate
 763 ####
 764
 765 package OpenDocumentTemplate;
 766
 767 use POSIX 'setsid';
 768 use vars qw(@ISA);
 769
 770 use Cwd;
 771 # use File::Copy;
 772 # use File::Spec;
 773 # use File::Temp qw(:mktemp);
 774 use IO::File;
 775
 776 @ISA = qw(SimpleTemplate);
 777
 778 sub new {
 779   my $type = shift;
 780
 781   $self = $type->SUPER::new(@_);
 782
 783   foreach my $module (qw(Archive::Zip Text::Iconv)) {
 784     eval("use ${module};");
 785     if ($@) {
 786       $self->{"form"}->error("The Perl module '${module}' could not be " .
 787                              "loaded. Support for OpenDocument templates " .
 788                              "does not work without it. Please install your " .
 789                              "distribution's package or get the module from " .
 790                              "CPAN ( http://www.cpan.org ).");
 791     }
 792   }
 793
 794   $self->{"rnd"}   = int(rand(1000000));
 795   $self->{"iconv"} = Text::Iconv->new($main::dbcharset, "UTF-8");
 796
 797   $self->set_tag_style('&lt;%', '%&gt;');
 798
 799   return $self;
 800 }
 801
 802 sub parse_foreach {
 803   my ($self, $var, $text, $start_tag, $end_tag, @indices) = @_;
 804
 805   my ($form, $new_contents) = ($self->{"form"}, "");
 806
 807   my $ary = $self->_get_loop_variable($var, 1, @indices);
 808
 809   for (my $i = 0; $i < scalar(@{$ary}); $i++) {
 810     $form->{"__first__"} = $i == 0;
 811     $form->{"__last__"} = ($i + 1) == scalar(@{$ary});
 812     $form->{"__odd__"} = (($i + 1) % 2) == 1;
 813     $form->{"__counter__"} = $i + 1;
 814     my $new_text = $self->parse_block($text, (@indices, $i));
 815     return undef unless (defined($new_text));
 816     $new_contents .= $start_tag . $new_text . $end_tag;
 817   }
 818   map({ delete($form->{"__${_}__"}); } qw(first last odd counter));
 819
 820   return $new_contents;
 821 }
 822
 823 sub find_end {
 824   my ($self, $text, $pos, $var, $not) = @_;
 825
 826   my $depth = 1;
 827   $pos = 0 unless ($pos);
 828
 829   while ($pos < length($text)) {
 830     $pos++;
 831
 832     next if (substr($text, $pos - 1, 5) ne '&lt;%');
 833
 834     if ((substr($text, $pos + 4, 2) eq 'if') || (substr($text, $pos + 4, 3) eq 'for')) {
 835       $depth++;
 836
 837     } elsif ((substr($text, $pos + 4, 4) eq 'else') && (1 == $depth)) {
 838       if (!$var) {
 839         $self->{"error"} = '<%else%> outside of <%if%> / <%ifnot%>.';
 840         return undef;
 841       }
 842
 843       my $block = substr($text, 0, $pos - 1);
 844       substr($text, 0, $pos - 1) = "";
 845       $text =~ s!^\&lt;\%[^\%]+\%\&gt;!!;
 846       $text = '&lt;%if' . ($not ?  " " : "not ") . $var . '%&gt;' . $text;
 847
 848       return ($block, $text);
 849
 850     } elsif (substr($text, $pos + 4, 3) eq 'end') {
 851       $depth--;
 852       if ($depth == 0) {
 853         my $block = substr($text, 0, $pos - 1);
 854         substr($text, 0, $pos - 1) = "";
 855         $text =~ s!^\&lt;\%[^\%]+\%\&gt;!!;
 856
 857         return ($block, $text);
 858       }
 859     }
 860   }
 861
 862   return undef;
 863 }
 864
 865 sub parse_block {
 866   $main::lxdebug->enter_sub();
 867
 868   my ($self, $contents, @indices) = @_;
 869
 870   my $new_contents = "";
 871
 872   while ($contents ne "") {
 873     if (substr($contents, 0, 1) eq "<") {
 874       $contents =~ m|^<[^>]+>|;
 875       my $tag = $&;
 876       substr($contents, 0, length($&)) = "";
 877
 878       if ($tag =~ m|<table:table-row|) {
 879         $contents =~ m|^(.*?)(</table:table-row[^>]*>)|;
 880         my $table_row = $1;
 881         my $end_tag = $2;
 882         substr($contents, 0, length($1) + length($end_tag)) = "";
 883
 884         if ($table_row =~ m|\&lt;\%foreachrow\s+(.*?)\%\&gt;|) {
 885           my $var = $1;
 886
 887           substr($table_row, length($`), length($&)) = "";
 888
 889           my ($t1, $t2) = $self->find_end($table_row, length($`));
 890           if (!$t1) {
 891             $self->{"error"} = "Unclosed <\%foreachrow\%>." unless ($self->{"error"});
 892             $main::lxdebug->leave_sub();
 893             return undef;
 894           }
 895
 896           my $new_text = $self->parse_foreach($var, $t1 . $t2, $tag, $end_tag, @indices);
 897           if (!defined($new_text)) {
 898             $main::lxdebug->leave_sub();
 899             return undef;
 900           }
 901           $new_contents .= $new_text;
 902
 903         } else {
 904           my $new_text = $self->parse_block($table_row, @indices);
 905           if (!defined($new_text)) {
 906             $main::lxdebug->leave_sub();
 907             return undef;
 908           }
 909           $new_contents .= $tag . $new_text . $end_tag;
 910         }
 911
 912       } else {
 913         $new_contents .= $tag;
 914       }
 915
 916     } else {
 917       $contents =~ /^[^<]+/;
 918       my $text = $&;
 919
 920       my $pos_if = index($text, '&lt;%if');
 921       my $pos_foreach = index($text, '&lt;%foreach');
 922
 923       if ((-1 == $pos_if) && (-1 == $pos_foreach)) {
 924         substr($contents, 0, length($text)) = "";
 925         $new_contents .= $self->substitute_vars($text, @indices);
 926         next;
 927       }
 928
 929       if ((-1 == $pos_if) || ((-1 != $pos_foreach) && ($pos_if > $pos_foreach))) {
 930         $new_contents .= $self->substitute_vars(substr($contents, 0, $pos_foreach), @indices);
 931         substr($contents, 0, $pos_foreach) = "";
 932
 933         if ($contents !~ m|^\&lt;\%foreach (.*?)\%\&gt;|) {
 934           $self->{"error"} = "Malformed <\%foreach\%>.";
 935           $main::lxdebug->leave_sub();
 936           return undef;
 937         }
 938
 939         my $var = $1;
 940
 941         substr($contents, 0, length($&)) = "";
 942
 943         my $block;
 944         ($block, $contents) = $self->find_end($contents);
 945         if (!$block) {
 946           $self->{"error"} = "Unclosed <\%foreach\%>." unless ($self->{"error"});
 947           $main::lxdebug->leave_sub();
 948           return undef;
 949         }
 950
 951         my $new_text = $self->parse_foreach($var, $block, "", "", @indices);
 952         if (!defined($new_text)) {
 953           $main::lxdebug->leave_sub();
 954           return undef;
 955         }
 956         $new_contents .= $new_text;
 957
 958       } else {
 959         $new_contents .= $self->substitute_vars(substr($contents, 0, $pos_if), @indices);
 960         substr($contents, 0, $pos_if) = "";
 961
 962         if ($contents !~ m|^\&lt;\%if\s*(not)?\s+(.*?)\%\&gt;|) {
 963           $self->{"error"} = "Malformed <\%if\%>.";
 964           $main::lxdebug->leave_sub();
 965           return undef;
 966         }
 967
 968         my ($not, $var) = ($1, $2);
 969
 970         substr($contents, 0, length($&)) = "";
 971
 972         ($block, $contents) = $self->find_end($contents, 0, $var, $not);
 973         if (!$block) {
 974           $self->{"error"} = "Unclosed <\%if${not}\%>." unless ($self->{"error"});
 975           $main::lxdebug->leave_sub();
 976           return undef;
 977         }
 978
 979         my $value = $self->{"form"}->{$var};
 980         for (my $i = 0; $i < scalar(@indices); $i++) {
 981           last unless (ref($value) eq "ARRAY");
 982           $value = $value->[$indices[$i]];
 983         }
 984
 985         if (($not && !$value) || (!$not && $value)) {
 986           my $new_text = $self->parse_block($block, @indices);
 987           if (!defined($new_text)) {
 988             $main::lxdebug->leave_sub();
 989             return undef;
 990           }
 991           $new_contents .= $new_text;
 992         }
 993       }
 994     }
 995   }
 996
 997   $main::lxdebug->leave_sub();
 998
 999   return $new_contents;
1000 }
1001
1002 sub parse {
1003   $main::lxdebug->enter_sub();
1004
1005   my $self = $_[0];
1006   local *OUT = $_[1];
1007   my $form = $self->{"form"};
1008
1009   close(OUT);
1010
1011   my $file_name;
1012   if ($form->{"IN"} =~ m|^/|) {
1013     $file_name = $form->{"IN"};
1014   } else {
1015     $file_name = $form->{"templates"} . "/" . $form->{"IN"};
1016   }
1017
1018   my $zip = Archive::Zip->new();
1019   if (Archive::Zip::AZ_OK != $zip->read($file_name)) {
1020     $self->{"error"} = "File not found/is not a OpenDocument file.";
1021     $main::lxdebug->leave_sub();
1022     return 0;
1023   }
1024
1025   my $contents = $zip->contents("content.xml");
1026   if (!$contents) {
1027     $self->{"error"} = "File is not a OpenDocument file.";
1028     $main::lxdebug->leave_sub();
1029     return 0;
1030   }
1031
1032   my $rnd = $self->{"rnd"};
1033   my $new_styles = qq|<style:style style:name="TLXO${rnd}BOLD" style:family="text">
1034 <style:text-properties fo:font-weight="bold" style:font-weight-asian="bold" style:font-weight-complex="bold"/>
1035 </style:style>
1036 <style:style style:name="TLXO${rnd}ITALIC" style:family="text">
1037 <style:text-properties fo:font-style="italic" style:font-style-asian="italic" style:font-style-complex="italic"/>
1038 </style:style>
1039 <style:style style:name="TLXO${rnd}UNDERLINE" style:family="text">
1040 <style:text-properties style:text-underline-style="solid" style:text-underline-width="auto" style:text-underline-color="font-color"/>
1041 </style:style>
1042 <style:style style:name="TLXO${rnd}STRIKETHROUGH" style:family="text">
1043 <style:text-properties style:text-line-through-style="solid"/>
1044 </style:style>
1045 <style:style style:name="TLXO${rnd}SUPER" style:family="text">
1046 <style:text-properties style:text-position="super 58%"/>
1047 </style:style>
1048 <style:style style:name="TLXO${rnd}SUB" style:family="text">
1049 <style:text-properties style:text-position="sub 58%"/>
1050 </style:style>
1051 |;
1052
1053   $contents =~ s|</office:automatic-styles>|${new_styles}</office:automatic-styles>|;
1054   $contents =~ s|[\n\r]||gm;
1055
1056   my $new_contents = $self->parse_block($contents);
1057   if (!defined($new_contents)) {
1058     $main::lxdebug->leave_sub();
1059     return 0;
1060   }
1061
1062 #   $new_contents =~ s|>|>\n|g;
1063
1064   $zip->contents("content.xml", $new_contents);
1065
1066   my $styles = $zip->contents("styles.xml");
1067   if ($contents) {
1068     my $new_styles = $self->parse_block($styles);
1069     if (!defined($new_contents)) {
1070       $main::lxdebug->leave_sub();
1071       return 0;
1072     }
1073     $zip->contents("styles.xml", $new_styles);
1074   }
1075
1076   $zip->writeToFileNamed($form->{"tmpfile"}, 1);
1077
1078   my $res = 1;
1079   if ($form->{"format"} =~ /pdf/) {
1080     $res = $self->convert_to_pdf();
1081   }
1082
1083   $main::lxdebug->leave_sub();
1084   return $res;
1085 }
1086
1087 sub is_xvfb_running {
1088   $main::lxdebug->enter_sub();
1089
1090   my ($self) = @_;
1091
1092   local *IN;
1093   my $dfname = $self->{"userspath"} . "/xvfb_display";
1094   my $display;
1095
1096   $main::lxdebug->message(LXDebug::DEBUG2, "    Looking for $dfname\n");
1097   if ((-f $dfname) && open(IN, $dfname)) {
1098     my $pid = <IN>;
1099     chomp($pid);
1100     $display = <IN>;
1101     chomp($display);
1102     my $xauthority = <IN>;
1103     chomp($xauthority);
1104     close(IN);
1105
1106     $main::lxdebug->message(LXDebug::DEBUG2, "      found with $pid and $display\n");
1107
1108     if ((! -d "/proc/$pid") || !open(IN, "/proc/$pid/cmdline")) {
1109       $main::lxdebug->message(LXDebug::DEBUG2, "  no/wrong process #1\n");
1110       unlink($dfname, $xauthority);
1111       $main::lxdebug->leave_sub();
1112       return undef;
1113     }
1114     my $line = <IN>;
1115     close(IN);
1116     if ($line !~ /xvfb/i) {
1117       $main::lxdebug->message(LXDebug::DEBUG2, "      no/wrong process #2\n");
1118       unlink($dfname, $xauthority);
1119       $main::lxdebug->leave_sub();
1120       return undef;
1121     }
1122
1123     $ENV{"XAUTHORITY"} = $xauthority;
1124     $ENV{"DISPLAY"} = $display;
1125   } else {
1126     $main::lxdebug->message(LXDebug::DEBUG2, "      not found\n");
1127   }
1128
1129   $main::lxdebug->leave_sub();
1130
1131   return $display;
1132 }
1133
1134 sub spawn_xvfb {
1135   $main::lxdebug->enter_sub();
1136
1137   my ($self) = @_;
1138
1139   $main::lxdebug->message(LXDebug::DEBUG2, "spawn_xvfb()\n");
1140
1141   my $display = $self->is_xvfb_running();
1142
1143   if ($display) {
1144     $main::lxdebug->leave_sub();
1145     return $display;
1146   }
1147
1148   $display = 99;
1149   while ( -f "/tmp/.X${display}-lock") {
1150     $display++;
1151   }
1152   $display = ":${display}";
1153   $main::lxdebug->message(LXDebug::DEBUG2, "  display $display\n");
1154
1155   my $mcookie = `mcookie`;
1156   die("Installation error: mcookie not found.") if ($? != 0);
1157   chomp($mcookie);
1158
1159   $main::lxdebug->message(LXDebug::DEBUG2, "  mcookie $mcookie\n");
1160
1161   my $xauthority = "/tmp/.Xauthority-" . $$ . "-" . time() . "-" . int(rand(9999999));
1162   $ENV{"XAUTHORITY"} = $xauthority;
1163
1164   $main::lxdebug->message(LXDebug::DEBUG2, "  xauthority $xauthority\n");
1165
1166   system("xauth add \"${display}\" . \"${mcookie}\"");
1167   if ($? != 0) {
1168     $self->{"error"} = "Conversion to PDF failed because OpenOffice could not be started (xauth: $!)";
1169     $main::lxdebug->leave_sub();
1170     return undef;
1171   }
1172
1173   $main::lxdebug->message(LXDebug::DEBUG2, "  about to fork()\n");
1174
1175   my $pid = fork();
1176   if (0 == $pid) {
1177     $main::lxdebug->message(LXDebug::DEBUG2, "  Child execing\n");
1178     exec($main::xvfb_bin, $display, "-screen", "0", "640x480x8", "-nolisten", "tcp");
1179   }
1180   sleep(3);
1181   $main::lxdebug->message(LXDebug::DEBUG2, "  parent dont sleeping\n");
1182
1183   local *OUT;
1184   my $dfname = $self->{"userspath"} . "/xvfb_display";
1185   if (!open(OUT, ">$dfname")) {
1186     $self->{"error"} = "Conversion to PDF failed because OpenOffice could not be started ($dfname: $!)";
1187     unlink($xauthority);
1188     kill($pid);
1189     $main::lxdebug->leave_sub();
1190     return undef;
1191   }
1192   print(OUT "$pid\n$display\n$xauthority\n");
1193   close(OUT);
1194
1195   $main::lxdebug->message(LXDebug::DEBUG2, "  parent re-testing\n");
1196
1197   if (!$self->is_xvfb_running()) {
1198     $self->{"error"} = "Conversion to PDF failed because OpenOffice could not be started.";
1199     unlink($xauthority, $dfname);
1200     kill($pid);
1201     $main::lxdebug->leave_sub();
1202     return undef;
1203   }
1204
1205   $main::lxdebug->message(LXDebug::DEBUG2, "  spawn OK\n");
1206
1207   $main::lxdebug->leave_sub();
1208
1209   return $display;
1210 }
1211
1212 sub is_openoffice_running {
1213   $main::lxdebug->enter_sub();
1214
1215   system("./scripts/oo-uno-test-conn.py $main::openofficeorg_daemon_port " .
1216          "> /dev/null 2> /dev/null");
1217   my $res = $? == 0;
1218   $main::lxdebug->message(LXDebug::DEBUG2, "  is_openoffice_running(): $?\n");
1219
1220   $main::lxdebug->leave_sub();
1221
1222   return $res;
1223 }
1224
1225 sub spawn_openoffice {
1226   $main::lxdebug->enter_sub();
1227
1228   my ($self) = @_;
1229
1230   $main::lxdebug->message(LXDebug::DEBUG2, "spawn_openoffice()\n");
1231
1232   my ($try, $spawned_oo, $res);
1233
1234   $res = 0;
1235   for ($try = 0; $try < 15; $try++) {
1236     if ($self->is_openoffice_running()) {
1237       $res = 1;
1238       last;
1239     }
1240
1241     if (!$spawned_oo) {
1242       my $pid = fork();
1243       if (0 == $pid) {
1244         $main::lxdebug->message(LXDebug::DEBUG2, "  Child daemonizing\n");
1245         chdir('/');
1246         open(STDIN, '/dev/null');
1247         open(STDOUT, '>/dev/null');
1248         my $new_pid = fork();
1249         exit if ($new_pid);
1250         my $ssres = setsid();
1251         $main::lxdebug->message(LXDebug::DEBUG2, "  Child execing\n");
1252         my @cmdline = ($main::openofficeorg_writer_bin,
1253                        "-minimized", "-norestore", "-nologo", "-nolockcheck",
1254                        "-headless",
1255                        "-accept=socket,host=localhost,port=" .
1256                        $main::openofficeorg_daemon_port . ";urp;");
1257         exec(@cmdline);
1258       }
1259
1260       $main::lxdebug->message(LXDebug::DEBUG2, "  Parent after fork\n");
1261       $spawned_oo = 1;
1262       sleep(3);
1263     }
1264
1265     sleep($try >= 5 ? 2 : 1);
1266   }
1267
1268   if (!$res) {
1269     $self->{"error"} = "Conversion from OpenDocument to PDF failed because " .
1270       "OpenOffice could not be started.";
1271   }
1272
1273   $main::lxdebug->leave_sub();
1274
1275   return $res;
1276 }
1277
1278 sub convert_to_pdf {
1279   $main::lxdebug->enter_sub();
1280
1281   my ($self) = @_;
1282
1283   my $form = $self->{"form"};
1284
1285   my $filename = $form->{"tmpfile"};
1286   $filename =~ s/.odt$//;
1287   if (substr($filename, 0, 1) ne "/") {
1288     $filename = getcwd() . "/${filename}";
1289   }
1290
1291   if (substr($self->{"userspath"}, 0, 1) eq "/") {
1292     $ENV{'HOME'} = $self->{"userspath"};
1293   } else {
1294     $ENV{'HOME'} = getcwd() . "/" . $self->{"userspath"};
1295   }
1296
1297   if (!$self->spawn_xvfb()) {
1298     $main::lxdebug->leave_sub();
1299     return 0;
1300   }
1301
1302   my @cmdline;
1303   if (!$main::openofficeorg_daemon) {
1304     @cmdline = ($main::openofficeorg_writer_bin,
1305                 "-minimized", "-norestore", "-nologo", "-nolockcheck",
1306                 "-headless",
1307                 "file:${filename}.odt",
1308                 "macro://" . (split('/', $filename))[-1] .
1309                 "/Standard.Conversion.ConvertSelfToPDF()");
1310   } else {
1311     if (!$self->spawn_openoffice()) {
1312       $main::lxdebug->leave_sub();
1313       return 0;
1314     }
1315
1316     @cmdline = ("./scripts/oo-uno-convert-pdf.py",
1317                 $main::openofficeorg_daemon_port,
1318                 "${filename}.odt");
1319   }
1320
1321   system(@cmdline);
1322
1323   my $res = $?;
1324   if (0 == $?) {
1325     $form->{"tmpfile"} =~ s/odt$/pdf/;
1326
1327     unlink($filename . ".odt");
1328
1329     $main::lxdebug->leave_sub();
1330     return 1;
1331
1332   }
1333
1334   unlink($filename . ".odt", $filename . ".pdf");
1335   $self->{"error"} = "Conversion from OpenDocument to PDF failed. " .
1336     "Exit code: $res";
1337
1338   $main::lxdebug->leave_sub();
1339   return 0;
1340 }
1341
1342 sub format_string {
1343   my ($self, $variable) = @_;
1344   my $form = $self->{"form"};
1345   my $iconv = $self->{"iconv"};
1346
1347   $variable = $main::locale->quote_special_chars('Template/OpenDocument', $variable);
1348
1349   # Allow some HTML markup to be converted into the output format's
1350   # corresponding markup code, e.g. bold or italic.
1351   my $rnd = $self->{"rnd"};
1352   my %markup_replace = ("b" => "BOLD", "i" => "ITALIC", "s" => "STRIKETHROUGH",
1353                         "u" => "UNDERLINE", "sup" => "SUPER", "sub" => "SUB");
1354
1355   foreach my $key (keys(%markup_replace)) {
1356     my $value = $markup_replace{$key};
1357     $variable =~ s|\&lt;${key}\&gt;|<text:span text:style-name=\"TLXO${rnd}${value}\">|gi; #"
1358     $variable =~ s|\&lt;/${key}\&gt;|</text:span>|gi;
1359   }
1360
1361   return $iconv->convert($variable);
1362 }
1363
1364 sub get_mime_type() {
1365   if ($self->{"form"}->{"format"} =~ /pdf/) {
1366     return "application/pdf";
1367   } else {
1368     return "application/vnd.oasis.opendocument.text";
1369   }
1370 }
1371
1372 sub uses_temp_file {
1373   return 1;
1374 }
1375
1376
1377 ##########################################################
1378 ####
1379 #### XMLTemplate
1380 ####
1381 ##########################################################
1382
1383 package XMLTemplate;
1384
1385 use vars qw(@ISA);
1386
1387 @ISA = qw(HTMLTemplate);
1388
1389 sub new {
1390   #evtl auskommentieren
1391   my $type = shift;
1392
1393   return $type->SUPER::new(@_);
1394 }
1395
1396 sub format_string {
1397   my ($self, $variable) = @_;
1398   my $form = $self->{"form"};
1399
1400   $variable = $main::locale->quote_special_chars('Template/XML', $variable);
1401
1402   # Allow no markup to be converted into the output format
1403   my @markup_replace = ('b', 'i', 's', 'u', 'sub', 'sup');
1404
1405   foreach my $key (@markup_replace) {
1406     $variable =~ s/\&lt;(\/?)${key}\&gt;//g;
1407   }
1408
1409   return $variable;
1410 }
1411
1412 sub get_mime_type() {
1413   my ($self) = @_;
1414
1415   if ($self->{"form"}->{"format"} =~ /elsterwinston/i) {
1416     return "application/xml ";
1417   } elsif ($self->{"form"}->{"format"} =~ /elstertaxbird/i) {
1418     return "application/x-taxbird";
1419   } else {
1420     return "text";
1421   }
1422 }
1423
1424 sub uses_temp_file {
1425   # tempfile needet for XML Output
1426   return 1;
1427 }
1428
1429 1;