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