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 #
  10 #    NOTE: strict checks are package global. don't check this file
  11 #            with perl -sc, it will only capture SimpleTemplate
  12 #
  13 #
  14
  15 package SimpleTemplate;
  16
  17 use strict;
  18
  19 # Parameters:
  20 #   1. The template's file name
  21 #   2. A reference to the Form object
  22 #   3. A reference to the myconfig hash
  23 #
  24 # Returns:
  25 #   A new template object
  26 sub new {
  27   my $type = shift;
  28   my $self = {};
  29
  30   bless($self, $type);
  31   $self->_init(@_);
  32
  33   return $self;
  34 }
  35
  36 sub _init {
  37   my $self = shift;
  38
  39   $self->{source}    = shift;
  40   $self->{form}      = shift;
  41   $self->{myconfig}  = shift;
  42   $self->{userspath} = shift;
  43
  44   $self->{error}     = undef;
  45   $self->{quot_re}   = '"';
  46
  47   $self->set_tag_style('<%', '%>');
  48 }
  49
  50 sub set_tag_style {
  51   my $self                    = shift;
  52   my $tag_start               = shift;
  53   my $tag_end                 = shift;
  54
  55   $self->{tag_start}          = $tag_start;
  56   $self->{tag_end}            = $tag_end;
  57   $self->{tag_start_qm}       = quotemeta $tag_start;
  58   $self->{tag_end_qm}         = quotemeta $tag_end;
  59
  60   $self->{substitute_vars_re} = "$self->{tag_start_qm}(.+?)$self->{tag_end_qm}";
  61 }
  62
  63 sub cleanup {
  64   my ($self) = @_;
  65 }
  66
  67 # Parameters:
  68 #   1. A typeglob for the file handle. The output will be written
  69 #      to this file handle.
  70 #
  71 # Returns:
  72 #   1 on success and undef or 0 if there was an error. In the latter case
  73 #   the calling function can retrieve the error message via $obj->get_error()
  74 sub parse {
  75   my $self = $_[0];
  76   local *OUT = $_[1];
  77
  78   print(OUT "Hallo!\n");
  79 }
  80
  81 sub get_error {
  82   my $self = shift;
  83
  84   return $self->{"error"};
  85 }
  86
  87 sub uses_temp_file {
  88   return 0;
  89 }
  90
  91 sub _get_loop_variable {
  92   my $self      = shift;
  93   my $var       = shift;
  94   my $get_array = shift;
  95   my @indices   = @_;
  96
  97   my $form      = $self->{form};
  98   my $value;
  99
 100   if (($get_array || @indices) && (ref $form->{TEMPLATE_ARRAYS} eq 'HASH') && (ref $form->{TEMPLATE_ARRAYS}->{$var} eq 'ARRAY')) {
 101     $value = $form->{TEMPLATE_ARRAYS}->{$var};
 102   } else {
 103     $value = $form->{$var};
 104   }
 105
 106   for (my $i = 0; $i < scalar(@indices); $i++) {
 107     last unless (ref($value) eq "ARRAY");
 108     $value = $value->[$indices[$i]];
 109   }
 110
 111   return $value;
 112 }
 113
 114 sub substitute_vars {
 115   my ($self, $text, @indices) = @_;
 116
 117   my $form = $self->{"form"};
 118
 119   while ($text =~ /$self->{substitute_vars_re}/) {
 120     my ($tag_pos, $tag_len) = ($-[0], $+[0] - $-[0]);
 121     my ($var, @options)     = split(/\s+/, $1);
 122
 123     my $value               = $self->_get_loop_variable($var, 0, @indices);
 124     $value                  = $self->format_string($value) unless (grep(/^NOESCAPE$/, @options));
 125
 126     substr($text, $tag_pos, $tag_len, $value);
 127   }
 128
 129   return $text;
 130 }
 131
 132 sub _parse_block_if {
 133   $main::lxdebug->enter_sub();
 134
 135   my $self         = shift;
 136   my $contents     = shift;
 137   my $new_contents = shift;
 138   my $pos_if       = shift;
 139   my @indices      = @_;
 140
 141   $$new_contents .= $self->substitute_vars(substr($$contents, 0, $pos_if), @indices);
 142   substr($$contents, 0, $pos_if) = "";
 143
 144   if ($$contents !~ m/^$self->{tag_start_qm}if
 145                      \s*
 146                      (not\b|\!)?           # $1 -- Eventuelle Negierung
 147                      \s+
 148                      (\b.+?\b)             # $2 -- Name der zu überprüfenden Variablen
 149                      (                     # $3 -- Beginn des optionalen Vergleiches
 150                        \s*
 151                        ([!=])              # $4 -- Negierung des Vergleiches speichern
 152                        ([=~])              # $5 -- Art des Vergleiches speichern
 153                        \s*
 154                        (                   # $6 -- Gequoteter String oder Bareword
 155                          $self->{quot_re}
 156                          (.*?)(?<!\\)      # $7 -- Gequoteter String -- direkter Vergleich mit eq bzw. ne oder Patternmatching; Escapete Anführungs als Teil des Strings belassen
 157                          $self->{quot_re}
 158                        |
 159                          (\b.+?\b)         # $8 -- Bareword -- als Index für $form benutzen
 160                        )
 161                      )?
 162                      \s*
 163                      $self->{tag_end_qm}
 164                     /x) {
 165     $self->{"error"} = "Malformed $self->{tag_start}if$self->{tag_end}.";
 166     $main::lxdebug->leave_sub();
 167     return undef;
 168   }
 169
 170   my $not           = $1;
 171   my $var           = $2;
 172   my $operator_neg  = $4; # '=' oder '!' oder undef, wenn kein Vergleich erkannt
 173   my $operator_type = $5; # '=' oder '~' für Stringvergleich oder Regex
 174   my $quoted_word   = $7; # nur gültig, wenn quoted string angegeben (siehe unten); dann "value" aus <%if var == "value" %>
 175   my $bareword      = $8; # undef, falls quoted string angegeben wurde; andernfalls "othervar" aus <%if var == othervar %>
 176
 177   $not = !$not if ($operator_neg && $operator_neg eq '!');
 178
 179   substr($$contents, 0, length($&)) = "";
 180
 181   my $block;
 182   ($block, $$contents) = $self->find_end($$contents, 0, $var, $not);
 183   if (!$block) {
 184     $self->{"error"} = "Unclosed $self->{tag_start}if$self->{tag_end}." unless ($self->{"error"});
 185     $main::lxdebug->leave_sub();
 186     return undef;
 187   }
 188
 189   my $value = $self->_get_loop_variable($var, 0, @indices);
 190   my $hit   = 0;
 191
 192   if ($operator_type) {
 193     my $compare_to = $bareword ? $self->_get_loop_variable($bareword, 0, @indices) : $quoted_word;
 194     if ($operator_type eq '=') {
 195       $hit         = ($not && !($value eq $compare_to))     || (!$not && ($value eq $compare_to));
 196     } else {
 197       $hit         = ($not && !($value =~ m/$compare_to/i)) || (!$not && ($value =~ m/$compare_to/i));
 198     }
 199
 200   } else {
 201     $hit           = ($not && ! $value)                     || (!$not &&  $value);
 202   }
 203
 204   if ($hit) {
 205     my $new_text = $self->parse_block($block, @indices);
 206     if (!defined($new_text)) {
 207       $main::lxdebug->leave_sub();
 208       return undef;
 209     }
 210     $$new_contents .= $new_text;
 211   }
 212
 213   $main::lxdebug->leave_sub();
 214
 215   return 1;
 216 }
 217
 218 1;
 219
 220 ####
 221 #### LaTeXTemplate
 222 ####
 223
 224 package LaTeXTemplate;
 225
 226 use vars qw(@ISA);
 227
 228 @ISA = qw(SimpleTemplate);
 229
 230 use strict;
 231
 232 sub new {
 233   my $type = shift;
 234
 235   my $self = $type->SUPER::new(@_);
 236
 237   return $self;
 238 }
 239
 240 sub format_string {
 241   my ($self, $variable) = @_;
 242   my $form = $self->{"form"};
 243
 244   $variable = $main::locale->quote_special_chars('Template/LaTeX', $variable);
 245
 246   # Allow some HTML markup to be converted into the output format's
 247   # corresponding markup code, e.g. bold or italic.
 248   my %markup_replace = ('b' => 'textbf',
 249                         'i' => 'textit',
 250                         'u' => 'underline');
 251
 252   foreach my $key (keys(%markup_replace)) {
 253     my $new = $markup_replace{$key};
 254     $variable =~ s/\$\<\$${key}\$\>\$(.*?)\$<\$\/${key}\$>\$/\\${new}\{$1\}/gi;
 255   }
 256
 257   $variable =~ s/[\x00-\x1f]//g;
 258
 259   return $variable;
 260 }
 261
 262 sub parse_foreach {
 263   my ($self, $var, $text, $start_tag, $end_tag, @indices) = @_;
 264
 265   my ($form, $new_contents) = ($self->{"form"}, "");
 266
 267   my $ary = $self->_get_loop_variable($var, 1, @indices);
 268
 269   my $sum                          = 0;
 270   my $current_page                 = 1;
 271   my ($current_line, $corrent_row) = (0, 1);
 272   my $description_array            = $self->_get_loop_variable("description",     1);
 273   my $longdescription_array        = $self->_get_loop_variable("longdescription", 1);
 274   my $linetotal_array              = $self->_get_loop_variable("linetotal",       1);
 275
 276   $form->{TEMPLATE_ARRAYS}->{cumulatelinetotal} = [];
 277
 278   # forech block hasn't given us an array. ignore
 279   return $new_contents unless ref $ary eq 'ARRAY';
 280
 281   for (my $i = 0; $i < scalar(@{$ary}); $i++) {
 282     # do magic markers
 283     $form->{"__first__"}   = $i == 1;
 284     $form->{"__last__"}    = ($i + 1) == scalar(@{$ary});
 285     $form->{"__odd__"}     = (($i + 1) % 2) == 1;
 286     $form->{"__counter__"} = $i + 1;
 287
 288     if (   ref $description_array       eq 'ARRAY'
 289         && scalar @{$description_array} == scalar @{$ary}
 290         && $self->{"chars_per_line"}    != 0)
 291     {
 292       my $lines = int(length($description_array->[$i]) / $self->{"chars_per_line"});
 293       my $lpp;
 294
 295       $description_array->[$i] =~ s/(\\newline\s?)*$//;
 296       $lines++ while ($description_array->[$i] =~ m/\\newline/g);
 297       $lines++;
 298
 299       if ($current_page == 1) {
 300         $lpp = $self->{"lines_on_first_page"};
 301       } else {
 302         $lpp = $self->{"lines_on_second_page"};
 303       }
 304
 305       # Yes we need a manual page break -- or the user has forced one
 306       if (   (($current_line + $lines) > $lpp)
 307           || ($description_array->[$i]     =~ /<pagebreak>/)
 308           || (   ref $longdescription_array eq 'ARRAY'
 309               && $longdescription_array->[$i] =~ /<pagebreak>/)) {
 310         my $pb = $self->{"pagebreak_block"};
 311
 312         # replace the special variables <%sumcarriedforward%>
 313         # and <%lastpage%>
 314
 315         my $psum = $form->format_amount($self->{"myconfig"}, $sum, 2);
 316         $pb =~ s/$self->{tag_start_qm}sumcarriedforward$self->{tag_end_qm}/$psum/g;
 317         $pb =~ s/$self->{tag_start_qm}lastpage$self->{tag_end_qm}/$current_page/g;
 318
 319         my $new_text = $self->parse_block($pb, (@indices, $i));
 320         return undef unless (defined($new_text));
 321         $new_contents .= $new_text;
 322
 323         $current_page++;
 324         $current_line = 0;
 325       }
 326       $current_line += $lines;
 327     }
 328
 329     if (   ref $linetotal_array eq 'ARRAY'
 330         && $i < scalar(@{$linetotal_array})) {
 331       $sum += $form->parse_amount($self->{"myconfig"}, $linetotal_array->[$i]);
 332     }
 333
 334     $form->{TEMPLATE_ARRAYS}->{cumulatelinetotal}->[$i] = $form->format_amount($self->{"myconfig"}, $sum, 2);
 335
 336     my $new_text = $self->parse_block($text, (@indices, $i));
 337     return undef unless (defined($new_text));
 338     $new_contents .= $start_tag . $new_text . $end_tag;
 339   }
 340   map({ delete($form->{"__${_}__"}); } qw(first last odd counter));
 341
 342   return $new_contents;
 343 }
 344
 345 sub find_end {
 346   my ($self, $text, $pos, $var, $not) = @_;
 347
 348   my $tag_start_len = length $self->{tag_start};
 349
 350   my $depth = 1;
 351   $pos = 0 unless ($pos);
 352
 353   while ($pos < length($text)) {
 354     $pos++;
 355
 356     next if (substr($text, $pos - 1, length($self->{tag_start})) ne $self->{tag_start});
 357
 358     my $keyword_pos = $pos - 1 + $tag_start_len;
 359
 360     if ((substr($text, $keyword_pos, 2) eq 'if') || (substr($text, $keyword_pos, 3) eq 'for')) {
 361       $depth++;
 362
 363     } elsif ((substr($text, $keyword_pos, 4) eq 'else') && (1 == $depth)) {
 364       if (!$var) {
 365         $self->{"error"} =
 366             "$self->{tag_start}else$self->{tag_end} outside of "
 367           . "$self->{tag_start}if$self->{tag_end} / "
 368           . "$self->{tag_start}ifnot$self->{tag_end}.";
 369         return undef;
 370       }
 371
 372       my $block = substr($text, 0, $pos - 1);
 373       substr($text, 0, $pos - 1) = "";
 374       $text =~ s!^$self->{tag_start_qm}.+?$self->{tag_end_qm}!!;
 375       $text =  $self->{tag_start} . 'if' . ($not ?  " " : "not ") . $var . $self->{tag_end} . $text;
 376
 377       return ($block, $text);
 378
 379     } elsif (substr($text, $keyword_pos, 3) eq 'end') {
 380       $depth--;
 381       if ($depth == 0) {
 382         my $block = substr($text, 0, $pos - 1);
 383         substr($text, 0, $pos - 1) = "";
 384         $text =~ s!^$self->{tag_start_qm}.+?$self->{tag_end_qm}!!;
 385
 386         return ($block, $text);
 387       }
 388     }
 389   }
 390
 391   return undef;
 392 }
 393
 394 sub parse_block {
 395   $main::lxdebug->enter_sub();
 396
 397   my ($self, $contents, @indices) = @_;
 398
 399   my $new_contents = "";
 400
 401   while ($contents ne "") {
 402     my $pos_if      = index($contents, $self->{tag_start} . 'if');
 403     my $pos_foreach = index($contents, $self->{tag_start} . 'foreach');
 404
 405     if ((-1 == $pos_if) && (-1 == $pos_foreach)) {
 406       $new_contents .= $self->substitute_vars($contents, @indices);
 407       last;
 408     }
 409
 410     if ((-1 == $pos_if) || ((-1 != $pos_foreach) && ($pos_if > $pos_foreach))) {
 411       $new_contents .= $self->substitute_vars(substr($contents, 0, $pos_foreach), @indices);
 412       substr($contents, 0, $pos_foreach) = "";
 413
 414       if ($contents !~ m|^$self->{tag_start_qm}foreach (.+?)$self->{tag_end_qm}|) {
 415         $self->{"error"} = "Malformed $self->{tag_start}foreach$self->{tag_end}.";
 416         $main::lxdebug->leave_sub();
 417         return undef;
 418       }
 419
 420       my $var = $1;
 421
 422       substr($contents, 0, length($&)) = "";
 423
 424       my $block;
 425       ($block, $contents) = $self->find_end($contents);
 426       if (!$block) {
 427         $self->{"error"} = "Unclosed $self->{tag_start}foreach$self->{tag_end}." unless ($self->{"error"});
 428         $main::lxdebug->leave_sub();
 429         return undef;
 430       }
 431
 432       my $new_text = $self->parse_foreach($var, $block, "", "", @indices);
 433       if (!defined($new_text)) {
 434         $main::lxdebug->leave_sub();
 435         return undef;
 436       }
 437       $new_contents .= $new_text;
 438
 439     } else {
 440       if (!$self->_parse_block_if(\$contents, \$new_contents, $pos_if, @indices)) {
 441         $main::lxdebug->leave_sub();
 442         return undef;
 443       }
 444     }
 445   }
 446
 447   $main::lxdebug->leave_sub();
 448
 449   return $new_contents;
 450 }
 451
 452 sub parse_first_line {
 453   my $self = shift;
 454   my $line = shift || "";
 455
 456   if ($line =~ m/([^\s]+)set-tag-style([^\s]+)/) {
 457     if ($1 eq $2) {
 458       $self->{error} = "The tag start and end markers must not be equal.";
 459       return 0;
 460     }
 461
 462     $self->set_tag_style($1, $2);
 463   }
 464
 465   return 1;
 466 }
 467
 468 sub _parse_config_option {
 469   my $self = shift;
 470   my $line = shift;
 471
 472   $line =~ s/^\s*//;
 473   $line =~ s/\s*$//;
 474
 475   my ($key, $value) = split m/\s*=\s*/, $line, 2;
 476
 477   if ($key eq 'tag-style') {
 478     $self->set_tag_style(split(m/\s+/, $value, 2));
 479   }
 480 }
 481
 482 sub _parse_config_lines {
 483   my $self  = shift;
 484   my $lines = shift;
 485
 486   my ($comment_start, $comment_end) = ("", "");
 487
 488   if (ref $self eq 'LaTeXTemplate') {
 489     $comment_start = '\s*%';
 490   } elsif (ref $self eq 'HTMLTemplate') {
 491     $comment_start = '\s*<!--';
 492     $comment_end   = '>\s*';
 493   } else {
 494     $comment_start = '\s*\#';
 495   }
 496
 497   my $num_lines = scalar @{ $lines };
 498   my $i         = 0;
 499
 500   while ($i < $num_lines) {
 501     my $line = $lines->[$i];
 502
 503     if ($line !~ m/^${comment_start}\s*config\s*:(.*)${comment_end}$/i) {
 504       $i++;
 505       next;
 506     }
 507
 508     $self->_parse_config_option($1);
 509     splice @{ $lines }, $i, 1;
 510     $num_lines--;
 511   }
 512 }
 513
 514 sub _force_mandatory_packages {
 515   my $self  = shift;
 516   my $lines = shift;
 517
 518   my (%used_packages, $document_start_line);
 519
 520   foreach my $i (0 .. scalar @{ $lines } - 1) {
 521     if ($lines->[$i] =~ m/\\usepackage[^\{]*{(.*?)}/) {
 522       $used_packages{$1} = 1;
 523
 524     } elsif ($lines->[$i] =~ m/\\begin{document}/) {
 525       $document_start_line = $i;
 526       last;
 527
 528     }
 529   }
 530
 531   $document_start_line = scalar @{ $lines } - 1 if (!defined $document_start_line);
 532
 533   if (!$used_packages{textcomp}) {
 534     splice @{ $lines }, $document_start_line, 0, "\\usepackage{textcomp}\n";
 535     $document_start_line++;
 536   }
 537 }
 538
 539 sub parse {
 540   my $self = $_[0];
 541   local *OUT = $_[1];
 542   my $form = $self->{"form"};
 543
 544   if (!open(IN, "$form->{templates}/$form->{IN}")) {
 545     $self->{"error"} = "$!";
 546     return 0;
 547   }
 548   my @lines = <IN>;
 549   close(IN);
 550
 551   $self->_parse_config_lines(\@lines);
 552   $self->_force_mandatory_packages(\@lines) if (ref $self eq 'LaTeXTemplate');
 553
 554   my $contents = join("", @lines);
 555
 556   # detect pagebreak block and its parameters
 557   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) {
 558     $self->{"chars_per_line"} = $1;
 559     $self->{"lines_on_first_page"} = $2;
 560     $self->{"lines_on_second_page"} = $3;
 561     $self->{"pagebreak_block"} = $4;
 562
 563     substr($contents, length($`), length($&)) = "";
 564   }
 565
 566   $self->{"forced_pagebreaks"} = [];
 567
 568   my $new_contents = $self->parse_block($contents);
 569   if (!defined($new_contents)) {
 570     $main::lxdebug->leave_sub();
 571     return 0;
 572   }
 573
 574   print(OUT $new_contents);
 575
 576   if ($form->{"format"} =~ /postscript/i) {
 577     return $self->convert_to_postscript();
 578   } elsif ($form->{"format"} =~ /pdf/i) {
 579     return $self->convert_to_pdf();
 580   } else {
 581     return 1;
 582   }
 583 }
 584
 585 sub convert_to_postscript {
 586   my ($self) = @_;
 587   my ($form, $userspath) = ($self->{"form"}, $self->{"userspath"});
 588
 589   # Convert the tex file to postscript
 590
 591   if (!chdir("$userspath")) {
 592     $self->{"error"} = "chdir : $!";
 593     $self->cleanup();
 594     return 0;
 595   }
 596
 597   $form->{tmpfile} =~ s/\Q$userspath\E\///g;
 598
 599   my $latex = $self->_get_latex_path();
 600
 601   for (my $run = 1; $run <= 2; $run++) {
 602     system("${latex} --interaction=nonstopmode $form->{tmpfile} " .
 603            "> $form->{tmpfile}.err");
 604     if ($?) {
 605       $self->{"error"} = $form->cleanup();
 606       $self->cleanup();
 607       return 0;
 608     }
 609   }
 610
 611   $form->{tmpfile} =~ s/tex$/dvi/;
 612
 613   system("dvips $form->{tmpfile} -o -q > /dev/null");
 614   if ($?) {
 615     $self->{"error"} = "dvips : $!";
 616     $self->cleanup();
 617     return 0;
 618   }
 619   $form->{tmpfile} =~ s/dvi$/ps/;
 620
 621   $self->cleanup();
 622
 623   return 1;
 624 }
 625
 626 sub convert_to_pdf {
 627   my ($self) = @_;
 628   my ($form, $userspath) = ($self->{"form"}, $self->{"userspath"});
 629
 630   # Convert the tex file to PDF
 631
 632   if (!chdir("$userspath")) {
 633     $self->{"error"} = "chdir : $!";
 634     $self->cleanup();
 635     return 0;
 636   }
 637
 638   $form->{tmpfile} =~ s/\Q$userspath\E\///g;
 639
 640   my $latex = $self->_get_latex_path();
 641
 642   for (my $run = 1; $run <= 2; $run++) {
 643     system("${latex} --interaction=nonstopmode $form->{tmpfile} " .
 644            "> $form->{tmpfile}.err");
 645     if ($?) {
 646       $self->{"error"} = $form->cleanup();
 647       $self->cleanup();
 648       return 0;
 649     }
 650   }
 651
 652   $form->{tmpfile} =~ s/tex$/pdf/;
 653
 654   $self->cleanup();
 655 }
 656
 657 sub _get_latex_path {
 658   return $main::latex_bin || 'pdflatex';
 659 }
 660
 661 sub get_mime_type() {
 662   my ($self) = @_;
 663
 664   if ($self->{"form"}->{"format"} =~ /postscript/i) {
 665     return "application/postscript";
 666   } else {
 667     return "application/pdf";
 668   }
 669 }
 670
 671 sub uses_temp_file {
 672   return 1;
 673 }
 674
 675
 676 ####
 677 #### HTMLTemplate
 678 ####
 679
 680 package HTMLTemplate;
 681
 682 use vars qw(@ISA);
 683
 684 @ISA = qw(LaTeXTemplate);
 685
 686 use strict;
 687
 688 sub new {
 689   my $type = shift;
 690
 691   return $type->SUPER::new(@_);
 692 }
 693
 694 sub format_string {
 695   my ($self, $variable) = @_;
 696   my $form = $self->{"form"};
 697
 698   $variable = $main::locale->quote_special_chars('Template/HTML', $variable);
 699
 700   # Allow some HTML markup to be converted into the output format's
 701   # corresponding markup code, e.g. bold or italic.
 702   my @markup_replace = ('b', 'i', 's', 'u', 'sub', 'sup');
 703
 704   foreach my $key (@markup_replace) {
 705     $variable =~ s/\&lt;(\/?)${key}\&gt;/<$1${key}>/g;
 706   }
 707
 708   return $variable;
 709 }
 710
 711 sub get_mime_type() {
 712   my ($self) = @_;
 713
 714   if ($self->{"form"}->{"format"} =~ /postscript/i) {
 715     return "application/postscript";
 716   } elsif ($self->{"form"}->{"format"} =~ /pdf/i) {
 717     return "application/pdf";
 718   } else {
 719     return "text/html";
 720   }
 721 }
 722
 723 sub uses_temp_file {
 724   my ($self) = @_;
 725
 726   if ($self->{"form"}->{"format"} =~ /postscript/i) {
 727     return 1;
 728   } elsif ($self->{"form"}->{"format"} =~ /pdf/i) {
 729     return 1;
 730   } else {
 731     return 0;
 732   }
 733 }
 734
 735 sub convert_to_postscript {
 736   my ($self) = @_;
 737   my ($form, $userspath) = ($self->{"form"}, $self->{"userspath"});
 738
 739   # Convert the HTML file to postscript
 740
 741   if (!chdir("$userspath")) {
 742     $self->{"error"} = "chdir : $!";
 743     $self->cleanup();
 744     return 0;
 745   }
 746
 747   $form->{"tmpfile"} =~ s/\Q$userspath\E\///g;
 748   my $psfile = $form->{"tmpfile"};
 749   $psfile =~ s/.html/.ps/;
 750   if ($psfile eq $form->{"tmpfile"}) {
 751     $psfile .= ".ps";
 752   }
 753
 754   system("html2ps -f html2ps-config < $form->{tmpfile} > $psfile");
 755   if ($?) {
 756     $self->{"error"} = $form->cleanup();
 757     $self->cleanup();
 758     return 0;
 759   }
 760
 761   $form->{"tmpfile"} = $psfile;
 762
 763   $self->cleanup();
 764
 765   return 1;
 766 }
 767
 768 sub convert_to_pdf {
 769   my ($self) = @_;
 770   my ($form, $userspath) = ($self->{"form"}, $self->{"userspath"});
 771
 772   # Convert the HTML file to PDF
 773
 774   if (!chdir("$userspath")) {
 775     $self->{"error"} = "chdir : $!";
 776     $self->cleanup();
 777     return 0;
 778   }
 779
 780   $form->{"tmpfile"} =~ s/\Q$userspath\E\///g;
 781   my $pdffile = $form->{"tmpfile"};
 782   $pdffile =~ s/.html/.pdf/;
 783   if ($pdffile eq $form->{"tmpfile"}) {
 784     $pdffile .= ".pdf";
 785   }
 786
 787   system("html2ps -f html2ps-config < $form->{tmpfile} | ps2pdf - $pdffile");
 788   if ($?) {
 789     $self->{"error"} = $form->cleanup();
 790     $self->cleanup();
 791     return 0;
 792   }
 793
 794   $form->{"tmpfile"} = $pdffile;
 795
 796   $self->cleanup();
 797
 798   return 1;
 799 }
 800
 801
 802 ####
 803 #### PlainTextTemplate
 804 ####
 805
 806 package PlainTextTemplate;
 807
 808 use vars qw(@ISA);
 809
 810 @ISA = qw(LaTeXTemplate);
 811
 812 use strict;
 813
 814 sub new {
 815   my $type = shift;
 816
 817   return $type->SUPER::new(@_);
 818 }
 819
 820 sub format_string {
 821   my ($self, $variable) = @_;
 822
 823   return $variable;
 824 }
 825
 826 sub get_mime_type {
 827   return "text/plain";
 828 }
 829
 830 sub parse {
 831 }
 832
 833 1;
 834
 835 ####
 836 #### OpenDocumentTemplate
 837 ####
 838
 839 package OpenDocumentTemplate;
 840
 841 use Archive::Zip;
 842 use POSIX 'setsid';
 843 use vars qw(@ISA);
 844
 845 use SL::Iconv;
 846
 847 use Cwd;
 848 # use File::Copy;
 849 # use File::Spec;
 850 # use File::Temp qw(:mktemp);
 851 use IO::File;
 852
 853 @ISA = qw(SimpleTemplate);
 854
 855 use strict;
 856
 857 sub new {
 858   my $type = shift;
 859
 860   my $self = $type->SUPER::new(@_);
 861
 862   $self->{"rnd"}   = int(rand(1000000));
 863   $self->{"iconv"} = SL::Iconv->new($main::dbcharset, "UTF-8");
 864
 865   $self->set_tag_style('&lt;%', '%&gt;');
 866   $self->{quot_re} = '&quot;';
 867
 868   return $self;
 869 }
 870
 871 sub parse_foreach {
 872   my ($self, $var, $text, $start_tag, $end_tag, @indices) = @_;
 873
 874   my ($form, $new_contents) = ($self->{"form"}, "");
 875
 876   my $ary = $self->_get_loop_variable($var, 1, @indices);
 877
 878   for (my $i = 0; $i < scalar(@{$ary}); $i++) {
 879     $form->{"__first__"} = $i == 0;
 880     $form->{"__last__"} = ($i + 1) == scalar(@{$ary});
 881     $form->{"__odd__"} = (($i + 1) % 2) == 1;
 882     $form->{"__counter__"} = $i + 1;
 883     my $new_text = $self->parse_block($text, (@indices, $i));
 884     return undef unless (defined($new_text));
 885     $new_contents .= $start_tag . $new_text . $end_tag;
 886   }
 887   map({ delete($form->{"__${_}__"}); } qw(first last odd counter));
 888
 889   return $new_contents;
 890 }
 891
 892 sub find_end {
 893   my ($self, $text, $pos, $var, $not) = @_;
 894
 895   my $depth = 1;
 896   $pos = 0 unless ($pos);
 897
 898   while ($pos < length($text)) {
 899     $pos++;
 900
 901     next if (substr($text, $pos - 1, 5) ne '&lt;%');
 902
 903     if ((substr($text, $pos + 4, 2) eq 'if') || (substr($text, $pos + 4, 3) eq 'for')) {
 904       $depth++;
 905
 906     } elsif ((substr($text, $pos + 4, 4) eq 'else') && (1 == $depth)) {
 907       if (!$var) {
 908         $self->{"error"} = '<%else%> outside of <%if%> / <%ifnot%>.';
 909         return undef;
 910       }
 911
 912       my $block = substr($text, 0, $pos - 1);
 913       substr($text, 0, $pos - 1) = "";
 914       $text =~ s!^\&lt;\%[^\%]+\%\&gt;!!;
 915       $text = '&lt;%if' . ($not ?  " " : "not ") . $var . '%&gt;' . $text;
 916
 917       return ($block, $text);
 918
 919     } elsif (substr($text, $pos + 4, 3) eq 'end') {
 920       $depth--;
 921       if ($depth == 0) {
 922         my $block = substr($text, 0, $pos - 1);
 923         substr($text, 0, $pos - 1) = "";
 924         $text =~ s!^\&lt;\%[^\%]+\%\&gt;!!;
 925
 926         return ($block, $text);
 927       }
 928     }
 929   }
 930
 931   return undef;
 932 }
 933
 934 sub parse_block {
 935   $main::lxdebug->enter_sub();
 936
 937   my ($self, $contents, @indices) = @_;
 938
 939   my $new_contents = "";
 940
 941   while ($contents ne "") {
 942     if (substr($contents, 0, 1) eq "<") {
 943       $contents =~ m|^<[^>]+>|;
 944       my $tag = $&;
 945       substr($contents, 0, length($&)) = "";
 946
 947       if ($tag =~ m|<table:table-row|) {
 948         $contents =~ m|^(.*?)(</table:table-row[^>]*>)|;
 949         my $table_row = $1;
 950         my $end_tag = $2;
 951         substr($contents, 0, length($1) + length($end_tag)) = "";
 952
 953         if ($table_row =~ m|\&lt;\%foreachrow\s+(.*?)\%\&gt;|) {
 954           my $var = $1;
 955
 956           substr($table_row, length($`), length($&)) = "";
 957
 958           my ($t1, $t2) = $self->find_end($table_row, length($`));
 959           if (!$t1) {
 960             $self->{"error"} = "Unclosed <\%foreachrow\%>." unless ($self->{"error"});
 961             $main::lxdebug->leave_sub();
 962             return undef;
 963           }
 964
 965           my $new_text = $self->parse_foreach($var, $t1 . $t2, $tag, $end_tag, @indices);
 966           if (!defined($new_text)) {
 967             $main::lxdebug->leave_sub();
 968             return undef;
 969           }
 970           $new_contents .= $new_text;
 971
 972         } else {
 973           my $new_text = $self->parse_block($table_row, @indices);
 974           if (!defined($new_text)) {
 975             $main::lxdebug->leave_sub();
 976             return undef;
 977           }
 978           $new_contents .= $tag . $new_text . $end_tag;
 979         }
 980
 981       } else {
 982         $new_contents .= $tag;
 983       }
 984
 985     } else {
 986       $contents =~ /^[^<]+/;
 987       my $text = $&;
 988
 989       my $pos_if = index($text, '&lt;%if');
 990       my $pos_foreach = index($text, '&lt;%foreach');
 991
 992       if ((-1 == $pos_if) && (-1 == $pos_foreach)) {
 993         substr($contents, 0, length($text)) = "";
 994         $new_contents .= $self->substitute_vars($text, @indices);
 995         next;
 996       }
 997
 998       if ((-1 == $pos_if) || ((-1 != $pos_foreach) && ($pos_if > $pos_foreach))) {
 999         $new_contents .= $self->substitute_vars(substr($contents, 0, $pos_foreach), @indices);
1000         substr($contents, 0, $pos_foreach) = "";
1001
1002         if ($contents !~ m|^\&lt;\%foreach (.*?)\%\&gt;|) {
1003           $self->{"error"} = "Malformed <\%foreach\%>.";
1004           $main::lxdebug->leave_sub();
1005           return undef;
1006         }
1007
1008         my $var = $1;
1009
1010         substr($contents, 0, length($&)) = "";
1011
1012         my $block;
1013         ($block, $contents) = $self->find_end($contents);
1014         if (!$block) {
1015           $self->{"error"} = "Unclosed <\%foreach\%>." unless ($self->{"error"});
1016           $main::lxdebug->leave_sub();
1017           return undef;
1018         }
1019
1020         my $new_text = $self->parse_foreach($var, $block, "", "", @indices);
1021         if (!defined($new_text)) {
1022           $main::lxdebug->leave_sub();
1023           return undef;
1024         }
1025         $new_contents .= $new_text;
1026
1027       } else {
1028         if (!$self->_parse_block_if(\$contents, \$new_contents, $pos_if, @indices)) {
1029           $main::lxdebug->leave_sub();
1030           return undef;
1031         }
1032       }
1033     }
1034   }
1035
1036   $main::lxdebug->leave_sub();
1037
1038   return $new_contents;
1039 }
1040
1041 sub parse {
1042   $main::lxdebug->enter_sub();
1043
1044   my $self = $_[0];
1045   local *OUT = $_[1];
1046   my $form = $self->{"form"};
1047
1048   close(OUT);
1049
1050   my $file_name;
1051   if ($form->{"IN"} =~ m|^/|) {
1052     $file_name = $form->{"IN"};
1053   } else {
1054     $file_name = $form->{"templates"} . "/" . $form->{"IN"};
1055   }
1056
1057   my $zip = Archive::Zip->new();
1058   if (Archive::Zip->AZ_OK != $zip->read($file_name)) {
1059     $self->{"error"} = "File not found/is not a OpenDocument file.";
1060     $main::lxdebug->leave_sub();
1061     return 0;
1062   }
1063
1064   my $contents = $zip->contents("content.xml");
1065   if (!$contents) {
1066     $self->{"error"} = "File is not a OpenDocument file.";
1067     $main::lxdebug->leave_sub();
1068     return 0;
1069   }
1070
1071   my $rnd = $self->{"rnd"};
1072   my $new_styles = qq|<style:style style:name="TLXO${rnd}BOLD" style:family="text">
1073 <style:text-properties fo:font-weight="bold" style:font-weight-asian="bold" style:font-weight-complex="bold"/>
1074 </style:style>
1075 <style:style style:name="TLXO${rnd}ITALIC" style:family="text">
1076 <style:text-properties fo:font-style="italic" style:font-style-asian="italic" style:font-style-complex="italic"/>
1077 </style:style>
1078 <style:style style:name="TLXO${rnd}UNDERLINE" style:family="text">
1079 <style:text-properties style:text-underline-style="solid" style:text-underline-width="auto" style:text-underline-color="font-color"/>
1080 </style:style>
1081 <style:style style:name="TLXO${rnd}STRIKETHROUGH" style:family="text">
1082 <style:text-properties style:text-line-through-style="solid"/>
1083 </style:style>
1084 <style:style style:name="TLXO${rnd}SUPER" style:family="text">
1085 <style:text-properties style:text-position="super 58%"/>
1086 </style:style>
1087 <style:style style:name="TLXO${rnd}SUB" style:family="text">
1088 <style:text-properties style:text-position="sub 58%"/>
1089 </style:style>
1090 |;
1091
1092   $contents =~ s|</office:automatic-styles>|${new_styles}</office:automatic-styles>|;
1093   $contents =~ s|[\n\r]||gm;
1094
1095   my $new_contents = $self->parse_block($contents);
1096   if (!defined($new_contents)) {
1097     $main::lxdebug->leave_sub();
1098     return 0;
1099   }
1100
1101 #   $new_contents =~ s|>|>\n|g;
1102
1103   $zip->contents("content.xml", $new_contents);
1104
1105   my $styles = $zip->contents("styles.xml");
1106   if ($contents) {
1107     my $new_styles = $self->parse_block($styles);
1108     if (!defined($new_contents)) {
1109       $main::lxdebug->leave_sub();
1110       return 0;
1111     }
1112     $zip->contents("styles.xml", $new_styles);
1113   }
1114
1115   $zip->writeToFileNamed($form->{"tmpfile"}, 1);
1116
1117   my $res = 1;
1118   if ($form->{"format"} =~ /pdf/) {
1119     $res = $self->convert_to_pdf();
1120   }
1121
1122   $main::lxdebug->leave_sub();
1123   return $res;
1124 }
1125
1126 sub is_xvfb_running {
1127   $main::lxdebug->enter_sub();
1128
1129   my ($self) = @_;
1130
1131   local *IN;
1132   my $dfname = $self->{"userspath"} . "/xvfb_display";
1133   my $display;
1134
1135   $main::lxdebug->message(LXDebug->DEBUG2(), "    Looking for $dfname\n");
1136   if ((-f $dfname) && open(IN, $dfname)) {
1137     my $pid = <IN>;
1138     chomp($pid);
1139     $display = <IN>;
1140     chomp($display);
1141     my $xauthority = <IN>;
1142     chomp($xauthority);
1143     close(IN);
1144
1145     $main::lxdebug->message(LXDebug->DEBUG2(), "      found with $pid and $display\n");
1146
1147     if ((! -d "/proc/$pid") || !open(IN, "/proc/$pid/cmdline")) {
1148       $main::lxdebug->message(LXDebug->DEBUG2(), "  no/wrong process #1\n");
1149       unlink($dfname, $xauthority);
1150       $main::lxdebug->leave_sub();
1151       return undef;
1152     }
1153     my $line = <IN>;
1154     close(IN);
1155     if ($line !~ /xvfb/i) {
1156       $main::lxdebug->message(LXDebug->DEBUG2(), "      no/wrong process #2\n");
1157       unlink($dfname, $xauthority);
1158       $main::lxdebug->leave_sub();
1159       return undef;
1160     }
1161
1162     $ENV{"XAUTHORITY"} = $xauthority;
1163     $ENV{"DISPLAY"} = $display;
1164   } else {
1165     $main::lxdebug->message(LXDebug->DEBUG2(), "      not found\n");
1166   }
1167
1168   $main::lxdebug->leave_sub();
1169
1170   return $display;
1171 }
1172
1173 sub spawn_xvfb {
1174   $main::lxdebug->enter_sub();
1175
1176   my ($self) = @_;
1177
1178   $main::lxdebug->message(LXDebug->DEBUG2, "spawn_xvfb()\n");
1179
1180   my $display = $self->is_xvfb_running();
1181
1182   if ($display) {
1183     $main::lxdebug->leave_sub();
1184     return $display;
1185   }
1186
1187   $display = 99;
1188   while ( -f "/tmp/.X${display}-lock") {
1189     $display++;
1190   }
1191   $display = ":${display}";
1192   $main::lxdebug->message(LXDebug->DEBUG2(), "  display $display\n");
1193
1194   my $mcookie = `mcookie`;
1195   die("Installation error: mcookie not found.") if ($? != 0);
1196   chomp($mcookie);
1197
1198   $main::lxdebug->message(LXDebug->DEBUG2(), "  mcookie $mcookie\n");
1199
1200   my $xauthority = "/tmp/.Xauthority-" . $$ . "-" . time() . "-" . int(rand(9999999));
1201   $ENV{"XAUTHORITY"} = $xauthority;
1202
1203   $main::lxdebug->message(LXDebug->DEBUG2(), "  xauthority $xauthority\n");
1204
1205   system("xauth add \"${display}\" . \"${mcookie}\"");
1206   if ($? != 0) {
1207     $self->{"error"} = "Conversion to PDF failed because OpenOffice could not be started (xauth: $!)";
1208     $main::lxdebug->leave_sub();
1209     return undef;
1210   }
1211
1212   $main::lxdebug->message(LXDebug->DEBUG2(), "  about to fork()\n");
1213
1214   my $pid = fork();
1215   if (0 == $pid) {
1216     $main::lxdebug->message(LXDebug->DEBUG2(), "  Child execing\n");
1217     exec($main::xvfb_bin, $display, "-screen", "0", "640x480x8", "-nolisten", "tcp");
1218   }
1219   sleep(3);
1220   $main::lxdebug->message(LXDebug->DEBUG2(), "  parent dont sleeping\n");
1221
1222   local *OUT;
1223   my $dfname = $self->{"userspath"} . "/xvfb_display";
1224   if (!open(OUT, ">$dfname")) {
1225     $self->{"error"} = "Conversion to PDF failed because OpenOffice could not be started ($dfname: $!)";
1226     unlink($xauthority);
1227     kill($pid);
1228     $main::lxdebug->leave_sub();
1229     return undef;
1230   }
1231   print(OUT "$pid\n$display\n$xauthority\n");
1232   close(OUT);
1233
1234   $main::lxdebug->message(LXDebug->DEBUG2(), "  parent re-testing\n");
1235
1236   if (!$self->is_xvfb_running()) {
1237     $self->{"error"} = "Conversion to PDF failed because OpenOffice could not be started.";
1238     unlink($xauthority, $dfname);
1239     kill($pid);
1240     $main::lxdebug->leave_sub();
1241     return undef;
1242   }
1243
1244   $main::lxdebug->message(LXDebug->DEBUG2(), "  spawn OK\n");
1245
1246   $main::lxdebug->leave_sub();
1247
1248   return $display;
1249 }
1250
1251 sub is_openoffice_running {
1252   $main::lxdebug->enter_sub();
1253
1254   system("./scripts/oo-uno-test-conn.py $main::openofficeorg_daemon_port " .
1255          "> /dev/null 2> /dev/null");
1256   my $res = $? == 0;
1257   $main::lxdebug->message(LXDebug->DEBUG2(), "  is_openoffice_running(): $?\n");
1258
1259   $main::lxdebug->leave_sub();
1260
1261   return $res;
1262 }
1263
1264 sub spawn_openoffice {
1265   $main::lxdebug->enter_sub();
1266
1267   my ($self) = @_;
1268
1269   $main::lxdebug->message(LXDebug->DEBUG2(), "spawn_openoffice()\n");
1270
1271   my ($try, $spawned_oo, $res);
1272
1273   $res = 0;
1274   for ($try = 0; $try < 15; $try++) {
1275     if ($self->is_openoffice_running()) {
1276       $res = 1;
1277       last;
1278     }
1279
1280     if (!$spawned_oo) {
1281       my $pid = fork();
1282       if (0 == $pid) {
1283         $main::lxdebug->message(LXDebug->DEBUG2(), "  Child daemonizing\n");
1284         chdir('/');
1285         open(STDIN, '/dev/null');
1286         open(STDOUT, '>/dev/null');
1287         my $new_pid = fork();
1288         exit if ($new_pid);
1289         my $ssres = setsid();
1290         $main::lxdebug->message(LXDebug->DEBUG2(), "  Child execing\n");
1291         my @cmdline = ($main::openofficeorg_writer_bin,
1292                        "-minimized", "-norestore", "-nologo", "-nolockcheck",
1293                        "-headless",
1294                        "-accept=socket,host=localhost,port=" .
1295                        $main::openofficeorg_daemon_port . ";urp;");
1296         exec(@cmdline);
1297       }
1298
1299       $main::lxdebug->message(LXDebug->DEBUG2(), "  Parent after fork\n");
1300       $spawned_oo = 1;
1301       sleep(3);
1302     }
1303
1304     sleep($try >= 5 ? 2 : 1);
1305   }
1306
1307   if (!$res) {
1308     $self->{"error"} = "Conversion from OpenDocument to PDF failed because " .
1309       "OpenOffice could not be started.";
1310   }
1311
1312   $main::lxdebug->leave_sub();
1313
1314   return $res;
1315 }
1316
1317 sub convert_to_pdf {
1318   $main::lxdebug->enter_sub();
1319
1320   my ($self) = @_;
1321
1322   my $form = $self->{"form"};
1323
1324   my $filename = $form->{"tmpfile"};
1325   $filename =~ s/.odt$//;
1326   if (substr($filename, 0, 1) ne "/") {
1327     $filename = getcwd() . "/${filename}";
1328   }
1329
1330   if (substr($self->{"userspath"}, 0, 1) eq "/") {
1331     $ENV{'HOME'} = $self->{"userspath"};
1332   } else {
1333     $ENV{'HOME'} = getcwd() . "/" . $self->{"userspath"};
1334   }
1335
1336   if (!$self->spawn_xvfb()) {
1337     $main::lxdebug->leave_sub();
1338     return 0;
1339   }
1340
1341   my @cmdline;
1342   if (!$main::openofficeorg_daemon) {
1343     @cmdline = ($main::openofficeorg_writer_bin,
1344                 "-minimized", "-norestore", "-nologo", "-nolockcheck",
1345                 "-headless",
1346                 "file:${filename}.odt",
1347                 "macro://" . (split('/', $filename))[-1] .
1348                 "/Standard.Conversion.ConvertSelfToPDF()");
1349   } else {
1350     if (!$self->spawn_openoffice()) {
1351       $main::lxdebug->leave_sub();
1352       return 0;
1353     }
1354
1355     @cmdline = ("./scripts/oo-uno-convert-pdf.py",
1356                 $main::openofficeorg_daemon_port,
1357                 "${filename}.odt");
1358   }
1359
1360   system(@cmdline);
1361
1362   my $res = $?;
1363   if (0 == $?) {
1364     $form->{"tmpfile"} =~ s/odt$/pdf/;
1365
1366     unlink($filename . ".odt");
1367
1368     $main::lxdebug->leave_sub();
1369     return 1;
1370
1371   }
1372
1373   unlink($filename . ".odt", $filename . ".pdf");
1374   $self->{"error"} = "Conversion from OpenDocument to PDF failed. " .
1375     "Exit code: $res";
1376
1377   $main::lxdebug->leave_sub();
1378   return 0;
1379 }
1380
1381 sub format_string {
1382   my ($self, $variable) = @_;
1383   my $form = $self->{"form"};
1384   my $iconv = $self->{"iconv"};
1385
1386   $variable = $main::locale->quote_special_chars('Template/OpenDocument', $variable);
1387
1388   # Allow some HTML markup to be converted into the output format's
1389   # corresponding markup code, e.g. bold or italic.
1390   my $rnd = $self->{"rnd"};
1391   my %markup_replace = ("b" => "BOLD", "i" => "ITALIC", "s" => "STRIKETHROUGH",
1392                         "u" => "UNDERLINE", "sup" => "SUPER", "sub" => "SUB");
1393
1394   foreach my $key (keys(%markup_replace)) {
1395     my $value = $markup_replace{$key};
1396     $variable =~ s|\&lt;${key}\&gt;|<text:span text:style-name=\"TLXO${rnd}${value}\">|gi; #"
1397     $variable =~ s|\&lt;/${key}\&gt;|</text:span>|gi;
1398   }
1399
1400   return $iconv->convert($variable);
1401 }
1402
1403 sub get_mime_type() {
1404   my ($self) = @_;
1405
1406   if ($self->{"form"}->{"format"} =~ /pdf/) {
1407     return "application/pdf";
1408   } else {
1409     return "application/vnd.oasis.opendocument.text";
1410   }
1411 }
1412
1413 sub uses_temp_file {
1414   return 1;
1415 }
1416
1417
1418 ##########################################################
1419 ####
1420 #### XMLTemplate
1421 ####
1422 ##########################################################
1423
1424 package XMLTemplate;
1425
1426 use vars qw(@ISA);
1427
1428 @ISA = qw(HTMLTemplate);
1429
1430 use strict;
1431
1432 sub new {
1433   #evtl auskommentieren
1434   my $type = shift;
1435
1436   return $type->SUPER::new(@_);
1437 }
1438
1439 sub format_string {
1440   my ($self, $variable) = @_;
1441   my $form = $self->{"form"};
1442
1443   $variable = $main::locale->quote_special_chars('Template/XML', $variable);
1444
1445   # Allow no markup to be converted into the output format
1446   my @markup_replace = ('b', 'i', 's', 'u', 'sub', 'sup');
1447
1448   foreach my $key (@markup_replace) {
1449     $variable =~ s/\&lt;(\/?)${key}\&gt;//g;
1450   }
1451
1452   return $variable;
1453 }
1454
1455 sub get_mime_type() {
1456   my ($self) = @_;
1457
1458   if ($self->{"form"}->{"format"} =~ /elsterwinston/i) {
1459     return "application/xml ";
1460   } elsif ($self->{"form"}->{"format"} =~ /elstertaxbird/i) {
1461     return "application/x-taxbird";
1462   } else {
1463     return "text";
1464   }
1465 }
1466
1467 sub uses_temp_file {
1468   # tempfile needet for XML Output
1469   return 1;
1470 }
1471
1472
1473 ##########################################################
1474 ####
1475 #### ExcelTemplate
1476 ####
1477 ##########################################################
1478
1479 package ExcelTemplate;
1480
1481 use vars qw(@ISA);
1482
1483 @ISA = qw(SimpleTemplate);
1484
1485 sub new {
1486   my $type = shift;
1487
1488   my $self = $type->SUPER::new(@_);
1489
1490   return $self;
1491 }
1492 sub _init {
1493   my $self = shift;
1494
1495   $self->{source}    = shift;
1496   $self->{form}      = shift;
1497   $self->{myconfig}  = shift;
1498   $self->{userspath} = shift;
1499
1500   $self->{error}     = undef;
1501
1502   $self->set_tag_style('<<', '>>');
1503 }
1504
1505 sub get_mime_type() {
1506   my ($self) = @_;
1507
1508   return "application/msexcel";
1509 }
1510
1511 sub uses_temp_file {
1512   return 1;
1513 }
1514
1515 sub parse {
1516   $main::lxdebug->enter_sub();
1517
1518   my $self   = shift;
1519   local *OUT = shift;
1520   my $form   = $self->{"form"};
1521
1522   open(IN, "$form->{templates}/$form->{IN}") or do { $self->{"error"} = "$!"; return 0; };
1523   my @lines = <IN>;
1524   close IN;
1525
1526   my $contents = join("", @lines);
1527   my @indices;
1528   $contents =~ s{
1529     $self->{tag_start} [<]* (\s?) [<>\s]* ([\w\s]+) [<>\s]* $self->{tag_end}
1530   }{
1531     $self->format_vars(align_right => $1 ne '', varstring => $2, length => length($&), indices =>  \@indices)
1532   }egx;
1533
1534   if (!defined($contents)) {
1535     $main::lxdebug->leave_sub();
1536     return 0;
1537   }
1538
1539   print OUT $contents;
1540
1541   $main::lxdebug->leave_sub();
1542   return 1;
1543 }
1544
1545 sub format_vars {
1546   my ($self, %params) = @_;
1547   my $form            = $self->{"form"};
1548   my @indices         = @{ $params{indices} };
1549   my $align_right     = $params{align_right};
1550   my $varstring       = $params{varstring};
1551   my $length          = $params{length};
1552
1553   $varstring =~ s/(\w+)/ $self->_get_loop_variable($1, 0, @indices) /eg;
1554   my $old_string=$varstring;
1555   my $new_string = sprintf "%*s", ($align_right ? 1 : -1 ) * $length, $varstring;
1556   if (!defined($new_string) || $new_string eq ''){
1557     $main::lxdebug->message(0, 'varstring' . $varstring . "old" . $old_string);
1558     #  return substr $varstring, ($align_right ? (0, $length) : -$length);
1559   }
1560   return substr $new_string, ($align_right ? (0, $length) : -$length);
1561 }
1562
1563 1;