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