source: main/trunk/greenstone2/bin/script/gsConvert.pl@ 24192

Last change on this file since 24192 was 24192, checked in by ak19, 13 years ago

Sam discovered that using dollar-Config{perlpath} in place of dollar-hat-X is the better way to obtain the path to the perl that is being used. We hope this will not be a relative path on the Mac as dollar-hat-x was on Professor Witten's Mac when we tried it there today.
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 47.0 KB
Line 
1#!/usr/bin/perl -w
2
3###########################################################################
4#
5# gsConvert.pl -- convert documents to HTML or TEXT format
6#
7# A component of the Greenstone digital library software
8# from the New Zealand Digital Library Project at the
9# University of Waikato, New Zealand.
10#
11# Copyright (C) 1999-2002 New Zealand Digital Library Project
12#
13# This program is free software; you can redistribute it and/or modify
14# it under the terms of the GNU General Public License as published by
15# the Free Software Foundation; either version 2 of the License, or
16# (at your option) any later version.
17#
18# This program is distributed in the hope that it will be useful,
19# but WITHOUT ANY WARRANTY; without even the implied warranty of
20# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21# GNU General Public License for more details.
22#
23# You should have received a copy of the GNU General Public License
24# along with this program; if not, write to the Free Software
25# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
26#
27###########################################################################
28
29# gsConvert.pl converts documents in a range of formats to HTML or TEXT
30# by exploiting third-party programs. The sources of these are usually found
31# in the $GSDLHOME/packages directory, and the executables should live in
32# $GSDLHOME/bin/$GSDLOS (which is on the search path).
33#
34# Currently, we can convert the following formats by using external
35# conversion utilities:
36# Microsoft Word (versions 2,6,7 [==95?], 8[==97?], 9[==2000?]), RTF,
37# Adobe PDF, PostScript, MS PowerPoint (95 and 97), and MS Excel (95 and 97).
38#
39# We can try to convert any file to text with a perl implementation of the
40# UNIX strings command.
41#
42# We try to convert Postscript files to text using "gs" which is often on
43# *nix machines. We fall back to performing weak text extraction by using
44# regular expressions.
45
46BEGIN {
47 die "GSDLHOME not set\n" unless defined $ENV{'GSDLHOME'};
48 unshift (@INC, "$ENV{'GSDLHOME'}/perllib");
49
50 if(!$ENV{'PERLPATH'}) {
51 my $full_perl_exec = $Config{perlpath}; #$^X;
52 require File::Basename;
53 my $perl_path = File::Basename::dirname($full_perl_exec);
54 $ENV{'PERLPATH'} = $perl_path;
55 }
56
57}
58
59use strict;
60
61use parsargv;
62use util;
63use Cwd;
64use Config; # for getting the perlpath in the recommended way
65# Note: even though this (and other) use statement comes after its
66# usage in BEGIN, the use statement is in fact executed before BEGIN.
67
68
69# Are we running on WinNT or Win2000 (or later)?
70my $is_winnt_2000=eval {require Win32; return (Win32::IsWinNT()); return 0;};
71if (!defined($is_winnt_2000)) {$is_winnt_2000=0;}
72
73my $use_strings;
74my $pdf_complex;
75my $pdf_nohidden;
76my $pdf_zoom;
77my $pdf_ignore_images;
78my $pdf_allow_images_only;
79my $windows_scripting;
80
81sub print_usage
82{
83 print STDERR "\n";
84 print STDERR "gsConvert.pl: Converts documents in a range of formats to html\n";
85 print STDERR " or text using third-party programs.\n\n";
86 print STDERR " usage: $0 [options] filename\n";
87 print STDERR " options:\n\t-type\tdoc|dot|pdf|ps|ppt|rtf|xls\t(input file type)\n";
88 print STDERR "\t-errlog\t<filename>\t(append err messages)\n";
89 print STDERR "\t-output\tauto|html|text|pagedimg_jpg|pagedimg_gif|pagedimg_png\t(output file type)\n";
90 print STDERR "\t-timeout\t<max cpu seconds>\t(ulimit on unix systems)\n";
91 print STDERR "\t-use_strings\tuse strings to extract text if conversion fails\n";
92 print STDERR "\t-windows_scripting\tuse windows VB script (if available) to convert Microsoft Word and PPT documents\n";
93 print STDERR "\t-pdf_complex\tuse complex output when converting PDF to HTML\n";
94 print STDERR "\t-pdf_nohidden\tDon't attempt to extract hidden text from PDF files\n";
95 print STDERR "\t-pdf_ignore_images\tdon't attempt to extract images when\n";
96 print STDERR "\t\tconverting PDF to HTML\n";
97 print STDERR "\t-pdf_allow_images_only\tallow images only (continue even if no text is present when converting to HTML)\n";
98 print STDERR "\t-pdf_zoom\tfactor by which to zoom PDF (only useful if\n";
99 print STDERR "\t\t-pdf_complex is set\n";
100 exit(1);
101}
102
103my $faillogfile="";
104my $timeout=0;
105
106sub main
107{
108 my (@ARGV) = @_;
109 my ($input_type,$output_type,$verbose);
110
111 # Dynamically figure out what the --type option can support, based on whether -windows_scripting
112 # is in use or not
113 my $default_type_re = "(doc|dot|pdf|ps|ppt|rtf|xls)";
114 #my $enhanced_type_re = "(docx?|dot|pdf|ps|pptx?|rtf|xlsx?)";
115 #my $enhanced_type_re = "(docx?|dot|pdf|ps|pptx?|rtf|xlsx?)";
116 # Currently only have VBA for Word and PPT(but no XLS)
117 my $enhanced_type_re = "(docx?|dot|pdf|ps|pptx?|rtf|xls)";
118
119 my $type_re = $default_type_re;
120
121 foreach my $a (@ARGV) {
122 if ($a =~ m/^windows_scripting$/i) {
123 $type_re = $enhanced_type_re;
124 }
125 }
126
127 # read command-line arguments
128 if (!parsargv::parse(\@ARGV,
129 "type/$type_re/", \$input_type,
130 '/errlog/.*/', \$faillogfile,
131 'output/(auto|html|text|pagedimg).*/', \$output_type,
132 'timeout/\d+/0',\$timeout,
133 'verbose/\d+/0', \$verbose,
134 'windows_scripting',\$windows_scripting,
135 'use_strings', \$use_strings,
136 'pdf_complex', \$pdf_complex,
137 'pdf_ignore_images', \$pdf_ignore_images,
138 'pdf_allow_images_only', \$pdf_allow_images_only,
139 'pdf_nohidden', \$pdf_nohidden,
140 'pdf_zoom/\d+/2', \$pdf_zoom
141 ))
142 {
143 print_usage();
144 }
145
146 # Make sure the input file exists and can be opened for reading
147 if (scalar(@ARGV!=1)) {
148 print_usage();
149 }
150
151 my $input_filename = $ARGV[0];
152 if (!-r $input_filename) {
153 print STDERR "Error: unable to open $input_filename for reading\n";
154 exit(1);
155 }
156
157 # Deduce filenames
158 my ($tailname,$dirname,$suffix)
159 = File::Basename::fileparse($input_filename, "\\.[^\\.]+\$");
160 my $output_filestem = &util::filename_cat($dirname, "$tailname");
161
162 if ($input_type eq "")
163 {
164 $input_type = lc (substr($suffix,1,length($suffix)-1));
165 }
166
167 # Change to temporary working directory
168 my $stored_dir = cwd();
169 chdir ($dirname) || die "Unable to change to directory $dirname";
170
171 # Select convert utility
172 if (!defined $input_type) {
173 print STDERR "Error: No filename extension or input type defined\n";
174 exit(1);
175 }
176 elsif ($input_type =~ m/^docx?$/ || $input_type eq "dot") {
177 print &convertDOC($input_filename, $output_filestem, $output_type);
178 print "\n";
179 }
180 elsif ($input_type eq "rtf") {
181 print &convertRTF($input_filename, $output_filestem, $output_type);
182 print "\n";
183 }
184 elsif ($input_type eq "pdf") {
185 print &convertPDF($dirname, $input_filename, $output_filestem, $output_type);
186 print "\n";
187 }
188 elsif ($input_type eq "ps") {
189 print &convertPS($dirname, $input_filename, $output_filestem, $output_type);
190 print "\n";
191 }
192 elsif ($input_type =~ m/pptx?$/) {
193 print &convertPPT($input_filename, $output_filestem, $output_type);
194 print "\n";
195 }
196 elsif ($input_type =~ m/xlsx?$/) {
197 print &convertXLS($input_filename, $output_filestem, $output_type);
198 print "\n";
199 }
200 else {
201 print STDERR "Error: Unable to convert type '$input_type'\n";
202 exit(1);
203 }
204
205 # restore to original working directory
206 chdir ($stored_dir) || die "Unable to return to directory $stored_dir";
207
208}
209
210&main(@ARGV);
211
212
213
214# Document-type conversion functions
215#
216# The following functions attempt to convert documents from their
217# input type to the specified output type. If no output type was
218# given, then they first attempt HTML, and then TEXT.
219#
220# Each returns the output type ("html" or "text") or "fail" if no
221# conversion is possible.
222
223# Convert a Microsoft word document
224
225sub convertDOC {
226 my ($input_filename, $output_filestem, $output_type) = @_;
227
228 # Many .doc files are not in fact word documents!
229 my $realtype = &find_docfile_type($input_filename);
230
231 if ($realtype eq "word6" || $realtype eq "word7"
232 || $realtype eq "word8" || $realtype eq "docx") {
233 return &convertWord678($input_filename, $output_filestem, $output_type);
234 } elsif ($realtype eq "rtf") {
235 return &convertRTF($input_filename, $output_filestem, $output_type);
236 } else {
237 return &convertAnything($input_filename, $output_filestem, $output_type);
238 }
239}
240
241# Convert a Microsoft word 6/7/8 document
242
243sub convertWord678 {
244 my ($input_filename, $output_filestem, $output_type) = @_;
245
246 my $success = 0;
247 if (!$output_type || ($output_type =~ m/html/i)){
248 if ($windows_scripting) {
249 $success = &native_doc_to_html($input_filename, $output_filestem);
250 }
251 else {
252 $success = &doc_to_html($input_filename, $output_filestem);
253 }
254 if ($success) {
255 return "html";
256 }
257 }
258 return &convertAnything($input_filename, $output_filestem, $output_type);
259}
260
261
262# Convert a Rich Text Format (RTF) file
263
264sub convertRTF {
265 my ($input_filename, $output_filestem, $output_type) = @_;
266
267 my $success = 0;
268
269 # Attempt specialised conversion to HTML
270 if (!$output_type || ($output_type =~ m/html/i)) {
271
272 if ($windows_scripting) {
273 $success = &native_doc_to_html($input_filename, $output_filestem);
274 }
275 else {
276 $success = &rtf_to_html($input_filename, $output_filestem);
277 }
278 if ($success) {
279 return "html";
280 }
281 }
282
283# rtf is so ugly that's it's not worth running strings over.
284# One day I'll write some quick'n'dirty regexps to try to extract text - jrm21
285# return &convertAnything($input_filename, $output_filestem, $output_type);
286 return "fail";
287}
288
289
290# Convert an unidentified file
291
292sub convertAnything {
293 my ($input_filename, $output_filestem, $output_type) = @_;
294
295 my $success = 0;
296
297 # Attempt simple conversion to HTML
298 if (!$output_type || ($output_type =~ m/html/i)) {
299 $success = &any_to_html($input_filename, $output_filestem);
300 if ($success) {
301 return "html";
302 }
303 }
304
305 # Convert to text
306 if (!$output_type || ($output_type =~ m/text/i)) {
307 $success = &any_to_text($input_filename, $output_filestem);
308 if ($success) {
309 return "text";
310 }
311 }
312 return "fail";
313}
314
315
316
317# Convert an Adobe PDF document
318
319sub convertPDF {
320 my ($dirname, $input_filename, $output_filestem, $output_type) = @_;
321
322 my $success = 0;
323 $output_type =~ s/.*\-(.*)/$1/i;
324 # Attempt coversion to Image
325 if ($output_type =~ m/jp?g|gif|png/i) {
326 $success = &pdfps_to_img($dirname, $input_filename, $output_filestem, $output_type);
327 if ($success){
328 return "item";
329 }
330 }
331
332 # Attempt conversion to HTML
333 if (!$output_type || ($output_type =~ m/html/i)) {
334 $success = &pdf_to_html($dirname, $input_filename, $output_filestem);
335 if ($success) {
336 return "html";
337 }
338 }
339
340 # Attempt conversion to TEXT
341 if (!$output_type || ($output_type =~ m/text/i)) {
342 $success = &pdf_to_text($dirname, $input_filename, $output_filestem);
343 if ($success) {
344 return "text";
345 }
346 }
347
348 return "fail";
349
350}
351
352
353# Convert an Adobe PostScript document
354
355sub convertPS {
356 my ($dirname,$input_filename, $output_filestem, $output_type) = @_;
357
358 my $success = 0;
359 $output_type =~ s/.*\-(.*)/$1/i;
360 # Attempt coversion to Image
361 if ($output_type =~ m/jp?g|gif|png/i) {
362 $success = &pdfps_to_img($dirname, $input_filename, $output_filestem, $output_type);
363 if ($success){
364 return "item";
365 }
366 }
367
368 # Attempt conversion to TEXT
369 if (!$output_type || ($output_type =~ m/text/i)) {
370 $success = &ps_to_text($input_filename, $output_filestem);
371 if ($success) {
372 return "text";
373 }
374 }
375 return "fail";
376}
377
378
379sub convertPPT {
380 my ($input_filename, $output_filestem, $output_type) = @_;
381 my $success = 0;
382
383 my $ppt_convert_type = "";
384
385 #if (!$output_type || $windows_scripting || ($output_type !~ m/html/i) || ($output_type !~ m/text/i)){
386 if ($windows_scripting && ($output_type !~ m/html/i) && ($output_type !~ m/text/i)){
387 if ($output_type =~ m/gif/i) {
388 $ppt_convert_type = "-g";
389 } elsif ($output_type =~ m/jp?g/i){
390 $ppt_convert_type = "-j";
391 } elsif ($output_type =~ m/png/i){
392 $ppt_convert_type = "-p";
393 }
394 my $vbScript = &util::filename_cat($ENV{'GSDLHOME'}, "bin",
395 $ENV{'GSDLOS'}, "pptextract");
396 $vbScript = "pptextract" if ($ENV{'GSDLOS'} =~ m/^windows$/i);
397
398 my $cmd = "";
399 if ($timeout) {$cmd = "ulimit -t $timeout;";}
400 # if the converting directory already exists
401 if (-d $output_filestem) {
402 print STDERR "**The conversion directory already exists\n";
403 return "item";
404 } else {
405 $cmd .= "$vbScript $ppt_convert_type \"$input_filename\" \"$output_filestem\"";
406 $cmd .= " 2>\"$output_filestem.err\""
407 if ($ENV{'GSDLOS'} !~ m/^windows$/i || $is_winnt_2000);
408 if (system($cmd) !=0) {
409 print STDERR "Powerpoint VB Scripting convert failed\n";
410 } else {
411 return "item";
412 }
413 }
414 } elsif (!$output_type || ($output_type =~ m/html/i)) {
415 # Attempt conversion to HTML
416 #if (!$output_type || ($output_type =~ m/html/i)) {
417 # formulate the command
418 my $cmd = "";
419 my $full_perl_path = &util::filename_cat($ENV{'PERLPATH'},"perl");
420 $cmd .= "\"$full_perl_path\" -S ppttohtml.pl ";
421 $cmd .= " \"$input_filename\" \"$output_filestem.html\"";
422 $cmd .= " 2>\"$output_filestem.err\""
423 if ($ENV{'GSDLOS'} !~ m/^windows$/i || $is_winnt_2000);
424
425 # execute the command
426 $!=0;
427 if (system($cmd)!=0)
428 {
429 print STDERR "Powerpoint 95/97 converter failed $!\n";
430 } else {
431 return "html";
432 }
433 }
434
435 $success = &any_to_text($input_filename, $output_filestem);
436 if ($success) {
437 return "text";
438 }
439
440 return "fail";
441}
442
443
444sub convertXLS {
445 my ($input_filename, $output_filestem, $output_type) = @_;
446
447 my $success = 0;
448
449 # Attempt conversion to HTML
450 if (!$output_type || ($output_type =~ m/html/i)) {
451 # formulate the command
452 my $cmd = "";
453 my $full_perl_path = &util::filename_cat($ENV{'PERLPATH'},"perl");
454 $cmd .= "\"$full_perl_path\" -S xlstohtml.pl ";
455 $cmd .= " \"$input_filename\" \"$output_filestem.html\"";
456 $cmd .= " 2>\"$output_filestem.err\""
457 if ($ENV{'GSDLOS'} !~ m/^windows$/i || $is_winnt_2000);
458
459
460 # execute the command
461 $!=0;
462 if (system($cmd)!=0)
463 {
464 print STDERR "Excel 95/97 converter failed $!\n";
465 } else {
466 return "html";
467 }
468 }
469
470 $success = &any_to_text($input_filename, $output_filestem);
471 if ($success) {
472 return "text";
473 }
474
475 return "fail";
476}
477
478
479
480# Find the real type of a .doc file
481#
482# We seem to have a lot of files with a .doc extension that are .rtf
483# files or Word 5 files. This function attempts to tell the difference.
484sub find_docfile_type {
485 my ($input_filename) = @_;
486
487 if (($windows_scripting) && ($input_filename =~ m/\.docx$/)) {
488 return "docx";
489 }
490
491 open(CHK, "<$input_filename");
492 binmode(CHK);
493 my $line = "";
494 my $first = 1;
495
496 while (<CHK>) {
497
498 $line = $_;
499
500 if ($first) {
501 # check to see if this is an rtf file
502 if ($line =~ m/^\{\\rtf/) {
503 close(CHK);
504 return "rtf";
505 }
506 $first = 0;
507 }
508
509 # is this is a word 6/7/8 document?
510 if ($line =~ m/Word\.Document\.([678])/) {
511 close(CHK);
512
513 return "word$1";
514 }
515
516 }
517
518 return "unknown";
519}
520
521
522# Specific type-to-type conversions
523#
524# Each of the following functions attempts to convert a document from
525# a specific format to another. If they succeed they return 1 and leave
526# the output document(s) in the appropriate place; if they fail they
527# return 0 and delete any working files.
528
529
530# Attempt to convert a word document to html with the wv program
531sub doc_to_html {
532 my ($input_filename, $output_filestem) = @_;
533
534 my $wvWare = &util::filename_cat($ENV{'GSDLHOME'}, "bin", $ENV{'GSDLOS'}, "wvWare");
535
536 if ( -d "$ENV{'GSDLHOME'}/bin/$ENV{'GSDLOS'}/wv" && $ENV{'GSDLOS'} eq "linux" ) {
537 $ENV{'PATH'} = "$ENV{'GSDLHOME'}/bin/$ENV{'GSDLOS'}/wv/bin:$ENV{'PATH'}";
538 $ENV{'LD_LIBRARY_PATH'} = "$ENV{'GSDLHOME'}/bin/$ENV{'GSDLOS'}/wv/lib:$ENV{'LD_LIBRARY_PATH'}";
539 $wvWare = &util::filename_cat($ENV{'GSDLHOME'}, "bin", $ENV{'GSDLOS'}, "wv", "bin", "wvWare");
540 }
541
542 # don't include path on windows (to avoid having to play about
543 # with quoting when GSDLHOME might contain spaces) but assume
544 # that the PATH is set up correctly
545 $wvWare = "wvWare" if ($ENV{'GSDLOS'} =~ m/^windows$/i);
546
547 my $wv_conf = &util::filename_cat($ENV{'GSDLHOME'}, "etc",
548 "packages", "wv", "wvHtml.xml");
549
550 # Added the following to work with replace_srcdoc_with_html.pl:
551 # Make wvWare put any associated (image) files of the word doc into
552 # folder docname-without-extention_files. This folder should be at
553 # the same level as the html file generated from the doc.
554 # wvWare will take care of proper interlinking.
555
556 # This step is necessary for replace_srcdoc_with_html.pl which will
557 # move the html and associated files into the import folder. We
558 # want to ensure that the associated files won't overwrite similarly
559 # named items already in import. Hence we put them in a folder first
560 # (to which the html links properly) and that will allow
561 # replace_srcdoc_with_html.pl to move them safely to /import.
562
563 # To do all this, we need to use wvWare's --dir and --basename options
564 # where dir is the full path to the image folder directory and
565 # basename is the full path to the image folder appended to the name
566 # which is to be prepended to every image file:
567 # eg. if the images were to have names like sample0.jpg to sampleN.jpg,
568 # then the basename is "/full/path/to/imgdir/sample".
569 # In this case, basename is the full path to and name of the document.
570 # HOWEVER: basename always takes full path, not relative url, so
571 # the greenstone browser is unable to display the images (absolute paths
572 # cause it to give an "external link" message)
573 # See http://osdir.com/ml/lib.wvware.devel/2002-11/msg00014.html
574 # and http://rpmfind.net/linux/RPM/freshmeat/rpms/wv/wv-0.5.44-1.i386.html
575 # "added --dir option to wvHtml so that pictures can be placed in
576 # a seperate directory"
577 # "running wvWare through IMP to view word documents as html. It gets
578 # invoked like this:
579 # wvWare --dir=/tmp-wvWare --basename=/tmp-wvWare/img$$- $tmp_word >$tmp_output"
580
581 # toppath is the folder where html is generated
582 # docname is the name (without extension) of the html to be generated
583 # suffix (extension) is thrown away
584 my ($docname, $toppath)
585 = &File::Basename::fileparse($input_filename, "\\.[^\\.]+\$");
586
587 # We want the image folder generated to have the same name as windows
588 # would generate ($windows_scripting) when it converts from word to html.
589 # That is, foldername=docname_files
590 my $assoc_dir = &util::filename_cat($toppath, $docname."_files");
591 #print "assoc_dir: ".$assoc_dir."\n"; # same as "$output_filestem._files"
592
593 # ensure this image directory exists
594 # if it exists already, just delete and recreate
595 if(-e $assoc_dir) {
596 &util::rm_r($assoc_dir);
597 }
598 &util::mk_dir($assoc_dir);
599
600 # the images are all going to be called image0, image1,..., imageN
601 my $img_basenames = &util::filename_cat($assoc_dir, $docname);
602
603 #print STDERR "****toppath: $toppath\n****docname: $docname\n;
604 #print STDERR "****img_basenames: $img_basenames\n" if($img_basenames);
605 #print STDERR "****assoc_dir: $assoc_dir\n" if($assoc_dir);
606
607 my $cmd = "";
608 if ($timeout) {$cmd = "ulimit -t $timeout;";}
609 # wvWare's --dir and --basename options for image directory.
610 # Replaced the next line with the *2 lines* following it:
611 # $cmd .= "$wvWare --charset utf-8 --config \"$wv_conf\"";
612 $cmd .= "$wvWare --dir \"$assoc_dir\" --basename \"$img_basenames\"";
613 $cmd .= " --charset utf-8 --config \"$wv_conf\"";
614 $cmd .= " \"$input_filename\" > \"$output_filestem.html\"";
615
616 # redirecting STDERR is a bad idea on windows 95/98
617 $cmd .= " 2> \"$output_filestem.err\""
618 if ($ENV{'GSDLOS'} !~ m/^windows$/i || $is_winnt_2000);
619 # execute the command
620 $!=0;
621 if (system($cmd)!=0)
622 {
623 print STDERR "Error executing wv converter:$!\n";
624 if (-s "$output_filestem.err") {
625 open (ERRFILE, "<$output_filestem.err");
626
627 my $write_to_fail_log=0;
628 if ($faillogfile ne "" && defined(open(FAILLOG,">>$faillogfile")))
629 {$write_to_fail_log=1;}
630
631 my $line;
632 while ($line=<ERRFILE>) {
633 if ($line =~ m/\w/) {
634 print STDERR "$line";
635 print FAILLOG "$line" if ($write_to_fail_log);
636 }
637 if ($line !~ m/startup error/) {next;}
638 print STDERR " (given an invalid .DOC file?)\n";
639 print FAILLOG " (given an invalid .DOC file?)\n"
640 if ($write_to_fail_log);
641
642 } # while ERRFILE
643 close FAILLOG if ($write_to_fail_log);
644 }
645 return 0; # we can try any_to_text
646 }
647
648 # Was the conversion successful?
649
650 if (-s "$output_filestem.html") { # if file has non-zero size (i.e. it has contents)
651 open(TMP, "$output_filestem.html");
652 my $line = <TMP>;
653 close(TMP);
654 if ($line && $line =~ m/DOCTYPE HTML/) {
655 &util::rm("$output_filestem.err") if -e "$output_filestem.err";
656
657 # Inserted this code to remove the images directory if it was still empty after
658 # the html was generated (in case there were no images in the word document)
659 if (&util::is_dir_empty($assoc_dir)) {
660 #print STDERR "***gsConvert.pl: Image dir $assoc_dir is empty, removing***\n";
661 &util::rm_r($assoc_dir);
662 } else { # there was an image folder (it was generated)
663 # Therefore, the html file generated contains absolute links to the images
664 # Replace them with relative links instead, so the folder can be moved elsewhere
665 &make_links_to_assocdir_relative($toppath, $docname, "$output_filestem.html", $assoc_dir, $docname."_files");
666 }
667 return 1;
668 }
669 }
670
671 # If here, an error of some sort occurred
672 &util::rm("$output_filestem.html") if -e "$output_filestem.html";
673 if (-e "$output_filestem.err") {
674 if ($faillogfile ne "" && defined(open(FAILLOG,">>$faillogfile"))) {
675 open (ERRLOG,"$output_filestem.err");
676 while (<ERRLOG>) {print FAILLOG $_;}
677 close FAILLOG;
678 close ERRLOG;
679 }
680 &util::rm("$output_filestem.err");
681 }
682
683 return 0;
684}
685
686# Method to work with doc_to_html - Word docs might contain images.
687# When such word docs are converted with wvWare, we make it generate a
688# <filename>_files folder with the associated images, while the html file
689# <filename> refers to the images using absolute paths to <filename>_files.
690# This method reads in that html file and replaces all the absolute paths to
691# the images in <filename>_files with the relative paths to the images from
692# that folder. (I.e. with <filename>_files/<imagename.ext>).
693sub make_links_to_assocdir_relative{
694 # toppath is the top-level folder in which the html file we're going to be fixing resides
695 # docname is just the name (without extension) of the html file
696 # html_file is the full path to the html file: /full/path/docname.html
697 # assoc_dir_path is toppath/docname_files
698 # assoc_dirname is the directory name of the folder with associated imgs: docname_files
699 my ($toppath, $docname, $html_file, $assoc_dir_path, $assoc_dirname) = @_;
700
701 # 1. Read all the contents of the html into a string
702 # open the original file for reading
703 unless(open(FIN, "<$html_file")) {
704 print STDERR "gsConvert.pl: Unable to open $html_file for reading absolute urls...ERROR: $!\n";
705 return 0;
706 }
707 # From http://perl.plover.com/local.html
708 # "It's cheaper to read the file all at once, without all the splitting and reassembling.
709 # (Some people call this slurping the file.) Perl has a special feature to support this:
710 # If the $/ variable is undefined, the <...> operator will read the entire file all at once"
711 my $html_contents;
712 {
713 local $/ = undef; # Read entire file at once
714 $html_contents = <FIN>; # Now file is read in as one single 'line'
715 }
716 close(FIN); # close the file
717 #print STDERR $html_contents;
718
719 # 2. Replace (substitute) *all* ocurrences of the assoc_dir_path in a hrefs and img src
720 # values with assoc_dirname
721 # At the end: g means substitute all occurrences (global), while s at the end means treat
722 # all new lines as a regular space. This interacts with g to consider all the lines
723 # together as a single line so that multi-occurrences can be replaced.
724
725 # we can't just replace $assoc_dir_path with $assoc_dir
726 # $assoc_dir_path represents a regular expression that needs to be replaced
727 # if it contains ., -, [, ], or Windows style backslashes in paths -- which all have special
728 # meaning in Perl regular expressions -- we need to escape these first
729 my $safe_reg_expression = $assoc_dir_path;
730 $safe_reg_expression =~ s/\\/\\\\/g;
731 $safe_reg_expression =~ s/\./\\./g;
732 $safe_reg_expression =~ s/\-/\\-/g;
733 $safe_reg_expression =~ s/\[/\\[/g;
734 $safe_reg_expression =~ s/\]/\\]/g;
735 $safe_reg_expression =~ s/ /%20/g; # wvWare put %20 in place of space, so we need to change our prefix to match
736
737 # The following regular expression substitution looks for <a or <image, followed by any other
738 # attributes and values until it comes to the FIRST (indicated by ?) href= or src=
739 # followed by " or ' no quotes at all around path, followed by the associated folder's pathname
740 # followed by characters (for the img filename), then finally the optional closing quotes
741 # in " or ' form, followed by any other attributes and values until the first > to end the tag.
742 # The substitution: all the parts preceding associated folder's pathname are retained,
743 # the associated folder path name is replaced by associated folder directory name
744 # and the rest upto and including the closing > tag is retained.
745 # The sg at the end of the pattern match treats all of html_contents as a single line (s)
746 # and performs a global replace (g) meaning that all occurrences that match in that single line
747 # are substituted.
748 $html_contents =~ s/(<(a|img).*?(href|src)=(\"|\')?)$safe_reg_expression(.*?(\"|\')?.*?>)/$1$assoc_dirname$5/sg;
749 #$html_contents =~ s/$safe_reg_expression/$assoc_dirname/gs; # this works, used as fall-back
750 # now replace any %20 chars in filenames of href or src attributes to use literal space ' '. Calls a function for this
751 $html_contents =~ s/(<(a|img).*?(href|src)=(\"|\')?)(.*)(.*?(\"|\')?.*?>)/&post_process_assocfile_urls($1, $5, $6)/sge;
752
753 #print STDERR "****assoc_dirname: $assoc_dirname***\n";
754 #print STDERR "****safe_reg_expression: $safe_reg_expression***\n";
755
756 # delete the original file and recreate it
757 my $copy_of_filename = $html_file;
758 &util::rm($copy_of_filename); # deleted the file
759
760 # Recreate the original file for writing the updated contents
761 unless(open(FOUT, ">$html_file")) { # open it as a new file for writing
762 print STDERR "gsConvert.pl: Unable to open $html_file for writing relative links...ERROR: $!\n";
763 return 0;
764 }
765
766 # write out the updated contents and close the file
767 print FOUT $html_contents;
768 close(FOUT);
769 return 1;
770}
771
772# Utility routine to make sure HTML plugin gets img src/href link pathnames that contain
773# url slashes (/) instead of windows-style backwards slashes, and to convert all %20
774# introduced in link pathnames by wvWare into space again. Converts all percent signs
775# introduced by URL encoding filenames generated into %25 in these url links referencing them
776sub post_process_assocfile_urls
777{
778 my ($pre, $text, $post) = @_;
779
780 $text =~ s/%20/ /g; # Convert %20s to space and not underscore since underscores mess with incremental rebuild
781 # $text =~ s/%20/_/g; # reinstated this line, since we no longer replace spaces with %20. We replace them with underscores
782 $text =~ s/\\/\//g;
783 $text =~ s/%/%25/g;
784
785 return "$pre$text$post";
786}
787
788# Attempt to convert a word document to html with the word2html scripting program
789sub native_doc_to_html {
790 my ($input_filename, $output_filestem) = @_;
791
792 # build up the path to the doc-to-html conversion tool we're going to use
793 my $vbScript = &util::filename_cat($ENV{'GSDLHOME'}, "bin", $ENV{'GSDLOS'});
794
795 if ($ENV{'GSDLOS'} =~ m/^windows$/i) {
796 # if windows scripting with docx input, use new VBscript to get the local Word install (if
797 # any) to do the conversion, since docX can't be processed by word2html's windows_scripting
798
799 if($input_filename =~ m/docx$/i) { # need to use full path to docx2html script,
800 # else script launch fails when there are error msgs
801 $vbScript = &util::filename_cat($vbScript, "docx2html.vbs");
802 $vbScript = "CScript //Nologo \"$vbScript\""; # launche with CScript for error output in STDERR
803 # //Nologo flag avoids Microsoft's opening/logo msgs
804 print STDERR "About to use windows scripting to process docx file $input_filename.\n";
805 print STDERR " This may take some time. Please wait...\n";
806 }
807 else { # old doc versions. use the usual VB executable word2html for the
808 # conversion. Doesn't need full path, since bin\windows is on PATH
809 $vbScript = "word2html"; #$vbScript = "\"".&util::filename_cat($vbScript, "word2html")."\"";
810 }
811 }
812 else { # not windows
813 $vbScript = "\"".&util::filename_cat($vbScript, "word2html")."\"";
814 }
815
816 if (-e "$output_filestem.html") {
817 print STDERR " The conversion file:\n";
818 print STDERR " $output_filestem.html\n";
819 print STDERR " ... already exists. Skipping\n";
820 return 1;
821 }
822
823 my $cmd = "";
824 if ($timeout) {$cmd = "ulimit -t $timeout;";}
825 #$cmd .= "$vbScript \"$input_filename\" \"$output_filestem.html\"";
826 #$cmd .= "$vbScript $input_filename $output_filestem.html";
827 $cmd .= "$vbScript \"$input_filename\" \"$output_filestem.html\"";
828
829 # redirecting STDERR
830
831 $cmd .= " 2> \"$output_filestem.err\""
832 if ($ENV {'GSDLOS'} !~ m/^windows$/i || $is_winnt_2000);
833 #print STDERR "@@@@@@@@@ cmd=$cmd\n";
834
835 # execute the command
836 $!=0;
837 if (system($cmd)!=0)
838 {
839 print STDERR "Error executing $vbScript converter:$!\n";
840 if (-s "$output_filestem.err") {
841 open (ERRFILE, "<$output_filestem.err");
842
843 my $write_to_fail_log=0;
844 if ($faillogfile ne "" && defined(open(FAILLOG,">>$faillogfile")))
845 {$write_to_fail_log=1;}
846
847 my $line;
848 while ($line=<ERRFILE>) {
849 if ($line =~ m/\w/) {
850 print STDERR "$line";
851 print FAILLOG "$line" if ($write_to_fail_log);
852 }
853 if ($line !~ m/startup error/) {next;}
854 print STDERR " (given an invalid .DOC file?)\n";
855 print FAILLOG " (given an invalid .DOC file?)\n"
856 if ($write_to_fail_log);
857
858 } # while ERRFILE
859 close FAILLOG if ($write_to_fail_log);
860 }
861 return 0; # we can try any_to_text
862 }
863
864 # Was the conversion successful?
865 if (-s "$output_filestem.html") {
866 open(TMP, "$output_filestem.html");
867 my $line = <TMP>;
868 close(TMP);
869 if ($line && $line =~ m/html/i) {
870 &util::rm("$output_filestem.err") if -e "$output_filestem.err";
871 return 1;
872 }
873 }
874
875 # If here, an error of some sort occurred
876 &util::rm("$output_filestem.html") if -e "$output_filestem.html";
877 if (-e "$output_filestem.err") {
878 if ($faillogfile ne "" && defined(open(FAILLOG,">>$faillogfile"))) {
879 open (ERRLOG,"$output_filestem.err");
880 while (<ERRLOG>) {print FAILLOG $_;}
881 close FAILLOG;
882 close ERRLOG;
883 }
884 &util::rm("$output_filestem.err");
885 }
886 return 0;
887}
888
889# Attempt to convert an RTF document to html with rtftohtml
890sub rtf_to_html {
891 my ($input_filename, $output_filestem) = @_;
892
893 # formulate the command
894 my $cmd = "";
895 if ($timeout) {$cmd = "ulimit -t $timeout;";}
896 $cmd .= "rtftohtml";
897 #$cmd .= "rtf-converter";
898
899 $cmd .= " -o \"$output_filestem.html\" \"$input_filename\"";
900
901 $cmd .= " 2>\"$output_filestem.err\""
902 if ($ENV{'GSDLOS'} !~ m/^windows$/i || $is_winnt_2000);
903
904
905 # execute the command
906 $!=0;
907 if (system($cmd)!=0)
908 {
909 print STDERR "Error executing rtf converter $!\n";
910 # don't currently bother printing out error log...
911 # keep going, in case it still created an HTML file...
912 }
913
914 # Was the conversion successful?
915 my $was_successful=0;
916 if (-s "$output_filestem.html") {
917 # make sure we have some content other than header
918 open (HTML, "$output_filestem.html"); # what to do if fail?
919 my $line;
920 my $past_header=0;
921 while ($line=<HTML>) {
922
923 if ($past_header == 0) {
924 if ($line =~ m/<body>/) {$past_header=1;}
925 next;
926 }
927
928 $line =~ s/<[^>]+>//g;
929 if ($line =~ m/\w/ && $past_header) { # we found some content...
930 $was_successful=1;
931 last;
932 }
933 }
934 close HTML;
935 }
936
937 if ($was_successful) {
938 &util::rm("$output_filestem.err")
939 if (-e "$output_filestem.err");
940 # insert the (modified) table of contents, if it exists.
941 if (-e "${output_filestem}_ToC.html") {
942 &util::mv("$output_filestem.html","$output_filestem.src");
943 my $open_failed=0;
944 open HTMLSRC, "$output_filestem.src" || ++$open_failed;
945 open TOC, "${output_filestem}_ToC.html" || ++$open_failed;
946 open HTML, ">$output_filestem.html" || ++$open_failed;
947
948 if ($open_failed) {
949 close HTMLSRC;
950 close TOC;
951 close HTML;
952 &util::mv("$output_filestem.src","$output_filestem.html");
953 return 1;
954 }
955
956 # print out header info from src html.
957 while (defined($_ = <HTMLSRC>) && $_ =~ m/\w/) {
958 print HTML "$_";
959 }
960
961 # print out table of contents, making links relative
962 <TOC>; <TOC>; # ignore first 2 lines
963 print HTML scalar(<TOC>); # line 3 = "<ol>\n"
964 my $line;
965 while ($line=<TOC>) {
966 $line =~ s@</body></html>$@@i ; # only last line has this
967 # make link relative
968 $line =~ s@href=\"[^\#]+@href=\"@i;
969 print HTML $line;
970 }
971 close TOC;
972
973 # rest of html src
974 while (<HTMLSRC>) {
975 print HTML $_;
976 }
977 close HTMLSRC;
978 close HTML;
979
980 &util::rm("${output_filestem}_ToC.html");
981 &util::rm("${output_filestem}.src");
982 }
983 # we don't yet do anything with footnotes ($output_filestem_fn.html) :(
984 return 1; # success
985 }
986
987 if (-e "$output_filestem.err") {
988 if ($faillogfile ne "" && defined(open(FAILLOG,">>$faillogfile")))
989 {
990 print FAILLOG "Error - rtftohtml - couldn't extract text\n";
991 #print FAILLOG "Error - rtf-converter - couldn't extract text\n";
992 print FAILLOG " (rtf file might be too recent):\n";
993 open (ERRLOG, "$output_filestem.err");
994 while (<ERRLOG>) {print FAILLOG $_;}
995 close ERRLOG;
996 close FAILLOG;
997 }
998 &util::rm("$output_filestem.err");
999 }
1000
1001 &util::rm("$output_filestem.html") if (-e "$output_filestem.html");
1002
1003 return 0;
1004}
1005
1006
1007# Convert a pdf file to html with the pdftohtml command
1008
1009sub pdf_to_html {
1010 my ($dirname, $input_filename, $output_filestem) = @_;
1011
1012 my $cmd = "";
1013 if ($timeout) {$cmd = "ulimit -t $timeout;";}
1014 my $full_perl_path = &util::filename_cat($ENV{'PERLPATH'},"perl");
1015 $cmd .= "\"$full_perl_path\" -S pdftohtml.pl -zoom $pdf_zoom";
1016 $cmd .= " -c" if ($pdf_complex);
1017 $cmd .= " -i" if ($pdf_ignore_images);
1018 $cmd .= " -a" if ($pdf_allow_images_only);
1019 $cmd .= " -hidden" unless ($pdf_nohidden);
1020 $cmd .= " \"$input_filename\" \"$output_filestem\"";
1021
1022 if ($ENV{'GSDLOS'} !~ m/^windows$/i || $is_winnt_2000) {
1023 $cmd .= " > \"$output_filestem.out\" 2> \"$output_filestem.err\"";
1024 } else {
1025 $cmd .= " > \"$output_filestem.err\"";
1026 }
1027
1028 $!=0;
1029
1030 my $retval=system($cmd);
1031 if ($retval!=0)
1032 {
1033 print STDERR "Error executing pdftohtml.pl";
1034 if ($!) {print STDERR ": $!";}
1035 print STDERR "\n";
1036 }
1037
1038 # make sure the converter made something
1039 if ($retval!=0 || ! -s "$output_filestem.html")
1040 {
1041 &util::rm("$output_filestem.out") if (-e "$output_filestem.out");
1042 # print out the converter's std err, if any
1043 if (-s "$output_filestem.err") {
1044 open (ERRLOG, "$output_filestem.err") || die "$!";
1045 print STDERR "pdftohtml error log:\n";
1046 while (<ERRLOG>) {
1047 print STDERR "$_";
1048 }
1049 close ERRLOG;
1050 }
1051 print STDERR "***********output filestem $output_filestem.html\n";
1052 &util::rm("$output_filestem.html") if (-e "$output_filestem.html");
1053 if (-e "$output_filestem.err") {
1054 if ($faillogfile ne "" && defined(open(FAILLOG,">>$faillogfile")))
1055 {
1056 open (ERRLOG, "$output_filestem.err");
1057 while (<ERRLOG>) {print FAILLOG $_;}
1058 close ERRLOG;
1059 close FAILLOG;
1060 }
1061 &util::rm("$output_filestem.err");
1062 }
1063 return 0;
1064 }
1065
1066 &util::rm("$output_filestem.err") if (-e "$output_filestem.err");
1067 &util::rm("$output_filestem.out") if (-e "$output_filestem.out");
1068 return 1;
1069}
1070
1071# Convert a pdf file to various types of image with the convert command
1072
1073sub pdfps_to_img {
1074 my ($dirname, $input_filename, $output_filestem, $output_type) = @_;
1075
1076 # Check that ImageMagick is installed and available on the path (except for Windows 95/98)
1077 if (!($ENV{'GSDLOS'} eq "windows" && !Win32::IsWinNT())) {
1078 my $result = `identify 2>&1`;
1079 if ($? == -1 || $? == 256) { # Linux and Windows return different values for "program not found"
1080 #ImageMagick is not installed, thus the convert utility is not available.
1081 print STDERR "*** ImageMagick is not installed, the convert utility is not available. Unable to convert PDF/PS to images\n";
1082 return 0;
1083 }
1084 }
1085
1086 my $cmd = "";
1087 if ($timeout) {$cmd = "ulimit -t $timeout;";}
1088 $output_type =~ s/.*\_(.*)/$1/i;
1089 my $full_perl_path = &util::filename_cat($ENV{'PERLPATH'},"perl");
1090 $cmd .= "\"$full_perl_path\" -S pdfpstoimg.pl -convert_to $output_type \"$input_filename\" \"$output_filestem\"";
1091 if ($ENV{'GSDLOS'} !~ m/^windows$/i || $is_winnt_2000) {
1092 $cmd .= " > \"$output_filestem.out\" 2> \"$output_filestem.err\"";
1093 } else {
1094 $cmd .= " > \"$output_filestem.err\"";
1095 }
1096
1097 # don't include path on windows (to avoid having to play about
1098 # with quoting when GSDLHOME might contain spaces) but assume
1099 # that the PATH is set up correctly
1100 $!=0;
1101 my $retval=system($cmd);
1102 if ($retval!=0)
1103 {
1104 print STDERR "Error executing pdftoimg.pl";
1105 if ($!) {print STDERR ": $!";}
1106 print STDERR "\n";
1107 }
1108
1109 #make sure the converter made something
1110 #if ($retval !=0) || ! -s "$output_filestem")
1111 if ($retval !=0)
1112 {
1113 &util::rm("$output_filestem.out") if (-e "$output_filestem.out");
1114 #print out the converter's std err, if any
1115 if (-s "$output_filestem.err") {
1116 open (ERRLOG, "$output_filestem.err") || die "$!";
1117 print STDERR "pdfpstoimg error log:\n";
1118 while (<ERRLOG>) {
1119 print STDERR "$_";
1120 }
1121 close ERRLOG;
1122 }
1123 #&util::rm("$output_filestem.html") if (-e "$output_filestem.html");
1124 if (-e "$output_filestem.err") {
1125 if ($faillogfile ne "" && defined(open(FAILLOG,">>$faillogfile")))
1126 {
1127 open (ERRLOG, "$output_filestem.err");
1128 while (<ERRLOG>) {print FAILLOG $_;}
1129 close ERRLOG;
1130 close FAILLOG;
1131 }
1132 &util::rm("$output_filestem.err");
1133 }
1134 return 0;
1135 }
1136 &util::rm("$output_filestem.err") if (-e "$output_filestem.err");
1137 &util::rm("$output_filestem.out") if (-e "$output_filestem.out");
1138 return 1;
1139}
1140
1141# Convert a PDF file to text with the pdftotext command
1142
1143sub pdf_to_text {
1144 my ($dirname, $input_filename, $output_filestem) = @_;
1145
1146 my $cmd = "pdftotext \"$input_filename\" \"$output_filestem.text\"";
1147
1148 if ($ENV{'GSDLOS'} !~ m/^windows$/i) {
1149 $cmd .= " > \"$output_filestem.out\" 2> \"$output_filestem.err\"";
1150 } else {
1151 $cmd .= " > \"$output_filestem.err\"";
1152 }
1153
1154 if (system($cmd)!=0)
1155 {
1156 print STDERR "Error executing $cmd: $!\n";
1157 &util::rm("$output_filestem.text") if (-e "$output_filestem.text");
1158 }
1159
1160 # make sure there is some extracted text.
1161 if (-e "$output_filestem.text") {
1162 open (EXTR_TEXT, "$output_filestem.text") || warn "open: $!";
1163 binmode(EXTR_TEXT); # just in case...
1164 my $line="";
1165 my $seen_text=0;
1166 while (($seen_text==0) && ($line=<EXTR_TEXT>)) {
1167 if ($line=~ m/\w/) {$seen_text=1;}
1168 }
1169 close EXTR_TEXT;
1170 if ($seen_text==0) { # no text was extracted
1171 print STDERR "Error: pdftotext found no text\n";
1172 &util::rm("$output_filestem.text");
1173 }
1174 }
1175
1176 # make sure the converter made something
1177 if (! -s "$output_filestem.text")
1178 {
1179 # print out the converters std err, if any
1180 if (-s "$output_filestem.err") {
1181 open (ERRLOG, "$output_filestem.err") || die "$!";
1182 print STDERR "pdftotext error log:\n";
1183 while (<ERRLOG>) {
1184 print STDERR "$_";
1185 }
1186 close ERRLOG;
1187 }
1188 # does this converter create a .out file?
1189 &util::rm("$output_filestem.out") if (-e "$output_filestem.out");
1190 &util::rm("$output_filestem.text") if (-e "$output_filestem.text");
1191 if (-e "$output_filestem.err") {
1192 if ($faillogfile ne "" && defined(open(FAILLOG,">>$faillogfile")))
1193 {
1194 open (ERRLOG,"$output_filestem.err");
1195 while (<ERRLOG>) {print FAILLOG $_;}
1196 close ERRLOG;
1197 close FAILLOG;
1198 }
1199 &util::rm("$output_filestem.err");
1200 }
1201 return 0;
1202 }
1203 &util::rm("$output_filestem.err") if (-e "$output_filestem.err");
1204 return 1;
1205}
1206
1207# Convert a PostScript document to text
1208# note - just using "ps2ascii" isn't good enough, as it
1209# returns 0 for a postscript interpreter error. ps2ascii is just
1210# a wrapper to "gs" anyway, so we use that cmd here.
1211
1212sub ps_to_text {
1213 my ($input_filename, $output_filestem) = @_;
1214
1215 my $error = "";
1216
1217 # if we're on windows we'll fall straight through without attempting
1218 # to use gs
1219 if ($ENV{'GSDLOS'} =~ m/^windows$/i) {
1220 $error = "Windows does not support gs";
1221
1222 } else {
1223 my $cmd = "";
1224 if ($timeout) {$cmd = "ulimit -t $timeout; ";}
1225 $cmd .= "gs -q -dNODISPLAY -dNOBIND -dWRITESYSTEMDICT -dSIMPLE -c save ";
1226 $cmd .= "-f ps2ascii.ps \"$input_filename\" -c quit > \"$output_filestem.text\"";
1227 #$cmd .= "pstotext -output \"$output_filestem.text\" $input_filename\"";
1228 $cmd .= " 2> $output_filestem.err";
1229 $!=0;
1230
1231 my $retcode=system($cmd);
1232 $retcode = $? >> 8; # see man perlfunc - system for this...
1233 # if system returns -1 | 127 (couldn't start program), look at $! for message
1234
1235 if ($retcode!=0) {if ($!) {$error=$!;} else {$error="couldn't run.\n";}}
1236 elsif (! -e "$output_filestem.text") {
1237 $error="did not create output file.\n";
1238 }
1239 else
1240 { # make sure the interpreter didn't get an error. It is technically
1241 # possible for the actual text to start with this, but....
1242 open PSOUT, "$output_filestem.text";
1243 if (<PSOUT> =~ m/^Error: (.*)/) {
1244 $error="interpreter error - \"$1\"";
1245 }
1246 close PSOUT;
1247 }
1248 }
1249
1250 if ($error ne "")
1251 {
1252 print STDERR "Warning: Error executing gs: $error\n";
1253 &util::rm("$output_filestem.text") if (-e "$output_filestem.text");
1254
1255 if ("$faillogfile" ne "" && defined(open (FAILLOG, ">>$faillogfile")))
1256 {
1257 print FAILLOG "gs - $error\n";
1258 if (-e "$output_filestem.err") {
1259 open(ERRLOG, "$output_filestem.err");
1260 while (<ERRLOG>) {print FAILLOG $_;}
1261 close ERRLOG;
1262 }
1263 close FAILLOG;
1264 }
1265 &util::rm("$output_filestem.err") if (-e "$output_filestem.err");
1266
1267
1268 # Fine then. We'll just do a lousy job by ourselves...
1269 # Based on 5-line regexp sed script found at:
1270 # http://snark.ptc.spbu.ru/mail-archives/lout/brown/msg00003.html
1271 #
1272 print STDERR "Stripping text from postscript\n";
1273 my $errorcode=0;
1274 open (IN, "$input_filename")
1275 || ($errorcode=1, warn "Couldn't read file: $!");
1276 open (OUT, ">$output_filestem.text")
1277 || ($errorcode=1, warn "Couldn't write file: $!");
1278 if ($errorcode) {print STDERR "errors\n";return 0;}
1279
1280 my $text=""; # this is for whole .ps file...
1281 $text = join('', <IN>); # see man perlport, under "System Resources"
1282 close IN;
1283
1284 # Make sure this is a ps file...
1285 if ($text !~ m/^%!/) {
1286 print STDERR "Bad postscript header: not '%!'\n";
1287 if ($faillogfile ne "" && defined(open(FAILLOG, ">>$faillogfile")))
1288 {
1289 print FAILLOG "Bad postscript header: not '%!'\n";
1290 close FAILLOG;
1291 }
1292 return 0;
1293 }
1294
1295 # if ps has Page data, then use it to delete all stuff before it.
1296 $text =~ s/^.*?%%Page:.*?\n//s; # treat string as single line
1297
1298 # remove all leading non-data stuff
1299 $text =~ s/^.*?\(//s;
1300
1301 # remove all newline chars for easier processing
1302 $text =~ s/\n//g;
1303
1304 # Big assumption here - assume that if any co-ordinates are
1305 # given, then we are at the end of a sentence.
1306 $text =~ s/\)-?\d+\ -?\d+/\) \(\n\)/g;
1307
1308 # special characters--
1309 $text =~ s/\(\|\)/\(\ - \)/g; # j -> em-dash?
1310
1311 # ? ps text formatting (eg italics?) ?
1312 $text =~ s/Fn\(f\)/\(\{\)/g; # f -> {
1313 $text =~ s/Fn\(g\)/\(\}\)/g; # g -> }
1314 $text =~ s/Fn\(j\)/\(\|\)/g; # j -> |
1315 # default - remove the rest
1316 $text =~ s/\ ?F.\((.+?)\)/\($1\)/g;
1317
1318 # attempt to add whitespace between words...
1319 # this is based purely on observation, and may be completely wrong...
1320 $text =~ s/([^F])[defghijkuy]\(/$1 \( /g;
1321 # eg I notice "b(" is sometimes NOT a space if preceded by a
1322 # negative number.
1323 $text =~ s/\)\d+ ?b\(/\) \( /g;
1324
1325 # change quoted braces to brackets
1326 $text =~ s/([^\\])\\\(/$1\{/g;
1327 $text =~ s/([^\\])\\\)/$1\}/g ;
1328
1329 # remove everything that is not between braces
1330 $text =~ s/\)([^\(\)])+?\(//sg ;
1331
1332 # remove any Trailer eof stuff.
1333 $text =~ s/\)[^\)]*$//sg;
1334
1335 ### ligatures have special characters...
1336 $text =~ s/\\013/ff/g;
1337 $text =~ s/\\014/fi/g;
1338 $text =~ s/\\015/fl/g;
1339 $text =~ s/\\016/ffi/g;
1340 $text =~ s/\\214/fi/g;
1341 $text =~ s/\\215/fl/g;
1342 $text =~ s/\\017/\n\* /g; # asterisk?
1343 $text =~ s/\\023/\023/g; # e acute ('e)
1344 $text =~ s/\\177/\252/g; # u"
1345# $text =~ s/ ?? /\344/g; # a"
1346
1347 print OUT "$text";
1348 close OUT;
1349 }
1350 # wrap the text - use a minimum length. ie, first space after this length.
1351 my $wrap_length=72;
1352 &util::mv("$output_filestem.text", "$output_filestem.text.tmp");
1353 open INFILE, "$output_filestem.text.tmp" ||
1354 die "Couldn't open file: $!";
1355 open OUTFILE, ">$output_filestem.text" ||
1356 die "Couldn't open file for writing: $!";
1357 my $line="";
1358 while ($line=<INFILE>) {
1359 while (length($line)>0) {
1360 if (length($line)>$wrap_length) {
1361 $line =~ s/^(.{$wrap_length}[^\s]*)\s*//;
1362 print OUTFILE "$1\n";
1363 } else {
1364 print OUTFILE "$line";
1365 $line="";
1366 }
1367 }
1368 }
1369 close INFILE;
1370 close OUTFILE;
1371 &util::rm("$output_filestem.text.tmp");
1372
1373 &util::rm("$output_filestem.err") if (-e "$output_filestem.err");
1374 return 1;
1375}
1376
1377
1378# Convert any file to HTML with a crude perl implementation of the
1379# UNIX strings command.
1380
1381sub any_to_html {
1382 my ($input_filename, $output_filestem) = @_;
1383
1384 # First generate a text file
1385 return 0 unless (&any_to_text($input_filename, $output_filestem));
1386
1387 # create an HTML file from the text file
1388 open(TEXT, "<$output_filestem.text");
1389 open(HTML, ">$output_filestem.html");
1390
1391 print HTML "<html><head>\n";
1392 print HTML "<META HTTP-EQUIV=\"Content-Type\" CONTENT=\"text/html\">\n";
1393 print HTML "<META NAME=\"GENERATOR\" CONTENT=\"Greenstone any_to_html\">\n";
1394 print HTML "</head><body>\n\n";
1395
1396 my $line;
1397 while ($line=<TEXT>) {
1398 $line =~ s/</&lt;/g;
1399 $line =~ s/>/&gt;/g;
1400 if ($line =~ m/^\s*$/) {
1401 print HTML "<p>";
1402 } else {
1403 print HTML "<br> ", $line;
1404 }
1405 }
1406 print HTML "\n</body></html>\n";
1407
1408 close HTML;
1409 close TEXT;
1410
1411 &util::rm("$output_filestem.text") if (-e "$output_filestem.text");
1412 return 1;
1413}
1414
1415# Convert any file to TEXT with a crude perl implementation of the
1416# UNIX strings command.
1417# Note - this assumes ascii charsets :( (jrm21)
1418
1419sub any_to_text {
1420 my ($input_filename, $output_filestem) = @_;
1421
1422 if (!$use_strings) {
1423 return 0;
1424 }
1425
1426 print STDERR "\n**** In any to text****\n\n";
1427 open(IN, "<$input_filename") || return 0;
1428 binmode(IN);
1429 open(OUT, ">$output_filestem.text") || return 0;
1430
1431 my ($line);
1432 my $output_line_count = 0;
1433 while (<IN>) {
1434 $line = $_;
1435
1436 # delete anything that isn't a printable character
1437 $line =~ s/[^\040-\176]+/\n/sg;
1438
1439 # delete any string less than 10 characters long
1440 $line =~ s/^.{0,9}$/\n/mg;
1441 while ($line =~ m/^.{1,9}$/m) {
1442 $line =~ s/^.{0,9}$/\n/mg;
1443 $line =~ s/\n+/\n/sg;
1444 }
1445
1446 # remove extraneous whitespace
1447 $line =~ s/\n+/\n/gs;
1448 $line =~ s/^\n//gs;
1449
1450 # output whatever is left
1451 if ($line =~ m/[^\n ]/) {
1452 print OUT $line;
1453 ++$output_line_count;
1454 }
1455 }
1456
1457 close OUT;
1458 close IN;
1459
1460 if ($output_line_count) { # try to protect against binary only formats
1461 return 1;
1462 }
1463
1464 &util::rm("$output_filestem.text");
1465 return 0;
1466
1467}
Note: See TracBrowser for help on using the repository browser.