File Coverage

blib/lib/HTML/HTMLDoc.pm
Criterion Covered Total %
statement 20 464 4.3
branch 0 114 0.0
condition 0 82 0.0
subroutine 7 70 10.0
pod 49 50 98.0
total 76 780 9.7


line stmt bran cond sub pod time code
1             package HTML::HTMLDoc;
2              
3 1     1   910 use 5.006;
  1         4  
4 1     1   6 use strict;
  1         2  
  1         18  
5 1     1   5 use warnings;
  1         2  
  1         22  
6 1     1   464 use IO::File;
  1         8354  
  1         111  
7 1     1   479 use IPC::Open3 qw();
  1         2746  
  1         26  
8 1     1   432 use HTML::HTMLDoc::PDF;
  1         3  
  1         31  
9 1     1   6 use vars qw(@ISA $VERSION);
  1         1  
  1         5022  
10              
11             @ISA = qw();
12             $VERSION = '0.14';
13             my $DEBUG = 0;
14              
15             ###############
16             # create a new Object
17             # param:
18             # return: object:HTML::HTMLDOC
19             ###############
20             sub new {
21 0     0 1   my $package = shift;
22              
23 0           my $self = {};
24 0           bless($self, $package);
25              
26 0           while (my $key = shift) {
27 0           my $value = shift;
28 0           $self->{'config'}->{$key} = $value;
29             }
30              
31 0           $self->_init();
32              
33 0           return $self;
34             }
35              
36             ###############
37             # initialises the Object with the basic parameters
38             # param: -
39             # return: -
40             ###############
41             sub _init {
42 0     0     my $self = shift;
43              
44 0 0 0       if ((not defined $self->{'config'}->{'mode'}) || ($self->{'config'}->{'mode'} ne 'file' && $self->{'config'}->{'mode'} ne 'ipc')) {
      0        
45 0           $self->{'config'}->{'mode'} = 'ipc';
46             }
47              
48 0 0 0       if ( (!$self->{'config'}->{'tmpdir'}) || (!-d $self->{'config'}->{'tmpdir'})) {
49 0           $self->{'config'}->{'tmpdir'} = '/tmp';
50             }
51              
52 0 0         if ( defined($self->{'config'}->{'bindir'}) ) {
53 0 0         $self->{'config'}->{'bindir'} .= "/" if ( $self->{'config'}->{'bindir'} !~ /\/$/ );
54             } else {
55 0           $self->{'config'}->{'bindir'} = '';
56             }
57              
58 0           $self->{'errors'} = [];
59 0           $self->{'doc_config'} = {};
60              
61 0           $self->set_page_size('universal');
62 0           $self->portrait();
63 0           $self->set_charset('iso-8859-1');
64 0           $self->_set_doc_config('quiet');
65 0           $self->set_output_format('pdf');
66            
67             # standard-header and footer
68 0           $self->set_footer('.', '1', '.');
69 0           $self->set_header('.', 't', '.');
70              
71             }
72              
73             ###############
74             # Store or get a global configuration value
75             # testet
76             # param: key:STRING, value:STRING
77             # return: 1
78             ###############
79             sub _config {
80 0     0     my $self = shift;
81 0           my $key = shift;
82 0           my $value = shift;
83              
84 0           my $ret;
85 0 0         if (defined $value) {
86 0           $self->{'config'}->{$key} = $value;
87             } else {
88 0           $ret = $self->{'config'}->{$key};
89             }
90 0           return $ret;
91             }
92              
93             ###############
94             # stores a specific value for formating the outputdoc
95             # testet
96             # param: key:STRING, value:STRING
97             # return: 1
98             ###############
99             sub _set_doc_config {
100 0     0     my $self = shift;
101 0           my $key = shift;
102 0           my $value = shift;
103              
104 0 0 0       if (ref($value) && (ref($value) eq 'ARRAY') ) {
105             # the value is an array, store it in an array too
106 0 0 0       if ( !$self->{'doc_config'}->{$key} || ref($self->{'doc_config'}->{$key}) ne 'ARRAY') {
107             # create a new array
108 0           $self->{'doc_config'}->{$key} = [];
109             }
110 0           foreach my $single_value(@{$value}) {
  0            
111 0           push(@{$self->{'doc_config'}->{$key}}, $single_value);
  0            
112             }
113             } else {
114 0           $self->{'doc_config'}->{$key} = $value;
115             }
116              
117 0           return 1;
118             }
119              
120             ###############
121             # deletes a specific config
122             # testet
123             # param: key:STRING
124             # return: value:STRING
125             ###############
126             sub _delete_doc_config {
127 0     0     my $self = shift;
128 0           my $key = shift;
129 0           my $value = shift;
130              
131 0 0         if (exists $self->{'doc_config'}->{$key}) {
132 0           my $set_value = $self->_get_doc_config($key);
133 0 0 0       if ( (ref($set_value) eq 'ARRAY') && $value ) {
134             # remove specific value only
135             # find the position of the value
136 0           for(my $i=0; $i<@{$set_value}; $i++) {
  0            
137 0 0         if ( $set_value->[$i] eq $value ) {
138 0           splice(@{$set_value}, $i, 1);
  0            
139 0           last;
140             }
141             }
142             } else {
143             # delete the singlevalue
144 0           delete $self->{'doc_config'}->{$key};
145             }
146             }
147             }
148              
149              
150             ###############
151             # tells a specific value for formating the outputdoc
152             # testet
153             # param: key:STRING
154             # return: value:STRING
155             ###############
156             sub _get_doc_config {
157 0     0     my $self = shift;
158 0           my $key = shift;
159 0           return $self->{'doc_config'}->{$key};
160             }
161              
162             ###############
163             # returns all the configuration keys
164             # param: key:STRING
165             # return: value:STRING
166             ###############
167             sub _get_doc_config_keys {
168 0     0     my $self = shift;
169              
170 0           my @keys = keys %{$self->{'doc_config'}};
  0            
171 0 0         print STDERR "Keys: @keys\n" if $DEBUG;
172 0           return @keys;
173             }
174              
175             ###############
176             # tests if the parameter exists in the array
177             # of allowed params
178             # testet
179             # param: key:STRING, \@allowed
180             # return: 1/0
181             ###############
182             sub _test_params {
183 0     0     my $self = shift;
184 0           my $param = shift;
185 0           my $allowed = shift;
186              
187 0           my $ok = 0;
188 0           foreach my $aparam (@{$allowed}) {
  0            
189 0 0         if (lc($param) eq lc($aparam)) {
190 0           $ok=1;
191 0           last;
192             }
193             }
194              
195 0           return $ok;
196             }
197              
198              
199             #######################################
200             # public Methods for configuring behaviour and style of the
201             # Document
202             #######################################
203              
204             ###############
205             # sets the size of the pages - default: a4
206             # testet
207             # param: letter, a4, WxH{in,cm,mm}
208             # return: 1/0
209             ###############
210             sub set_page_size {
211 0     0 1   my $self = shift;
212 0           my $value = shift;
213              
214 0 0 0       if ( !$value && $value ne 'a4' && $value ne 'letter' && $value ne 'universal' && $value!~/^\d+x\d+(?:in|cm|mm)/ ) {
      0        
      0        
      0        
215 0           $self->error("unknown value for pagesize: $value");
216 0           return 0;
217             }
218              
219 0           $self->_set_doc_config('size', $value);
220 0           return 1;
221             }
222              
223             ###############
224             # reads out the page-size
225             # param: letter, a4, WxH{in,cm,mm}
226             # return: 1/0
227             ###############
228             sub get_page_size {
229 0     0 0   my $self = shift;
230 0           return $self->_get_doc_config('size');
231             }
232              
233             ###############
234             # sets the master-password of the doc
235             # testet
236             # param: password:STRING
237             # return: 1/0
238             ###############
239             sub set_owner_password {
240 0     0 1   my $self = shift;
241 0           my $value = shift;
242 0           $self->_set_doc_config('owner-password', $value);
243 0           return 1;
244             }
245              
246             ###############
247             # sets the user-password of the doc
248             # testet
249             # param: password:STRING
250             # return: 1/0
251             ###############
252             sub set_user_password {
253 0     0 1   my $self = shift;
254 0           my $value = shift;
255 0           $self->_set_doc_config('user-password', $value);
256 0           return 1;
257             }
258              
259             # all,annotate,copy,modify,print,no-annotate,no-copy,no-modify,no-print,none
260             ###############
261             # sets the master-password of the doc
262             # testet
263             # param: password:STRING
264             # return: 1/0
265             ###############
266             sub set_permissions {
267 0     0 1   my $self = shift;
268 0           my @values = @_;
269              
270 0           my $thiskey = 'permissions';
271              
272 0           my @allowed = ('all','annotate','copy','modify','print','no-annotate','no-copy','no-modify','no-print','none');
273             # test the set value
274 0 0         if ($#values==-1) {
275 0           $self->error("wrong permission set: no values");
276 0           return 0;
277             }
278 0           for( my $i=0; $i<=$#values; $i++ ) {
279 0           $values[$i] = lc($values[$i]);
280 0 0         if ( !$self->_test_params($values[$i], \@allowed) ) {
281             # wrong permission set
282 0           $self->error("wrong permission set: $values[$i]");
283 0           return 0;
284             }
285             }
286              
287 0           foreach my $value(@values) {
288             # take care of the combination of the options
289 0 0         if ( $value eq 'all' ) {
    0          
290             # delete all
291 0           $self->_delete_doc_config($thiskey);
292             } elsif( $value eq 'none' ) {
293             # delete all
294 0           $self->_delete_doc_config($thiskey);
295             } else {
296             # delete the corresponding flag
297 0 0         if ( $value =~/^no-(.+)/ ) {
298 0           my $key = $1;
299 0           $self->_delete_doc_config($thiskey, $key);
300             } else {
301 0           $self->_delete_doc_config($thiskey, "no-$value");
302             }
303             }
304              
305 0           $self->_set_doc_config('permissions', [$value]);
306             }
307             # enable encryption since without it there is no effect.
308 0           $self->enable_encryption();
309 0           return 1;
310             }
311              
312             ###############
313             # sets to duplex for two-sided printing
314             # testet
315             # param: -
316             # return: 1/0
317             ###############
318             sub duplex_on {
319 0     0 1   my $self = shift;
320              
321 0           $self->_set_doc_config('duplex', '');
322 0           $self->_delete_doc_config('no-duplex');
323 0           return 1;
324             }
325              
326             ###############
327             # disable duplex / two-sided printing
328             # testet
329             # param: -
330             # return: 1/0
331             ###############
332             sub duplex_off {
333 0     0 1   my $self = shift;
334              
335 0           $self->_set_doc_config('no-duplex', '');
336 0           $self->_delete_doc_config('duplex');
337 0           return 1;
338             }
339              
340             ###############
341             # sets the pages to portrait
342             # testet
343             # param: -
344             # return: 1/0
345             ###############
346             sub landscape {
347 0     0 1   my $self = shift;
348              
349 0           $self->_set_doc_config('landscape', '');
350 0           $self->_delete_doc_config('portrait');
351 0           return 1;
352             }
353              
354             ###############
355             # sets the pages to portrait
356             # testet
357             # param: -
358             # return: 1/0
359             ###############
360             sub portrait {
361 0     0 1   my $self = shift;
362              
363 0           $self->_set_doc_config('portrait', '');
364 0           $self->_delete_doc_config('landscape');
365 0           return 1;
366             }
367              
368             ###############
369             # turns the title on
370             # param: -
371             # return: 1/0
372             ###############
373             sub title {
374 0     0 1   my $self = shift;
375              
376 0           $self->_set_doc_config('title', '');
377 0           $self->_delete_doc_config('no-title');
378 0           return 1;
379             }
380              
381             ###############
382             # turns the title off
383             # param: -
384             # return: 1/0
385             ###############
386             sub no_title {
387 0     0 1   my $self = shift;
388              
389 0           $self->_set_doc_config('no-title', '');
390 0           $self->_delete_doc_config('title');
391 0           return 1;
392             }
393              
394             ###############
395             # sets the footer
396             # testet
397             # param: left:CHAR, center:CHAR, right:CHAR
398             # return: 1/0
399             ###############
400             sub set_footer {
401 0     0 1   my $self = shift;
402 0           my $left = shift;
403 0           my $center = shift;
404 0           my $right = shift;
405              
406 0           my @allowed = ('.', ':', '/', '1', 'a', 'A', 'c', 'C', 'd', 'D', 'h', 'i', 'I', 'l', 't', 'T','u');
407 0 0         if (!$self->_test_params($left, \@allowed) ) {
408 0           $self->error("wrong left-footer-option: $left");
409 0           return 0;
410             }
411 0 0         if (!$self->_test_params($center, \@allowed) ) {
412 0           $self->error("wrong center-footer-option: $left");
413 0           return 0;
414             }
415 0 0         if (!$self->_test_params($right, \@allowed) ) {
416 0           $self->error("wrong right-footer-option: $left");
417 0           return 0;
418             }
419              
420 0           $self->_set_doc_config('footer', "${left}${center}${right}");
421              
422 0           return 1;
423             }
424              
425             ###############
426             # sets the header
427             # testet
428             # param: left:CHAR, center:CHAR, right:CHAR
429             # return: 1/0
430             ###############
431             sub set_header {
432 0     0 1   my $self = shift;
433 0           my $left = shift;
434 0           my $center = shift;
435 0           my $right = shift;
436              
437 0           my @allowed = ('.', ':', '/', '1', 'a', 'A', 'c', 'C', 'd', 'D', 'h', 'i', 'I', 'l','L', 't', 'T','u');
438 0 0         if (!$self->_test_params($left, \@allowed) ) {
439 0           $self->error("wrong left-header-option: $left");
440 0           return 0;
441             }
442 0 0         if (!$self->_test_params($center, \@allowed) ) {
443 0           $self->error("wrong center-header-option: $left");
444 0           return 0;
445             }
446 0 0         if (!$self->_test_params($right, \@allowed) ) {
447 0           $self->error("wrong right-header-option: $left");
448 0           return 0;
449             }
450              
451 0           $self->_set_doc_config('header', "${left}${center}${right}");
452              
453 0           return 1;
454             }
455              
456             ###############
457             # turns the links on
458             # param: -
459             # return: 1/0
460             ###############
461             sub links {
462 0     0 1   my $self = shift;
463              
464 0           $self->_set_doc_config('links', '');
465 0           $self->_delete_doc_config('no-links');
466 0           return 1;
467             }
468              
469             ###############
470             # turns the links off
471             # param: -
472             # return: 1/0
473             ###############
474             sub no_links {
475 0     0 1   my $self = shift;
476              
477 0           $self->_set_doc_config('no-links', '');
478 0           $self->_delete_doc_config('links');
479 0           return 1;
480             }
481              
482             ###############
483             # sets the search path for files in a document
484             # param: -
485             # return: 1/0
486             ###############
487             sub path {
488 0     0 1   my $self = shift;
489 0           my $sp = shift;
490              
491 0           $self->_set_doc_config('path', $sp);
492 0           return 1;
493             }
494              
495             ###############
496             # sets the right margin
497             # testet
498             # param: margin|NUM, messure:in,cm,mm
499             # return: 1/0
500             ###############
501             sub set_right_margin {
502 0     0 1   my $self = shift;
503 0           my $margin = shift;
504 0   0       my $m = shift || 'cm';
505 0           return $self->_set_margin('right', $margin, $m);
506             }
507              
508             ###############
509             # sets the left margin
510             # testet
511             # param: margin|NUM, messure:in,cm,mm
512             # return: 1/0
513             ###############
514             sub set_left_margin {
515 0     0 1   my $self = shift;
516 0           my $margin = shift;
517 0   0       my $m = shift || 'cm';
518 0           return $self->_set_margin('left', $margin, $m);
519             }
520              
521             ###############
522             # sets the bottom margin
523             # param: margin|NUM, messure:in,cm,mm
524             # return: 1/0
525             ###############
526             sub set_bottom_margin {
527 0     0 1   my $self = shift;
528 0           my $margin = shift;
529 0   0       my $m = shift || 'cm';
530 0           return $self->_set_margin('bottom', $margin, $m);
531             }
532              
533             ###############
534             # sets the top margin
535             # param: margin|NUM, messure:in,cm,mm
536             # return: 1/0
537             ###############
538             sub set_top_margin {
539 0     0 1   my $self = shift;
540 0           my $margin = shift;
541 0   0       my $m = shift || 'cm';
542 0           return $self->_set_margin('top', $margin, $m);
543             }
544              
545              
546             sub _set_margin {
547 0     0     my $self = shift;
548 0           my $where = shift;
549 0           my $margin = shift;
550 0           my $m = shift;
551              
552             # test the values
553 0 0 0       if ( $margin!~/^\d*\.?\d+$/ || ( ($m ne 'in') && ($m ne 'cm') && ($m ne 'mm') )) {
      0        
      0        
554 0           $self->error("wrong arguments for $where-margin: $margin $m");
555 0           return 0;
556             }
557              
558 0           $self->_set_doc_config($where, "$margin$m");
559 0           return 1;
560             }
561              
562             ###############
563             # sets the color of the body
564             # testet
565             # param: color:hex
566             # return: 1/0
567             ###############
568             sub set_bodycolor {
569 0     0 1   my $self = shift;
570              
571 0           my $ret;
572 0           my $color = $self->_test_color(@_);
573 0 0         if (!$color) {
574 0           $self->error("wrong value set for bodycolor");
575 0           $ret = 0;
576             } else {
577 0           $ret = $self->_set_doc_config('bodycolor', $color);
578             }
579              
580 0           return $ret;
581             }
582              
583             ###############
584             # internal method for testing and converting colors
585             # testet
586             # param: color:hex || color: rgb || color: name
587             # return: color:hex
588             ###############
589             sub _test_color {
590 0     0     my $self = shift;
591 0           my @colors = @_;
592 0           my $ret;
593              
594 0 0 0       if( (@colors == 1) && $colors[0]=~/^#[0-9a-f]{6}$/i ) {
    0          
    0          
595             # got hex-color
596 0           return $colors[0];
597             } elsif( @colors==3 ) {
598             # 3 input values, test if regular rgb is given
599 0           my ($r, $g, $b) = @colors;
600 0 0 0       if ($r=~/^\d{1,3}$/ && $g=~/^\d{1,3}$/ && $b=~/^\d{1,3}$/
      0        
      0        
      0        
      0        
      0        
      0        
      0        
601             && $r>=0 && $r <=255 && $b>=0 && $b<=255 && $g>=0 && $g<=255) {
602 0           $ret = sprintf("#%02x%02x%02x", $r, $g, $b);
603             }
604             } elsif( @colors==1 ) {
605 0           foreach my $c( qw(red green blue cyan magenta yellow darkRed
606             darkGreen darkBlue darkCyan darkMagenta darkYellow white
607             lightGray gray darkGray black) ) {
608 0 0         if ($c eq $colors[0]) {
609 0           $ret = $c;
610 0           last;
611             }
612             }
613             }
614              
615 0           return $ret;
616             }
617              
618             ###############
619             # sets the default font for the body
620             # testet
621             # param: fontface:STRING
622             # return: 1/0
623             ###############
624             sub set_bodyfont {
625 0     0 1   my $self = shift;
626 0           my $font = shift;
627              
628 0           my $ret = 0;
629 0           my @allowed = qw(Arial Courier Helvetica Monospace Sans Serif Times);
630 0 0         if ( !$self->_test_params($font, \@allowed) ) {
631 0           $self->error("illegal font set $font");
632             } else {
633 0           $self->_set_doc_config('bodyfont', $font);
634 0           $ret = 1;
635             }
636              
637 0           return $ret;
638             }
639              
640             ###############
641             # sets the default font for the document
642             # testet
643             # param: fontface:STRING
644             # return: 1/0
645             ###############
646             sub set_textfont {
647 0     0 1   my $self = shift;
648 0           my $font = shift;
649              
650 0           my $ret = 0;
651 0           my @allowed = qw(Arial Courier Helvetica Monospace Sans Serif Times);
652 0 0         if ( !$self->_test_params($font, \@allowed) ) {
653 0           $self->error("illegal font set $font");
654             } else {
655 0           $self->_set_doc_config('textfont', $font);
656 0           $ret = 1;
657             }
658              
659 0           return $ret;
660             }
661              
662             ###############
663             # sets the font size for body text
664             # param: size:NUM
665             # return: 1/0
666             ###############
667             sub set_fontsize {
668 0     0 1   my $self = shift;
669 0           my $fsize = shift;
670 0 0         if ($fsize =~ /^\d+(\.\d+){0,1}$/) {
671 0           return $self->_set_doc_config('fontsize', $fsize);
672             } else {
673 0           $self->error("illegal font size $fsize");
674 0           return 0;
675             }
676             }
677              
678              
679             ###############
680             # takes an image-filename that is used as background
681             # for all Pages
682             # param: image:STRING
683             # return: 1/0
684             ###############
685             sub set_bodyimage {
686 0     0 1   my $self = shift;
687 0           my $image = shift;
688              
689 0 0         if ( ! -f "$image" ) {
690 0           $self->error("Backgroundimage $image could not be found");
691 0           return 0;
692             }
693              
694 0           $self->_set_doc_config('bodyimage', $image);
695 0           return 1;
696             }
697              
698             ###############
699             # takes an image-filename that is used as logoimage
700             # param: image:STRING
701             # return: 1/0
702             ###############
703             sub set_logoimage {
704 0     0 1   my $self = shift;
705 0           my $image = shift;
706              
707 0 0         if ( ! -f "$image" ) {
708 0           $self->error("Logoimage $image could not be found");
709 0           return 0;
710             }
711              
712 0           $self->_set_doc_config('logoimage', $image);
713 0           return 1;
714             }
715              
716             ###############
717             # returns a previous set logo-image
718             # param: -
719             # return: image:STRING
720             ###############
721             sub get_logoimage {
722             my $self = shift;
723             return $self->_get_doc_config('logoimage');
724             }
725              
726             ###############
727             # takes an image-filename that is used as letterhead
728             # param: image:STRING
729             # return: 1/0
730             ###############
731             sub set_letterhead {
732 0     0 1   my $self = shift;
733 0           my $image = shift;
734              
735 0 0         if ( ! -f "$image" ) {
736 0           $self->error("Letterhead $image could not be found");
737 0           return 0;
738             }
739              
740 0           $self->_set_doc_config('letterhead', $image);
741            
742             # tell htmldoc to use this letterhead
743 0           $self->set_header('.', 'L', '.');
744            
745 0           return 1;
746             }
747              
748             ###############
749             # returns a previous set letterhead image
750             # param: -
751             # return: image:STRING
752             ###############
753             sub get_logoimage {
754 0     0 1   my $self = shift;
755 0           return $self->_get_doc_config('letterhead');
756             }
757              
758              
759             ###############
760             # set the witdh in px for the background image
761             # param: width:INT
762             # return: 1/0
763             ###############
764             sub set_browserwidth {
765 0     0 1   my $self = shift;
766 0           my $width = shift;
767              
768 0 0         if ($width !~ /^\d+$/) {
769 0           $self->error("wrong browserwidth $width set");
770 0           return 0;
771             }
772              
773 0           $self->_set_doc_config('browserwidth', $width);
774 0           return 1;
775             }
776              
777             ###############
778             # sets the compression level
779             # param:
780             # return: 1/0
781             ###############
782             sub set_compression {
783 0     0 1   my $self = shift;
784 0           my $comp = shift;
785 0           return $self->_set_doc_config('compression', $comp);
786             }
787              
788             ###############
789             # sets the JPEG-Kompression
790             # param: 0-100 (default 50)
791             # return: 1/0
792             ###############
793             sub set_jpeg_compression {
794 0     0 1   my $self = shift;
795 0           my $comp = shift;
796 0 0         $comp = 75 if (not defined $comp);
797 0           return $self->_set_doc_config('jpeg', $comp);
798             }
799              
800             ###############
801             # sets the JPEG-Kompression value to the highest quality
802             # param: -
803             # return: 1/0
804             ###############
805             sub best_image_quality {
806 0     0 1   my $self = shift;
807 0           return $self->set_jpeg_compression(100);
808             }
809              
810             ###############
811             # sets the JPEG-Kompression value to the highest quality
812             # param: -
813             # return: 1/0
814             ###############
815             sub low_image_quality {
816 0     0 1   my $self = shift;
817 0           return $self->set_jpeg_compression(25);
818             }
819              
820             ###############
821             # sets the pagemode
822             # param: mode:[document,outline,fullscreen]
823             # return: 1/0
824             ###############
825             sub set_pagemode {
826 0     0 1   my $self = shift;
827 0           my $value = shift;
828              
829             #--pagemode {document,outline,fullscreen}
830 0 0         if (!$self->_test_params($value, ['document', 'outline', 'fullscreen']) ) {
831             #if ($value ne 'document' && $value ne 'outline' && $value ne 'fullscreen') {
832 0           $self->error("wrong pagemode: $value");
833 0           return 0;
834             }
835              
836 0           $self->_set_doc_config('pagemode', $value);
837             }
838              
839             ###############
840             # sets the page layout when opened in the viewer
841             # param: mode:[single,one,twoleft,tworight]
842             # return: 1/0
843             ###############
844             sub set_pagelayout {
845 0     0 1   my $self = shift;
846 0           my $value = shift;
847              
848             #--pagemode {document,outline,fullscreen}
849 0 0         if (!$self->_test_params($value, ['single', 'one', 'twoleft', 'tworight']) ) {
850             #if ($value ne 'document' && $value ne 'outline' && $value ne 'fullscreen') {
851 0           $self->error("wrong pagelayout: $value");
852 0           return 0;
853             }
854              
855 0           $self->_set_doc_config('pagelayout', $value);
856             }
857              
858              
859              
860             ###############
861             # sets the charset
862             # param: charset
863             # return: 1/0
864             ###############
865             sub set_charset {
866 0     0 1   my $self = shift;
867 0           my $charset = shift;
868              
869 0           $self->_set_doc_config('charset', $charset);
870 0           return 1;
871             }
872              
873             ###############
874             # embedding the used fonts into the pdf-file
875             # testet
876             # param:
877             # return: 1/0
878             ###############
879             sub embed_fonts {
880 0     0 1   my $self = shift;
881 0           $self->_delete_doc_config('no-embedfonts');
882 0           $self->_set_doc_config('embedfonts', '');
883 0           return 1;
884             }
885              
886             ###############
887             # no font embedding
888             # testet
889             # param:
890             # return: 1/0
891             ###############
892             sub no_embed_fonts {
893 0     0 1   my $self = shift;
894 0           $self->_delete_doc_config('embedfonts');
895 0           $self->_set_doc_config('no-embedfonts', '');
896 0           return 1;
897             }
898              
899             ###############
900             # turns colors on in doc
901             # param: charset
902             # return: 1/0
903             ###############
904             sub color_on {
905 0     0 1   my $self = shift;
906              
907 0           $self->_set_doc_config('color', '');
908 0           $self->_delete_doc_config('grey', '');
909 0           return 1;
910             }
911              
912             ###############
913             # turns colors off in doc
914             # param:
915             # return: 1/0
916             ###############
917             sub color_off {
918 0     0 1   my $self = shift;
919              
920 0           $self->_set_doc_config('grey', '');
921 0           $self->_delete_doc_config('color', '');
922 0           return 1;
923             }
924              
925             ###############
926             # turns encryption off
927             # param: -
928             # return: 1/0
929             ###############
930             sub enable_encryption {
931 0     0 1   my $self = shift;
932              
933 0           $self->_set_doc_config('encryption', '');
934 0           $self->_delete_doc_config('no-enryption', '');
935 0           return 1;
936             }
937              
938             ###############
939             # turns encryption off
940             # param: -
941             # return: 1/0
942             ###############
943             sub disable_encryption {
944 0     0 1   my $self = shift;
945              
946 0           $self->_set_doc_config('no-encryption', '');
947 0           $self->_delete_doc_config('enryption', '');
948 0           return 1;
949             }
950              
951             ###############
952             # sets the outputformat of the document
953             # param: format:STRING
954             # return: 1/0
955             ###############
956             sub set_output_format {
957 0     0 1   my $self = shift;
958 0           my $f = shift;
959              
960 0           my @allowed = qw(epub html pdf pdf11 pdf12 pdf13 pdf14 ps ps1 ps2 ps3);
961 0 0         if( !$self->_test_params($f, \@allowed)) {
962 0           $self->error("Wrong output format set $f");
963 0           return 0;
964             }
965              
966 0           $self->_set_doc_config('format', $f);
967 0           return 1;
968             }
969              
970              
971             ####################################################
972             #
973             # Methods for outputting the result
974             #
975             ####################################################
976              
977              
978              
979             ###############
980             # sets the html-page that should be rendered
981             # param: html:STRING
982             # return: 1/0
983             ###############
984             sub set_html_content {
985 0     0 1   my $self = shift;
986 0           my $html = shift;
987              
988 0           $self->{'html'} = $html;
989 0           return 1;
990             }
991              
992             ###############
993             # returns the html-content
994             # param: -
995             # return: html:STRING
996             ###############
997             sub get_html_content {
998 0     0 1   my $self = shift;
999              
1000 0 0         if (ref($self->{'html'}) eq 'SCALAR') {
1001 0           return ${$self->{'html'}};
  0            
1002             }
1003              
1004 0           return $self->{'html'};
1005             }
1006              
1007             ###############
1008             # sets the filename of the html-page that should be rendered
1009             # param: input_file:STRING
1010             # return: 1/0
1011             ###############
1012             sub set_input_file {
1013 0     0 1   my $self = shift;
1014 0           my $infile = shift;
1015              
1016 0 0         if (-f $infile) {
1017 0           $self->{'input_file'} = $infile;
1018 0           $self->{'config'}->{'mode'} = 'file';
1019 0           return 1;
1020             }
1021 0           return 0;
1022             }
1023              
1024             ###############
1025             # returns the input htmlfile
1026             # param: -
1027             # return: input_file:STRING
1028             ###############
1029             sub get_input_file {
1030 0     0 1   my $self = shift;
1031 0           return $self->{'input_file'};
1032             }
1033              
1034              
1035             ###############
1036             # private: opens a temporary file and sets the
1037             # html-content in
1038             # param: -
1039             # return: filename:STRING
1040             ###############
1041             sub _prepare_input_file {
1042 0     0     my $self = shift;
1043            
1044 0           my $i=0;
1045 0           my $filename;
1046 0 0         return $filename if (defined ($filename = $self->{'input_file'}));
1047              
1048 0           while($i<1000) {
1049 0           my $randpart = int(rand(1000));
1050 0           $filename = $self->{'config'}->{'tmpdir'} . "/htmldoc$randpart.html";
1051              
1052 0 0         if (-f $filename) {
1053 0           $i++;
1054 0           next;
1055             } else {
1056 0           last;
1057             }
1058             }
1059              
1060 0           my $file = new IO::File($filename, 'w');
1061 0 0         if (!$file) {
1062 0           warn "could not open tempfile $!";
1063 0           return undef;
1064             }
1065 0           $file->print($self->get_html_content());
1066 0           $file->close();
1067 0           $self->{'config'}->{'tmpfile'} = $filename;
1068              
1069 0           return $filename;
1070             }
1071              
1072             ###############
1073             # private: cleans up, deletes the tempfile
1074             # param: -
1075             # return: -
1076             ###############
1077             sub _cleanup {
1078 0     0     my $self = shift;
1079             unlink($self->{'config'}->{'tmpfile'})
1080 0 0 0       if ( (defined $self->{'config'}->{'tmpfile'}) && (-f $self->{'config'}->{'tmpfile'}) );
1081             }
1082              
1083             ###############
1084             # finaly produces the pdf-output
1085             # param: -
1086             # return: pdf:STRING
1087             ###############
1088             sub generate_pdf {
1089 0     0 1   my $self = shift;
1090              
1091             # save the env-var for restoring it later
1092 0           my $old_htmldoc_env = $ENV{'HTMLDOC_NOCGI'};
1093 0           $ENV{'HTMLDOC_NOCGI'} = 'yes';
1094              
1095 0           my $params = $self->_build_parameters();
1096 0           my $pdf;
1097              
1098             #if ($self->{'config'}->{'mode'} eq 'ipc') {
1099 0 0         if ($self->_config('mode') eq 'ipc') {
1100             # we are in normale Mode, use IPC
1101 0           my ($pid, $error);
1102 0           ($pid,$pdf,$error) = $self->_run($self->{'config'}->{'bindir'}."htmldoc $params --webpage -", $self->get_html_content());
1103             } else {
1104             # we are in file-mode
1105 0           my $filename = $self->_prepare_input_file();
1106 0 0         return undef if (!$filename);
1107 0           $pdf = `$self->{'config'}->{'bindir'}htmldoc $params --webpage $filename`;
1108 0           $self->_cleanup();
1109             }
1110            
1111             # restore old value
1112 0 0         if (not defined $old_htmldoc_env) {
1113 0           delete $ENV{'HTMLDOC_NOCGI'};
1114             } else {
1115 0           $ENV{'HTMLDOC_NOCGI'} = $old_htmldoc_env;
1116             }
1117              
1118 0           my $doc = new HTML::HTMLDoc::PDF(\$pdf);
1119            
1120 0           return $doc;
1121             }
1122              
1123             ###############
1124             # generates a string for the configuration of htmldoc
1125             # testet
1126             # param: -
1127             # return: params:STRING
1128             ###############
1129             sub _build_parameters {
1130 0     0     my $self = shift;
1131              
1132 0           my $paramstring='';
1133              
1134 0           foreach my $key($self->_get_doc_config_keys()) {
1135 0   0       my $value = $self->_get_doc_config($key) || '';
1136 0 0         if ( ref($value) eq 'ARRAY' ) {
1137             # an array, set the option multiple
1138 0           foreach my $single_v(@{$value}) {
  0            
1139 0           $paramstring .= " --$key $single_v";
1140             }
1141             } else {
1142 0 0 0       if ($key eq 'compression' || $key eq 'jpeg') {
1143 0           $paramstring .= " --$key=$value";
1144             } else {
1145 0           $paramstring .= " --$key $value";
1146             }
1147             }
1148              
1149             }
1150            
1151 0           return $paramstring;
1152             }
1153              
1154             sub _run {
1155 0     0     my $self = shift;
1156 0           my $command = shift;
1157 0           my $input = shift;
1158              
1159             # create new Filehandles
1160 0           my ($stdin,$stdout,$stderr) = (IO::Handle->new(),IO::Handle->new(),IO::Handle->new());
1161 0           my $pid = IPC::Open3::open3($stdin,$stdout,$stderr, $command);
1162 0 0         if (!$pid) {
1163 0           $self->error("Cannot fork [COMMAND: '$command'].");
1164 0           return (0);
1165             }
1166              
1167 0           print $stdin $input;
1168 0           close $stdin;
1169              
1170 0           my $output = join('',<$stdout>);
1171 0           close $stdout;
1172              
1173 0           my $error = join('',<$stderr>);
1174 0           close $stderr;
1175              
1176 0           wait();
1177              
1178              
1179 0 0         if ($DEBUG) {
1180 0           print STDERR "\n********************************************************************\n";
1181 0           print STDERR "COMMAND : \n$command [PID $pid]\n";
1182 0           print STDERR "STDIN : \n$input\n";
1183 0           print STDERR "STDOUT : \n$output\n";
1184 0           print STDERR "STDERR : \n$error\n";
1185 0           print STDERR "\n********************************************************************\n";
1186             }
1187              
1188 0           return($pid,$output,$error);
1189             }
1190              
1191              
1192             ###############
1193             # set or retrieve an occurred error
1194             # param: -
1195             # return: pdf:STRING
1196             ###############
1197             sub error {
1198 0     0 1   my $self = shift;
1199 0           my $error = shift;
1200              
1201 0 0         if (defined $error) {
1202 0           push(@{$self->{'errors'}}, $error);
  0            
1203             } else {
1204 0 0         if (wantarray()) {
1205 0           return @{$self->{'errors'}};
  0            
1206             } else {
1207 0           return $self->{'errors'}->[0];
1208             }
1209             }
1210             }
1211              
1212             1;
1213             __END__