SL/Template.pm

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