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
  52 sub cleanup {
  53   my ($self) = @_;
  54 }
  55
  56 # Parameters:
  57 #   1. A typeglob for the file handle. The output will be written
  58 #      to this file handle.
  59 #
  60 # Returns:
  61 #   1 on success and undef or 0 if there was an error. In the latter case
  62 #   the calling function can retrieve the error message via $obj->get_error()
  63 sub parse {
  64   my $self = $_[0];
  65   local *OUT = $_[1];
  66
  67   print(OUT "Hallo!\n");
  68 }
  69
  70 sub get_error {
  71   my $self = shift;
  72
  73   return $self->{"error"};
  74 }
  75
  76 sub uses_temp_file {
  77   return 0;
  78 }
  79
  80 1;
  81
  82 ####
  83 #### LaTeXTemplate
  84 ####
  85
  86 package LaTeXTemplate;
  87
  88 use vars qw(@ISA);
  89
  90 @ISA = qw(SimpleTemplate);
  91
  92 sub new {
  93   my $type = shift;
  94
  95   return $type->SUPER::new(@_);
  96 }
  97
  98 sub format_string {
  99   my ($self, $variable) = @_;
 100   my $form = $self->{"form"};
 101
 102   $variable = $main::locale->quote_special_chars('Template/LaTeX', $variable);
 103
 104   # Allow some HTML markup to be converted into the output format's
 105   # corresponding markup code, e.g. bold or italic.
 106   my %markup_replace = ('b' => 'textbf',
 107                         'i' => 'textit',
 108                         'u' => 'underline');
 109
 110   foreach my $key (keys(%markup_replace)) {
 111     my $new = $markup_replace{$key};
 112     $variable =~ s/\$\<\$${key}\$\>\$(.*?)\$<\$\/${key}\$>\$/\\${new}\{$1\}/gi;
 113   }
 114
 115   $variable =~ s/[\x00-\x1f]//g;
 116
 117   return $variable;
 118 }
 119
 120 sub substitute_vars {
 121   my ($self, $text, @indices) = @_;
 122
 123   my $form = $self->{"form"};
 124
 125   while ($text =~ /$self->{tag_start_qm}(.+?)$self->{tag_end_qm}/) {
 126     my ($tag_pos, $tag_len) = ($-[0], $+[0] - $-[0]);
 127     my ($var, @options) = split(/\s+/, $1);
 128     my $value = $form->{$var};
 129
 130     for (my $i = 0; $i < scalar(@indices); $i++) {
 131       last unless (ref($value) eq "ARRAY");
 132       $value = $value->[$indices[$i]];
 133     }
 134     $value = $self->format_string($value) unless (grep(/^NOESCAPE$/, @options));
 135     substr($text, $tag_pos, $tag_len) = $value;
 136   }
 137
 138   return $text;
 139 }
 140
 141 sub parse_foreach {
 142   my ($self, $var, $text, $start_tag, $end_tag, @indices) = @_;
 143
 144   my ($form, $new_contents) = ($self->{"form"}, "");
 145
 146   my $ary = $form->{$var};
 147   for (my $i = 0; $i < scalar(@indices); $i++) {
 148     last unless (ref($ary) eq "ARRAY");
 149     $ary = $ary->[$indices[$i]];
 150   }
 151
 152   my $sum = 0;
 153   my $current_page = 1;
 154   my ($current_line, $corrent_row) = (0, 1);
 155
 156   for (my $i = 0; $i < scalar(@{$ary}); $i++) {
 157     $form->{"__first__"} = $i == 0;
 158     $form->{"__last__"} = ($i + 1) == scalar(@{$ary});
 159     $form->{"__odd__"} = (($i + 1) % 2) == 1;
 160     $form->{"__counter__"} = $i + 1;
 161
 162     if ((scalar(@{$form->{"description"}}) == scalar(@{$ary})) &&
 163         $self->{"chars_per_line"}) {
 164       my $lines =
 165         int(length($form->{"description"}->[$i]) / $self->{"chars_per_line"});
 166       my $lpp;
 167
 168       $form->{"description"}->[$i] =~ s/(\\newline\s?)*$//;
 169       my $_description = $form->{"description"}->[$i];
 170       while ($_description =~ /\\newline/) {
 171         $lines++;
 172         $_description =~ s/\\newline//;
 173       }
 174       $lines++;
 175
 176       if ($current_page == 1) {
 177         $lpp = $self->{"lines_on_first_page"};
 178       } else {
 179         $lpp = $self->{"lines_on_second_page"};
 180       }
 181
 182       # Yes we need a manual page break -- or the user has forced one
 183       if ((($current_line + $lines) > $lpp) || ($form->{"description"}->[$i] =~ /<pagebreak>/) || ($form->{"longdescription"}->[$i] =~ /<pagebreak>/)) {
 184         my $pb = $self->{"pagebreak_block"};
 185
 186         # replace the special variables <%sumcarriedforward%>
 187         # and <%lastpage%>
 188
 189         my $psum = $form->format_amount($self->{"myconfig"}, $sum, 2);
 190         $pb =~ s/$self->{tag_start_qm}sumcarriedforward$self->{tag_end_qm}/$psum/g;
 191         $pb =~ s/$self->{tag_start_qm}lastpage$self->{tag_end_qm}/$current_page/g;
 192
 193         my $new_text = $self->parse_block($pb, (@indices, $i));
 194         return undef unless (defined($new_text));
 195         $new_contents .= $new_text;
 196
 197         $current_page++;
 198         $current_line = 0;
 199       }
 200       $current_line += $lines;
 201     }
 202     if ($i < scalar(@{$form->{"linetotal"}})) {
 203       $sum += $form->parse_amount($self->{"myconfig"},
 204                                   $form->{"linetotal"}->[$i]);
 205     }
 206
 207     $form->{"cumulatelinetotal"}[$i] = $form->format_amount($self->{"myconfig"}, $sum, 2);
 208
 209     my $new_text = $self->parse_block($text, (@indices, $i));
 210     return undef unless (defined($new_text));
 211     $new_contents .= $start_tag . $new_text . $end_tag;
 212   }
 213   map({ delete($form->{"__${_}__"}); } qw(first last odd counter));
 214
 215   return $new_contents;
 216 }
 217
 218 sub find_end {
 219   my ($self, $text, $pos, $var, $not) = @_;
 220
 221   my $tag_start_len = length $self->{tag_start};
 222
 223   my $depth = 1;
 224   $pos = 0 unless ($pos);
 225
 226   while ($pos < length($text)) {
 227     $pos++;
 228
 229     next if (substr($text, $pos - 1, length($self->{tag_start})) ne $self->{tag_start});
 230
 231     my $keyword_pos = $pos - 1 + $tag_start_len;
 232
 233     if ((substr($text, $keyword_pos, 2) eq 'if') || (substr($text, $keyword_pos, 3) eq 'for')) {
 234       $depth++;
 235
 236     } elsif ((substr($text, $keyword_pos, 4) eq 'else') && (1 == $depth)) {
 237       if (!$var) {
 238         $self->{"error"} =
 239             "$self->{tag_start}else$self->{tag_end} outside of "
 240           . "$self->{tag_start}if$self->{tag_end} / "
 241           . "$self->{tag_start}ifnot$self->{tag_end}.";
 242         return undef;
 243       }
 244
 245       my $block = substr($text, 0, $pos - 1);
 246       substr($text, 0, $pos - 1) = "";
 247       $text =~ s!^$self->{tag_start_qm}.+?$self->{tag_end_qm}!!;
 248       $text =  $self->{tag_start} . 'if' . ($not ?  " " : "not ") . $var . $self->{tag_end} . $text;
 249
 250       return ($block, $text);
 251
 252     } elsif (substr($text, $keyword_pos, 3) eq 'end') {
 253       $depth--;
 254       if ($depth == 0) {
 255         my $block = substr($text, 0, $pos - 1);
 256         substr($text, 0, $pos - 1) = "";
 257         $text =~ s!^$self->{tag_start_qm}.+?$self->{tag_end_qm}!!;
 258
 259         return ($block, $text);
 260       }
 261     }
 262   }
 263
 264   return undef;
 265 }
 266
 267 sub parse_block {
 268   $main::lxdebug->enter_sub();
 269
 270   my ($self, $contents, @indices) = @_;
 271
 272   my $new_contents = "";
 273
 274   while ($contents ne "") {
 275     my $pos_if      = index($contents, $self->{tag_start} . 'if');
 276     my $pos_foreach = index($contents, $self->{tag_start} . 'foreach');
 277
 278     if ((-1 == $pos_if) && (-1 == $pos_foreach)) {
 279       $new_contents .= $self->substitute_vars($contents, @indices);
 280       last;
 281     }
 282
 283     if ((-1 == $pos_if) || ((-1 != $pos_foreach) && ($pos_if > $pos_foreach))) {
 284       $new_contents .= $self->substitute_vars(substr($contents, 0, $pos_foreach), @indices);
 285       substr($contents, 0, $pos_foreach) = "";
 286
 287       if ($contents !~ m|^$self->{tag_start_qm}foreach (.+?)$self->{tag_end_qm}|) {
 288         $self->{"error"} = "Malformed $self->{tag_start}foreach$self->{tag_end}.";
 289         $main::lxdebug->leave_sub();
 290         return undef;
 291       }
 292
 293       my $var = $1;
 294
 295       substr($contents, 0, length($&)) = "";
 296
 297       my $block;
 298       ($block, $contents) = $self->find_end($contents);
 299       if (!$block) {
 300         $self->{"error"} = "Unclosed $self->{tag_start}foreach$self->{tag_end}." unless ($self->{"error"});
 301         $main::lxdebug->leave_sub();
 302         return undef;
 303       }
 304
 305       my $new_text = $self->parse_foreach($var, $block, "", "", @indices);
 306       if (!defined($new_text)) {
 307         $main::lxdebug->leave_sub();
 308         return undef;
 309       }
 310       $new_contents .= $new_text;
 311
 312     } else {
 313       $new_contents .= $self->substitute_vars(substr($contents, 0, $pos_if), @indices);
 314       substr($contents, 0, $pos_if) = "";
 315
 316       if ($contents !~ m|^$self->{tag_start_qm}if\s*(not)?\s+(.*?)$self->{tag_end_qm}|) {
 317         $self->{"error"} = "Malformed $self->{tag_start}if$self->{tag_end}.";
 318         $main::lxdebug->leave_sub();
 319         return undef;
 320       }
 321
 322       my ($not, $var) = ($1, $2);
 323
 324       substr($contents, 0, length($&)) = "";
 325
 326       ($block, $contents) = $self->find_end($contents, 0, $var, $not);
 327       if (!$block) {
 328         $self->{"error"} = "Unclosed $self->{tag_start}if${not}$self->{tag_end}." unless ($self->{"error"});
 329         $main::lxdebug->leave_sub();
 330         return undef;
 331       }
 332
 333       my $value = $self->{"form"}->{$var};
 334       for (my $i = 0; $i < scalar(@indices); $i++) {
 335         last unless (ref($value) eq "ARRAY");
 336         $value = $value->[$indices[$i]];
 337       }
 338
 339       if (($not && !$value) || (!$not && $value)) {
 340         my $new_text = $self->parse_block($block, @indices);
 341         if (!defined($new_text)) {
 342           $main::lxdebug->leave_sub();
 343           return undef;
 344         }
 345         $new_contents .= $new_text;
 346       }
 347     }
 348   }
 349
 350   $main::lxdebug->leave_sub();
 351
 352   return $new_contents;
 353 }
 354
 355 sub parse_first_line {
 356   my $self = shift;
 357   my $line = shift || "";
 358
 359   if ($line =~ m/([^\s]+)set-tag-style([^\s]+)/) {
 360     if ($1 eq $2) {
 361       $self->{error} = "The tag start and end markers must not be equal.";
 362       return 0;
 363     }
 364
 365     $self->set_tag_style($1, $2);
 366   }
 367
 368   return 1;
 369 }
 370
 371 sub _parse_config_option {
 372   my $self = shift;
 373   my $line = shift;
 374
 375   $line =~ s/^\s*//;
 376   $line =~ s/\s*$//;
 377
 378   my ($key, $value) = split m/\s*=\s*/, $line, 2;
 379
 380   if ($key eq 'tag-style') {
 381     $self->set_tag_style(split(m/\s+/, $value, 2));
 382   }
 383 }
 384
 385 sub _parse_config_lines {
 386   my $self  = shift;
 387   my $lines = shift;
 388
 389   my ($comment_start, $comment_end) = ("", "");
 390
 391   if (ref $self eq 'LaTeXTemplate') {
 392     $comment_start = '\s*%';
 393   } elsif (ref $self eq 'HTMLTemplate') {
 394     $comment_start = '\s*<!--';
 395     $comment_end   = '>\s*';
 396   } else {
 397     $comment_start = '\s*\#';
 398   }
 399
 400   my $num_lines = scalar @{ $lines };
 401   my $i         = 0;
 402
 403   while ($i < $num_lines) {
 404     my $line = $lines->[$i];
 405
 406     if ($line !~ m/^${comment_start}\s*config\s*:(.*)${comment_end}$/i) {
 407       $i++;
 408       next;
 409     }
 410
 411     $self->_parse_config_option($1);
 412     splice @{ $lines }, $i, 1;
 413     $num_lines--;
 414   }
 415 }
 416
 417 sub _force_mandatory_packages {
 418   my $self  = shift;
 419   my $lines = shift;
 420
 421   my (%used_packages, $document_start_line);
 422
 423   foreach my $i (0 .. scalar @{ $lines } - 1) {
 424     if ($lines->[$i] =~ m/\\usepackage[^{]*{(.*?)}/) {
 425       $used_packages{$1} = 1;
 426
 427     } elsif ($lines->[$i] =~ m/\\begin{document}/) {
 428       $document_start_line = $i;
 429       last;
 430
 431     }
 432   }
 433
 434   $document_start_line = scalar @{ $lines } - 1 if (!defined $document_start_line);
 435
 436   if (!$used_packages{textcomp}) {
 437     splice @{ $lines }, $document_start_line, 0, "\\usepackage{textcomp}\n";
 438     $document_start_line++;
 439   }
 440 }
 441
 442 sub parse {
 443   my $self = $_[0];
 444   local *OUT = $_[1];
 445   my $form = $self->{"form"};
 446
 447   if (!open(IN, "$form->{templates}/$form->{IN}")) {
 448     $self->{"error"} = "$!";
 449     return 0;
 450   }
 451   my @lines = <IN>;
 452   close(IN);
 453
 454   $self->_parse_config_lines(\@lines);
 455   $self->_force_mandatory_packages(\@lines) if (ref $self eq 'LaTeXTemplate');
 456
 457   my $contents = join("", @lines);
 458
 459   # detect pagebreak block and its parameters
 460   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) {
 461     $self->{"chars_per_line"} = $1;
 462     $self->{"lines_on_first_page"} = $2;
 463     $self->{"lines_on_second_page"} = $3;
 464     $self->{"pagebreak_block"} = $4;
 465
 466     substr($contents, length($`), length($&)) = "";
 467   }
 468
 469   $self->{"forced_pagebreaks"} = [];
 470
 471   my $new_contents = $self->parse_block($contents);
 472   if (!defined($new_contents)) {
 473     $main::lxdebug->leave_sub();
 474     return 0;
 475   }
 476
 477   print(OUT $new_contents);
 478
 479   if ($form->{"format"} =~ /postscript/i) {
 480     return $self->convert_to_postscript();
 481   } elsif ($form->{"format"} =~ /pdf/i) {
 482     return $self->convert_to_pdf();
 483   } else {
 484     return 1;
 485   }
 486 }
 487
 488 sub convert_to_postscript {
 489   my ($self) = @_;
 490   my ($form, $userspath) = ($self->{"form"}, $self->{"userspath"});
 491
 492   # Convert the tex file to postscript
 493
 494   if (!chdir("$userspath")) {
 495     $self->{"error"} = "chdir : $!";
 496     $self->cleanup();
 497     return 0;
 498   }
 499
 500   $form->{tmpfile} =~ s/\Q$userspath\E\///g;
 501
 502   for (my $run = 1; $run <= 2; $run++) {
 503     system("latex --interaction=nonstopmode $form->{tmpfile} " .
 504            "> $form->{tmpfile}.err");
 505     if ($?) {
 506       $self->{"error"} = $form->cleanup();
 507       $self->cleanup();
 508       return 0;
 509     }
 510   }
 511
 512   $form->{tmpfile} =~ s/tex$/dvi/;
 513
 514   system("dvips $form->{tmpfile} -o -q > /dev/null");
 515   if ($?) {
 516     $self->{"error"} = "dvips : $!";
 517     $self->cleanup();
 518     return 0;
 519   }
 520   $form->{tmpfile} =~ s/dvi$/ps/;
 521
 522   $self->cleanup();
 523
 524   return 1;
 525 }
 526
 527 sub convert_to_pdf {
 528   my ($self) = @_;
 529   my ($form, $userspath) = ($self->{"form"}, $self->{"userspath"});
 530
 531   # Convert the tex file to PDF
 532
 533   if (!chdir("$userspath")) {
 534     $self->{"error"} = "chdir : $!";
 535     $self->cleanup();
 536     return 0;
 537   }
 538
 539   $form->{tmpfile} =~ s/\Q$userspath\E\///g;
 540
 541   for (my $run = 1; $run <= 2; $run++) {
 542     system("pdflatex --interaction=nonstopmode $form->{tmpfile} " .
 543            "> $form->{tmpfile}.err");
 544     if ($?) {
 545       $self->{"error"} = $form->cleanup();
 546       $self->cleanup();
 547       return 0;
 548     }
 549   }
 550
 551   $form->{tmpfile} =~ s/tex$/pdf/;
 552
 553   $self->cleanup();
 554 }
 555
 556 sub get_mime_type() {
 557   my ($self) = @_;
 558
 559   if ($self->{"form"}->{"format"} =~ /postscript/i) {
 560     return "application/postscript";
 561   } else {
 562     return "application/pdf";
 563   }
 564 }
 565
 566 sub uses_temp_file {
 567   return 1;
 568 }
 569
 570
 571 ####
 572 #### HTMLTemplate
 573 ####
 574
 575 package HTMLTemplate;
 576
 577 use vars qw(@ISA);
 578
 579 @ISA = qw(LaTeXTemplate);
 580
 581 sub new {
 582   my $type = shift;
 583
 584   return $type->SUPER::new(@_);
 585 }
 586
 587 sub format_string {
 588   my ($self, $variable) = @_;
 589   my $form = $self->{"form"};
 590
 591   $variable = $main::locale->quote_special_chars('Template/HTML', $variable);
 592
 593   # Allow some HTML markup to be converted into the output format's
 594   # corresponding markup code, e.g. bold or italic.
 595   my @markup_replace = ('b', 'i', 's', 'u', 'sub', 'sup');
 596
 597   foreach my $key (@markup_replace) {
 598     $variable =~ s/\&lt;(\/?)${key}\&gt;/<$1${key}>/g;
 599   }
 600
 601   return $variable;
 602 }
 603
 604 sub get_mime_type() {
 605   my ($self) = @_;
 606
 607   if ($self->{"form"}->{"format"} =~ /postscript/i) {
 608     return "application/postscript";
 609   } elsif ($self->{"form"}->{"format"} =~ /pdf/i) {
 610     return "application/pdf";
 611   } else {
 612     return "text/html";
 613   }
 614 }
 615
 616 sub uses_temp_file {
 617   my ($self) = @_;
 618
 619   if ($self->{"form"}->{"format"} =~ /postscript/i) {
 620     return 1;
 621   } elsif ($self->{"form"}->{"format"} =~ /pdf/i) {
 622     return 1;
 623   } else {
 624     return 0;
 625   }
 626 }
 627
 628 sub convert_to_postscript {
 629   my ($self) = @_;
 630   my ($form, $userspath) = ($self->{"form"}, $self->{"userspath"});
 631
 632   # Convert the HTML file to postscript
 633
 634   if (!chdir("$userspath")) {
 635     $self->{"error"} = "chdir : $!";
 636     $self->cleanup();
 637     return 0;
 638   }
 639
 640   $form->{"tmpfile"} =~ s/\Q$userspath\E\///g;
 641   my $psfile = $form->{"tmpfile"};
 642   $psfile =~ s/.html/.ps/;
 643   if ($psfile eq $form->{"tmpfile"}) {
 644     $psfile .= ".ps";
 645   }
 646
 647   system("html2ps -f html2ps-config < $form->{tmpfile} > $psfile");
 648   if ($?) {
 649     $self->{"error"} = $form->cleanup();
 650     $self->cleanup();
 651     return 0;
 652   }
 653
 654   $form->{"tmpfile"} = $psfile;
 655
 656   $self->cleanup();
 657
 658   return 1;
 659 }
 660
 661 sub convert_to_pdf {
 662   my ($self) = @_;
 663   my ($form, $userspath) = ($self->{"form"}, $self->{"userspath"});
 664
 665   # Convert the HTML file to PDF
 666
 667   if (!chdir("$userspath")) {
 668     $self->{"error"} = "chdir : $!";
 669     $self->cleanup();
 670     return 0;
 671   }
 672
 673   $form->{"tmpfile"} =~ s/\Q$userspath\E\///g;
 674   my $pdffile = $form->{"tmpfile"};
 675   $pdffile =~ s/.html/.pdf/;
 676   if ($pdffile eq $form->{"tmpfile"}) {
 677     $pdffile .= ".pdf";
 678   }
 679
 680   system("html2ps -f html2ps-config < $form->{tmpfile} | ps2pdf - $pdffile");
 681   if ($?) {
 682     $self->{"error"} = $form->cleanup();
 683     $self->cleanup();
 684     return 0;
 685   }
 686
 687   $form->{"tmpfile"} = $pdffile;
 688
 689   $self->cleanup();
 690
 691   return 1;
 692 }
 693
 694
 695 ####
 696 #### PlainTextTemplate
 697 ####
 698
 699 package PlainTextTemplate;
 700
 701 use vars qw(@ISA);
 702
 703 @ISA = qw(LaTeXTemplate);
 704
 705 sub new {
 706   my $type = shift;
 707
 708   return $type->SUPER::new(@_);
 709 }
 710
 711 sub format_string {
 712   my ($self, $variable) = @_;
 713
 714   return $variable;
 715 }
 716
 717 sub get_mime_type {
 718   return "text/plain";
 719 }
 720
 721 sub parse {
 722 }
 723
 724 1;
 725
 726 ####
 727 #### OpenDocumentTemplate
 728 ####
 729
 730 package OpenDocumentTemplate;
 731
 732 use POSIX 'setsid';
 733 use vars qw(@ISA);
 734
 735 use Cwd;
 736 # use File::Copy;
 737 # use File::Spec;
 738 # use File::Temp qw(:mktemp);
 739 use IO::File;
 740
 741 @ISA = qw(SimpleTemplate);
 742
 743 sub new {
 744   my $type = shift;
 745
 746   $self = $type->SUPER::new(@_);
 747
 748   foreach my $module (qw(Archive::Zip Text::Iconv)) {
 749     eval("use ${module};");
 750     if ($@) {
 751       $self->{"form"}->error("The Perl module '${module}' could not be " .
 752                              "loaded. Support for OpenDocument templates " .
 753                              "does not work without it. Please install your " .
 754                              "distribution's package or get the module from " .
 755                              "CPAN ( http://www.cpan.org ).");
 756     }
 757   }
 758
 759   $self->{"rnd"} = int(rand(1000000));
 760   $self->{"iconv"} = Text::Iconv->new($main::dbcharset, "UTF-8");
 761
 762   return $self;
 763 }
 764
 765 sub substitute_vars {
 766   my ($self, $text, @indices) = @_;
 767
 768   my $form = $self->{"form"};
 769
 770   while ($text =~ /\&lt;\%(.*?)\%\&gt;/) {
 771     my $value = $form->{$1};
 772
 773     for (my $i = 0; $i < scalar(@indices); $i++) {
 774       last unless (ref($value) eq "ARRAY");
 775       $value = $value->[$indices[$i]];
 776     }
 777     substr($text, $-[0], $+[0] - $-[0]) = $self->format_string($value);
 778   }
 779
 780   return $text;
 781 }
 782
 783 sub parse_foreach {
 784   my ($self, $var, $text, $start_tag, $end_tag, @indices) = @_;
 785
 786   my ($form, $new_contents) = ($self->{"form"}, "");
 787
 788   my $ary = $form->{$var};
 789   for (my $i = 0; $i < scalar(@indices); $i++) {
 790     last unless (ref($ary) eq "ARRAY");
 791     $ary = $ary->[$indices[$i]];
 792   }
 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;