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