SL/Template/OpenDocument.pm

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