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