SL/Template/OpenDocument.pm

   1 package SL::Template::OpenDocument;
   2
   3 use parent qw(SL::Template::Simple);
   4
   5 use Archive::Zip;
   6 use POSIX 'setsid';
   7
   8 use SL::Iconv;
   9
  10 use Cwd;
  11 # use File::Copy;
  12 # use File::Spec;
  13 # use File::Temp qw(:mktemp);
  14 use IO::File;
  15
  16 use strict;
  17
  18 sub new {
  19   my $type = shift;
  20
  21   my $self = $type->SUPER::new(@_);
  22
  23   $self->{"rnd"}   = int(rand(1000000));
  24   $self->{"iconv"} = SL::Iconv->new($main::dbcharset, "UTF-8");
  25
  26   $self->set_tag_style('&lt;%', '%&gt;');
  27   $self->{quot_re} = '&quot;';
  28
  29   return $self;
  30 }
  31
  32 sub parse_foreach {
  33   my ($self, $var, $text, $start_tag, $end_tag, @indices) = @_;
  34
  35   my ($form, $new_contents) = ($self->{"form"}, "");
  36
  37   my $ary = $self->_get_loop_variable($var, 1, @indices);
  38
  39   for (my $i = 0; $i < scalar(@{$ary}); $i++) {
  40     $form->{"__first__"} = $i == 0;
  41     $form->{"__last__"} = ($i + 1) == scalar(@{$ary});
  42     $form->{"__odd__"} = (($i + 1) % 2) == 1;
  43     $form->{"__counter__"} = $i + 1;
  44     my $new_text = $self->parse_block($text, (@indices, $i));
  45     return undef unless (defined($new_text));
  46     $new_contents .= $start_tag . $new_text . $end_tag;
  47   }
  48   map({ delete($form->{"__${_}__"}); } qw(first last odd counter));
  49
  50   return $new_contents;
  51 }
  52
  53 sub find_end {
  54   my ($self, $text, $pos, $var, $not) = @_;
  55
  56   my $depth = 1;
  57   $pos = 0 unless ($pos);
  58
  59   while ($pos < length($text)) {
  60     $pos++;
  61
  62     next if (substr($text, $pos - 1, 5) ne '&lt;%');
  63
  64     if ((substr($text, $pos + 4, 2) eq 'if') || (substr($text, $pos + 4, 3) eq 'for')) {
  65       $depth++;
  66
  67     } elsif ((substr($text, $pos + 4, 4) eq 'else') && (1 == $depth)) {
  68       if (!$var) {
  69         $self->{"error"} = '<%else%> outside of <%if%> / <%ifnot%>.';
  70         return undef;
  71       }
  72
  73       my $block = substr($text, 0, $pos - 1);
  74       substr($text, 0, $pos - 1) = "";
  75       $text =~ s!^\&lt;\%[^\%]+\%\&gt;!!;
  76       $text = '&lt;%if' . ($not ?  " " : "not ") . $var . '%&gt;' . $text;
  77
  78       return ($block, $text);
  79
  80     } elsif (substr($text, $pos + 4, 3) eq 'end') {
  81       $depth--;
  82       if ($depth == 0) {
  83         my $block = substr($text, 0, $pos - 1);
  84         substr($text, 0, $pos - 1) = "";
  85         $text =~ s!^\&lt;\%[^\%]+\%\&gt;!!;
  86
  87         return ($block, $text);
  88       }
  89     }
  90   }
  91
  92   return undef;
  93 }
  94
  95 sub parse_block {
  96   $main::lxdebug->enter_sub();
  97
  98   my ($self, $contents, @indices) = @_;
  99
 100   my $new_contents = "";
 101
 102   while ($contents ne "") {
 103     if (substr($contents, 0, 1) eq "<") {
 104       $contents =~ m|^<[^>]+>|;
 105       my $tag = $&;
 106       substr($contents, 0, length($&)) = "";
 107
 108       if ($tag =~ m|<table:table-row|) {
 109         $contents =~ m|^(.*?)(</table:table-row[^>]*>)|;
 110         my $table_row = $1;
 111         my $end_tag = $2;
 112         substr($contents, 0, length($1) + length($end_tag)) = "";
 113
 114         if ($table_row =~ m|\&lt;\%foreachrow\s+(.*?)\%\&gt;|) {
 115           my $var = $1;
 116
 117           substr($table_row, length($`), length($&)) = "";
 118
 119           my ($t1, $t2) = $self->find_end($table_row, length($`));
 120           if (!$t1) {
 121             $self->{"error"} = "Unclosed <\%foreachrow\%>." unless ($self->{"error"});
 122             $main::lxdebug->leave_sub();
 123             return undef;
 124           }
 125
 126           my $new_text = $self->parse_foreach($var, $t1 . $t2, $tag, $end_tag, @indices);
 127           if (!defined($new_text)) {
 128             $main::lxdebug->leave_sub();
 129             return undef;
 130           }
 131           $new_contents .= $new_text;
 132
 133         } else {
 134           my $new_text = $self->parse_block($table_row, @indices);
 135           if (!defined($new_text)) {
 136             $main::lxdebug->leave_sub();
 137             return undef;
 138           }
 139           $new_contents .= $tag . $new_text . $end_tag;
 140         }
 141
 142       } else {
 143         $new_contents .= $tag;
 144       }
 145
 146     } else {
 147       $contents =~ /^[^<]+/;
 148       my $text = $&;
 149
 150       my $pos_if = index($text, '&lt;%if');
 151       my $pos_foreach = index($text, '&lt;%foreach');
 152
 153       if ((-1 == $pos_if) && (-1 == $pos_foreach)) {
 154         substr($contents, 0, length($text)) = "";
 155         $new_contents .= $self->substitute_vars($text, @indices);
 156         next;
 157       }
 158
 159       if ((-1 == $pos_if) || ((-1 != $pos_foreach) && ($pos_if > $pos_foreach))) {
 160         $new_contents .= $self->substitute_vars(substr($contents, 0, $pos_foreach), @indices);
 161         substr($contents, 0, $pos_foreach) = "";
 162
 163         if ($contents !~ m|^\&lt;\%foreach (.*?)\%\&gt;|) {
 164           $self->{"error"} = "Malformed <\%foreach\%>.";
 165           $main::lxdebug->leave_sub();
 166           return undef;
 167         }
 168
 169         my $var = $1;
 170
 171         substr($contents, 0, length($&)) = "";
 172
 173         my $block;
 174         ($block, $contents) = $self->find_end($contents);
 175         if (!$block) {
 176           $self->{"error"} = "Unclosed <\%foreach\%>." unless ($self->{"error"});
 177           $main::lxdebug->leave_sub();
 178           return undef;
 179         }
 180
 181         my $new_text = $self->parse_foreach($var, $block, "", "", @indices);
 182         if (!defined($new_text)) {
 183           $main::lxdebug->leave_sub();
 184           return undef;
 185         }
 186         $new_contents .= $new_text;
 187
 188       } else {
 189         if (!$self->_parse_block_if(\$contents, \$new_contents, $pos_if, @indices)) {
 190           $main::lxdebug->leave_sub();
 191           return undef;
 192         }
 193       }
 194     }
 195   }
 196
 197   $main::lxdebug->leave_sub();
 198
 199   return $new_contents;
 200 }
 201
 202 sub parse {
 203   $main::lxdebug->enter_sub();
 204   my $self = $_[0];
 205   local *OUT = $_[1];
 206   my $form = $self->{"form"};
 207
 208   close(OUT);
 209
 210   my $file_name;
 211   if ($form->{"IN"} =~ m|^/|) {
 212     $file_name = $form->{"IN"};
 213   } else {
 214     $file_name = $form->{"templates"} . "/" . $form->{"IN"};
 215   }
 216
 217   my $zip = Archive::Zip->new();
 218   if (Archive::Zip->AZ_OK != $zip->read($file_name)) {
 219     $self->{"error"} = "File not found/is not a OpenDocument file.";
 220     $main::lxdebug->leave_sub();
 221     return 0;
 222   }
 223
 224   my $contents = $zip->contents("content.xml");
 225   if (!$contents) {
 226     $self->{"error"} = "File is not a OpenDocument file.";
 227     $main::lxdebug->leave_sub();
 228     return 0;
 229   }
 230
 231   my $rnd = $self->{"rnd"};
 232   my $new_styles = qq|<style:style style:name="TLXO${rnd}BOLD" style:family="text">
 233 <style:text-properties fo:font-weight="bold" style:font-weight-asian="bold" style:font-weight-complex="bold"/>
 234 </style:style>
 235 <style:style style:name="TLXO${rnd}ITALIC" style:family="text">
 236 <style:text-properties fo:font-style="italic" style:font-style-asian="italic" style:font-style-complex="italic"/>
 237 </style:style>
 238 <style:style style:name="TLXO${rnd}UNDERLINE" style:family="text">
 239 <style:text-properties style:text-underline-style="solid" style:text-underline-width="auto" style:text-underline-color="font-color"/>
 240 </style:style>
 241 <style:style style:name="TLXO${rnd}STRIKETHROUGH" style:family="text">
 242 <style:text-properties style:text-line-through-style="solid"/>
 243 </style:style>
 244 <style:style style:name="TLXO${rnd}SUPER" style:family="text">
 245 <style:text-properties style:text-position="super 58%"/>
 246 </style:style>
 247 <style:style style:name="TLXO${rnd}SUB" style:family="text">
 248 <style:text-properties style:text-position="sub 58%"/>
 249 </style:style>
 250 |;
 251
 252   $contents =~ s|</office:automatic-styles>|${new_styles}</office:automatic-styles>|;
 253   $contents =~ s|[\n\r]||gm;
 254
 255   my $new_contents = $self->parse_block($contents);
 256   if (!defined($new_contents)) {
 257     $main::lxdebug->leave_sub();
 258     return 0;
 259   }
 260
 261 #   $new_contents =~ s|>|>\n|g;
 262
 263   $zip->contents("content.xml", $new_contents);
 264
 265   my $styles = $zip->contents("styles.xml");
 266   if ($contents) {
 267     my $new_styles = $self->parse_block($styles);
 268     if (!defined($new_contents)) {
 269       $main::lxdebug->leave_sub();
 270       return 0;
 271     }
 272     $zip->contents("styles.xml", $new_styles);
 273   }
 274
 275   $zip->writeToFileNamed($form->{"tmpfile"}, 1);
 276
 277   my $res = 1;
 278   if ($form->{"format"} =~ /pdf/) {
 279     $res = $self->convert_to_pdf();
 280   }
 281
 282   $main::lxdebug->leave_sub();
 283   return $res;
 284 }
 285
 286 sub is_xvfb_running {
 287   $main::lxdebug->enter_sub();
 288
 289   my ($self) = @_;
 290
 291   local *IN;
 292   my $dfname = $self->{"userspath"} . "/xvfb_display";
 293   my $display;
 294
 295   $main::lxdebug->message(LXDebug->DEBUG2(), "    Looking for $dfname\n");
 296   if ((-f $dfname) && open(IN, $dfname)) {
 297     my $pid = <IN>;
 298     chomp($pid);
 299     $display = <IN>;
 300     chomp($display);
 301     my $xauthority = <IN>;
 302     chomp($xauthority);
 303     close(IN);
 304
 305     $main::lxdebug->message(LXDebug->DEBUG2(), "      found with $pid and $display\n");
 306
 307     if ((! -d "/proc/$pid") || !open(IN, "/proc/$pid/cmdline")) {
 308       $main::lxdebug->message(LXDebug->DEBUG2(), "  no/wrong process #1\n");
 309       unlink($dfname, $xauthority);
 310       $main::lxdebug->leave_sub();
 311       return undef;
 312     }
 313     my $line = <IN>;
 314     close(IN);
 315     if ($line !~ /xvfb/i) {
 316       $main::lxdebug->message(LXDebug->DEBUG2(), "      no/wrong process #2\n");
 317       unlink($dfname, $xauthority);
 318       $main::lxdebug->leave_sub();
 319       return undef;
 320     }
 321
 322     $ENV{"XAUTHORITY"} = $xauthority;
 323     $ENV{"DISPLAY"} = $display;
 324   } else {
 325     $main::lxdebug->message(LXDebug->DEBUG2(), "      not found\n");
 326   }
 327
 328   $main::lxdebug->leave_sub();
 329
 330   return $display;
 331 }
 332
 333 sub spawn_xvfb {
 334   $main::lxdebug->enter_sub();
 335
 336   my ($self) = @_;
 337
 338   $main::lxdebug->message(LXDebug->DEBUG2, "spawn_xvfb()\n");
 339
 340   my $display = $self->is_xvfb_running();
 341
 342   if ($display) {
 343     $main::lxdebug->leave_sub();
 344     return $display;
 345   }
 346
 347   $display = 99;
 348   while ( -f "/tmp/.X${display}-lock") {
 349     $display++;
 350   }
 351   $display = ":${display}";
 352   $main::lxdebug->message(LXDebug->DEBUG2(), "  display $display\n");
 353
 354   my $mcookie = `mcookie`;
 355   die("Installation error: mcookie not found.") if ($? != 0);
 356   chomp($mcookie);
 357
 358   $main::lxdebug->message(LXDebug->DEBUG2(), "  mcookie $mcookie\n");
 359
 360   my $xauthority = "/tmp/.Xauthority-" . $$ . "-" . time() . "-" . int(rand(9999999));
 361   $ENV{"XAUTHORITY"} = $xauthority;
 362
 363   $main::lxdebug->message(LXDebug->DEBUG2(), "  xauthority $xauthority\n");
 364
 365   system("xauth add \"${display}\" . \"${mcookie}\"");
 366   if ($? != 0) {
 367     $self->{"error"} = "Conversion to PDF failed because OpenOffice could not be started (xauth: $!)";
 368     $main::lxdebug->leave_sub();
 369     return undef;
 370   }
 371
 372   $main::lxdebug->message(LXDebug->DEBUG2(), "  about to fork()\n");
 373
 374   my $pid = fork();
 375   if (0 == $pid) {
 376     $main::lxdebug->message(LXDebug->DEBUG2(), "  Child execing\n");
 377     exec($main::xvfb_bin, $display, "-screen", "0", "640x480x8", "-nolisten", "tcp");
 378   }
 379   sleep(3);
 380   $main::lxdebug->message(LXDebug->DEBUG2(), "  parent dont sleeping\n");
 381
 382   local *OUT;
 383   my $dfname = $self->{"userspath"} . "/xvfb_display";
 384   if (!open(OUT, ">$dfname")) {
 385     $self->{"error"} = "Conversion to PDF failed because OpenOffice could not be started ($dfname: $!)";
 386     unlink($xauthority);
 387     kill($pid);
 388     $main::lxdebug->leave_sub();
 389     return undef;
 390   }
 391   print(OUT "$pid\n$display\n$xauthority\n");
 392   close(OUT);
 393
 394   $main::lxdebug->message(LXDebug->DEBUG2(), "  parent re-testing\n");
 395
 396   if (!$self->is_xvfb_running()) {
 397     $self->{"error"} = "Conversion to PDF failed because OpenOffice could not be started.";
 398     unlink($xauthority, $dfname);
 399     kill($pid);
 400     $main::lxdebug->leave_sub();
 401     return undef;
 402   }
 403
 404   $main::lxdebug->message(LXDebug->DEBUG2(), "  spawn OK\n");
 405
 406   $main::lxdebug->leave_sub();
 407
 408   return $display;
 409 }
 410
 411 sub is_openoffice_running {
 412   $main::lxdebug->enter_sub();
 413
 414   my $output = `./scripts/oo-uno-test-conn.py $main::openofficeorg_daemon_port 2> /dev/null`;
 415   chomp $output;
 416
 417   my $res = ($? == 0) || $output;
 418   $main::lxdebug->message(LXDebug->DEBUG2(), "  is_openoffice_running(): res $res\n");
 419
 420   $main::lxdebug->leave_sub();
 421
 422   return $res;
 423 }
 424
 425 sub spawn_openoffice {
 426   $main::lxdebug->enter_sub();
 427
 428   my ($self) = @_;
 429
 430   $main::lxdebug->message(LXDebug->DEBUG2(), "spawn_openoffice()\n");
 431
 432   my ($try, $spawned_oo, $res);
 433
 434   $res = 0;
 435   for ($try = 0; $try < 15; $try++) {
 436     if ($self->is_openoffice_running()) {
 437       $res = 1;
 438       last;
 439     }
 440
 441     if (!$spawned_oo) {
 442       my $pid = fork();
 443       if (0 == $pid) {
 444         $main::lxdebug->message(LXDebug->DEBUG2(), "  Child daemonizing\n");
 445         chdir('/');
 446         open(STDIN, '/dev/null');
 447         open(STDOUT, '>/dev/null');
 448         my $new_pid = fork();
 449         exit if ($new_pid);
 450         my $ssres = setsid();
 451         $main::lxdebug->message(LXDebug->DEBUG2(), "  Child execing\n");
 452         my @cmdline = ($main::openofficeorg_writer_bin,
 453                        "-minimized", "-norestore", "-nologo", "-nolockcheck",
 454                        "-headless",
 455                        "-accept=socket,host=localhost,port=" .
 456                        $main::openofficeorg_daemon_port . ";urp;");
 457         exec(@cmdline);
 458       }
 459
 460       $main::lxdebug->message(LXDebug->DEBUG2(), "  Parent after fork\n");
 461       $spawned_oo = 1;
 462       sleep(3);
 463     }
 464
 465     sleep($try >= 5 ? 2 : 1);
 466   }
 467
 468   if (!$res) {
 469     $self->{"error"} = "Conversion from OpenDocument to PDF failed because " .
 470       "OpenOffice could not be started.";
 471   }
 472
 473   $main::lxdebug->leave_sub();
 474
 475   return $res;
 476 }
 477
 478 sub convert_to_pdf {
 479   $main::lxdebug->enter_sub();
 480
 481   my ($self) = @_;
 482
 483   my $form = $self->{"form"};
 484
 485   my $filename = $form->{"tmpfile"};
 486   $filename =~ s/.odt$//;
 487   if (substr($filename, 0, 1) ne "/") {
 488     $filename = getcwd() . "/${filename}";
 489   }
 490
 491   if (substr($self->{"userspath"}, 0, 1) eq "/") {
 492     $ENV{'HOME'} = $self->{"userspath"};
 493   } else {
 494     $ENV{'HOME'} = getcwd() . "/" . $self->{"userspath"};
 495   }
 496
 497   if (!$self->spawn_xvfb()) {
 498     $main::lxdebug->leave_sub();
 499     return 0;
 500   }
 501
 502   my @cmdline;
 503   if (!$main::openofficeorg_daemon) {
 504     @cmdline = ($main::openofficeorg_writer_bin,
 505                 "-minimized", "-norestore", "-nologo", "-nolockcheck",
 506                 "-headless",
 507                 "file:${filename}.odt",
 508                 "macro://" . (split('/', $filename))[-1] .
 509                 "/Standard.Conversion.ConvertSelfToPDF()");
 510   } else {
 511     if (!$self->spawn_openoffice()) {
 512       $main::lxdebug->leave_sub();
 513       return 0;
 514     }
 515
 516     @cmdline = ("./scripts/oo-uno-convert-pdf.py",
 517                 $main::openofficeorg_daemon_port,
 518                 "${filename}.odt");
 519   }
 520
 521   system(@cmdline);
 522
 523   my $res = $?;
 524   if ((0 == $?) || (-f "${filename}.pdf" && -s "${filename}.pdf")) {
 525     $form->{"tmpfile"} =~ s/odt$/pdf/;
 526
 527     unlink($filename . ".odt");
 528
 529     $main::lxdebug->leave_sub();
 530     return 1;
 531
 532   }
 533
 534   unlink($filename . ".odt", $filename . ".pdf");
 535   $self->{"error"} = "Conversion from OpenDocument to PDF failed. " .
 536     "Exit code: $res";
 537
 538   $main::lxdebug->leave_sub();
 539   return 0;
 540 }
 541
 542 sub format_string {
 543   my ($self, $variable) = @_;
 544   my $form = $self->{"form"};
 545   my $iconv = $self->{"iconv"};
 546
 547   $variable = $main::locale->quote_special_chars('Template/OpenDocument', $variable);
 548
 549   # Allow some HTML markup to be converted into the output format's
 550   # corresponding markup code, e.g. bold or italic.
 551   my $rnd = $self->{"rnd"};
 552   my %markup_replace = ("b" => "BOLD", "i" => "ITALIC", "s" => "STRIKETHROUGH",
 553                         "u" => "UNDERLINE", "sup" => "SUPER", "sub" => "SUB");
 554
 555   foreach my $key (keys(%markup_replace)) {
 556     my $value = $markup_replace{$key};
 557     $variable =~ s|\&lt;${key}\&gt;|<text:span text:style-name=\"TLXO${rnd}${value}\">|gi; #"
 558     $variable =~ s|\&lt;/${key}\&gt;|</text:span>|gi;
 559   }
 560
 561   return $iconv->convert($variable);
 562 }
 563
 564 sub get_mime_type() {
 565   my ($self) = @_;
 566
 567   if ($self->{"form"}->{"format"} =~ /pdf/) {
 568     return "application/pdf";
 569   } else {
 570     return "application/vnd.oasis.opendocument.text";
 571   }
 572 }
 573
 574 sub uses_temp_file {
 575   return 1;
 576 }
 577
 578 1;