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