-
Notifications
You must be signed in to change notification settings - Fork 1
/
a2ping.pl
2399 lines (2211 loc) · 92 KB
/
a2ping.pl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
#! /bin/sh
eval '(exit $?0)' && eval 'PERL_BADLANG=x;export PERL_BADLANG;: \
;exec perl -x -S -- "$0" ${1+"$@"};#'if 0;
eval 'setenv PERL_BADLANG x;exec perl -x -S -- "$0" $argv:q;#'.q+
#!perl -w
package Htex::a2ping; $0=~/(.*)/s;unshift@INC,'.';do($1);die$@if$@;__END__+if !1;
# This Perl script was generated by JustLib2 at Wed Apr 23 09:14:13 2003.
# Don't touch/remove any lines above; http://www.inf.bme.hu/~pts/justlib
#
# This program is free software, licensed under the GNU GPL, >=2.0.
# This software comes with absolutely NO WARRANTY. Use at your own risk!
#
package just; BEGIN{$INC{'just.pm'}='just.pm'}
BEGIN{ $just::VERSION=2 }
sub end(){1}
sub main(){}
BEGIN{$ INC{'strict.pm'}='strict.pm'} {
package strict;
use just;
# by [email protected] at Wed Jan 10 12:42:08 CET 2001
require 5.002;
sub bits {
(grep{'refs'eq$_}@_ && 2)|
(grep{'subs'eq$_}@_ && 0x200)|
(grep{'vars'eq$_}@_ && 0x400)|
($@ || 0x602)
}
sub import { shift; $^H |= bits @_ }
sub unimport { shift; $^H &= ~ bits @_ }
just::end}
BEGIN{$ INC{'integer.pm'}='integer.pm'} {
package integer;
use just;
# by [email protected] at Wed Jan 10 12:42:08 CET 2001
sub import { $^H |= 1 }
sub unimport { $^H &= ~1 }
just::end}
BEGIN{$ INC{'Pts/string.pm'}='Pts/string.pm'} {
package Pts::string;
# by [email protected] at Sat Dec 21 21:32:18 CET 2002
use just;
use integer;
use strict;
#** @param $_[0] a string
#** @param $_[1] index of first bit to return. Bit 128 of byte 0 is index 0.
#** @param $_[2] number of bits to return (<=32)
#** @return an integer (negative on overflow), bit at $_[1] is its MSB
sub get_bits_msb($$$) {
# assume: use integer;
my $loop=$_[1];
my $count=$_[2];
my $ret=0;
($ret+=$ret+(1&(vec($_[0],$loop>>3,8)>>(7-($loop&7)))), $loop++) while $count--!=0;
$ret
}
#** @param $_[0] a string
#** @return value if $_[0] represents a floating point numeric constant
#** in the C language (without the LU etc. modifiers) -- or undef. Returns
#** undef for integer constants
sub c_floatval($) {
my $S=$_[0];
no integer; # very important; has local scope
return 0.0+$S if $S=~/\A[+-]?(?:[0-9]*\.[0-9]+|[0-9]+\.])(?:[eE][+-]?[0-9]+)?\Z(?!\n)/;
undef
}
#** @param $_[0] a string
#** @return value if $_[0] represents a floating point or integer numeric
#** constant in the C language (without the LU etc. modifiers) -- or undef
sub c_numval($) {
my $S=$_[0];
no integer; # very important; has local scope
return 0+$S if $S=~/\A[+-]?(?:[0-9]*\.[0-9]+(?:[eE][+-]?[0-9]+)?|[0-9]+\.?)\Z(?!\n)/;
undef
}
#** @param $_[0] a string
#** @return the integer value of $_[0] in C -- or undef
sub c_intval($) {
my $S=$_[0];
my $neg=1;
$neg=-1 if $S=~s@\A([+-])@@ and '-'eq$1;
return $neg*hex $1 if $S=~/\A0[xX]([0-9a-fA-F]+)\Z(?!\n)/;
return $neg*oct $1 if $S=~/\A0([0-7]+)\Z(?!\n)/;
return $neg*$1 if $S=~/\A([0-9]+)\Z(?!\n)/;
undef
}
sub import {
no strict 'refs';
my $package = (caller())[0];
shift; # my package
for my $p (@_ ? @_ : qw{get_bits_msb c_floatval c_numval c_intval}) { *{$package."::$p"}=\&{$p} }
}
just::end}
BEGIN{$ INC{'Htex/dimen.pm'}='Htex/dimen.pm'} {
package Htex::dimen;
# by [email protected] at Sat Dec 21 21:26:15 CET 2002
use just;
use integer;
use strict;
use Pts::string qw(c_numval);
my %bp_mul;
{ no integer; %bp_mul=(
'bp'=>1, # 1 bp = 1 bp (big point)
'in'=>72, # 1 in = 72 bp (inch)
'pt'=>72/72.27, # 1 pt = 72/72.27 bp (point)
'pc'=>12*72/72.27, # 1 pc = 12*72/72.27 bp (pica)
'dd'=>1238/1157*72/72.27, # 1 dd = 1238/1157*72/72.27 bp (didot point) [about 1.06601110141206 bp]
'cc'=>12*1238/1157*72/72.27, # 1 cc = 12*1238/1157*72/72.27 bp (cicero)
'sp'=>72/72.27/65536, # 1 sp = 72/72.27/65536 bp (scaled point)
'cm'=>72/2.54, # 1 cm = 72/2.54 bp (centimeter)
'mm'=>7.2/2.54, # 1 mm = 7.2/2.54 bp (millimeter)
) }
#** @param $_[0] a (real or integer) number, optionally postfixed by a
#** TeX dimension specifier (default=bp)
#** @return the number in bp, or undef
sub dimen2bp($) {
no integer;
my $S=$_[0];
my $mul;
$mul=$bp_mul{$1} if $S=~s/\s*([a-z][a-z0-9]+)\Z(?!\n)// and exists $bp_mul{$1};
my $val=c_numval($S);
$val*=$mul if defined $val and defined $mul;
$val
}
just::end}
BEGIN{$ INC{'Htex/papers.pm'}='Htex/papers.pm'} {
package Htex::papers;
# contains paper size information
# by [email protected] at Sun Dec 22 00:30:58 CET 2002
use just;
use integer;
use strict;
use Htex::dimen;
my @papers=(
#
# paper.txt
# by [email protected] at Tue Jan 16 18:21:59 CET 2001
# by [email protected] at Tue Jan 16 19:13:16 CET 2001
#
# Examined: dvips, gs, libpaperg
#
# all units are measured in Big Points (bp)
# 72 bp == 1 in
# 2.54 cm == 1 in
#
# papername width height
qw{Comm10 297 684},
qw{Monarch 279 540},
qw{halfexecutive 378 522},
qw{Legal 612 1008},
qw{Statement 396 612},
qw{Tabloid 792 1224},
qw{Ledger 1224 792},
qw{Folio 612 936},
qw{Quarto 610 780},
qw{7x9 504 648},
qw{9x11 648 792},
qw{9x12 648 864},
qw{10x13 720 936},
qw{10x14 720 1008},
qw{Executive 540 720},
qw{ISOB0 2835 4008},
qw{ISOB1 2004 2835},
qw{ISOB2 1417 2004},
qw{ISOB3 1001 1417},
qw{ISOB4 709 1001},
qw{ISOB5 499 709},
qw{ISOB6 354 499},
qw{ISOB7 249 354},
qw{ISOB8 176 249},
qw{ISOB9 125 176},
qw{ISOB10 88 125},
qw{jisb0 2916 4128},
qw{jisb1 2064 2916},
qw{jisb2 1458 2064},
qw{jisb3 1032 1458},
qw{jisb4 729 1032},
qw{jisb5 516 729},
qw{jisb6 363 516},
qw{C7 230 323},
qw{DL 312 624},
qw{a3 842 1190}, # defined by Adobe
qw{a4 595 842}, # defined by Adobe; must precede a4small
# a4small should be a4 with an ImagingBBox of [25 25 570 817].},
qw{a4small 595 842},
qw{letter 612 792}, # must precede lettersmall
# lettersmall should be letter with an ImagingBBox of [25 25 587 767].
qw{lettersmall 612 792},
# note should be letter (or some other size) with the ImagingBBox
# shrunk by 25 units on all 4 sides.
qw{note 612 792},
qw{letterLand 792 612},
# End of Adobe-defined page sizes
qw{a0 2380 3368},
qw{a1 1684 2380},
qw{a2 1190 1684},
qw{a5 421 595},
qw{a6 297 421},
qw{a7 210 297},
qw{a8 148 210},
qw{a9 105 148},
qw{a10 74 105},
qw{b0 2836 4008},
qw{b1 2004 2836},
qw{b2 1418 2004},
qw{b3 1002 1418},
qw{b4 709 1002},
qw{b5 501 709}, # defined by Adobe
qw{a0Land 3368 2380},
qw{a1Land 2380 1684},
qw{a2Land 1684 1190},
qw{a3Land 1190 842},
qw{a4Land 842 595},
qw{a5Land 595 421},
qw{a6Land 421 297},
qw{a7Land 297 210},
qw{a8Land 210 148},
qw{a9Land 148 105},
qw{a10Land 105 74},
qw{b0Land 4008 2836},
qw{b1Land 2836 2004},
qw{b2Land 2004 1418},
qw{b3Land 1418 1002},
qw{b4Land 1002 709},
qw{b5Land 709 501},
qw{c0 2600 3677},
qw{c1 1837 2600},
qw{c2 1298 1837},
qw{c3 918 1298},
qw{c4 649 918},
qw{c5 459 649},
qw{c6 323 459},
# vvv U.S. CAD standard paper sizes
qw{archE 2592 3456},
qw{archD 1728 2592},
qw{archC 1296 1728},
qw{archB 864 1296},
qw{archA 648 864},
qw{flsa 612 936}, # U.S. foolscap
qw{flse 612 936}, # European foolscap
qw{halfletter 396 612},
qw{csheet 1224 1584}, # ANSI C 17x22
qw{dsheet 1584 2448}, # ANSI D 22x34
qw{esheet 2448 3168}, # ANSI E 34x44
qw{17x22 1224 1584}, # ANSI C 17x22
qw{22x34 1584 2448}, # ANSI D 22x34
qw{34x44 2448 3168}, # ANSI E 34x44
);
#** Converts a numeric paper size to a well-defined paper name. Tolerance is
#** 8.5bp
#** @param $_[0] width, in bp
#** @param $_[1] height, in bp
#** @return () or ("papername", ret.paper.width.bp, ret.paper.height.bp)
sub valid_bp($$;$$) {
no integer;
my ($W1,$H1)=(defined$_[2]?$_[2]:0,defined$_[3]?$_[3]:0);
my ($WW,$HH)=(Htex::dimen::dimen2bp($_[0])-$W1, Htex::dimen::dimen2bp($_[1])-$H1);
# Dat: 1mm == 720/254bp; 3mm =~ 8.5bp
no integer;
for (my $I=0; $I<@papers; $I+=3) {
return @papers[$I,$I+1,$I+2] if abs($papers[$I+1]-$WW)<=8.5 and abs($papers[$I+2]-$HH)<=8.5;
}
()
}
#** @param $_[0] (width width_unit "," height height_unit)
#** @return () or ("papername", width.bp, height.bp)
sub valid($) { # valid_papersize
my $S=lc$_[0];
$S=~/^\s*(\d+(\.\d+)?)\s*([a-z][a-z0-9]+)\s*,\s*(\d+(\.\d+)?)\s*([a-z][a-z0-9]+)\s*\Z(?!\n)/ ?
valid_bp("$1$3","$4$6") : ();
}
#** @param $_[0] (width width_unit? ("," || "x") height height_unit?) || (papername)
#** @return () or ("papername"?, width.bp, height.bp)
sub any($) {
my $S=lc$_[0];
if ($S=~/\A[a-z]\w+\Z(?!\n)/) {
for (my $I=0; $I<@papers; $I+=3) {
return @papers[$I,$I+1,$I+2] if lc($papers[$I]) eq $S;
}
}
return () if $S!~/^\s*(\d+(\.\d+)?)\s*((?:[a-z][a-z0-9]+)?)\s*[,xX]\s*(\d+(\.\d+)?)\s*((?:[a-z][a-z0-9]+)?)\s*\Z(?!\n)/;
# ^^^ Dat: [xX] is xdvi-style, [,] is dvips-style spec
my($w,$h)=($1.$3, $4.$6);
my @L=valid_bp($w,$h);
@L ? @L : (undef,Htex::dimen::dimen2bp($w),Htex::dimen::dimen2bp($h))
}
just::end}
BEGIN{$ INC{'Htex/a2ping.pm'}='Htex/a2ping.pm'}
package Htex::a2ping;
# a2ping.pl -- convert between PS, EPS and PDF and other page description formats
# by [email protected] et al. at Wed Apr 16 14:54:13 CEST 2003
# a2ping.pa created at Sun Apr 20 22:25:47 2003
#
# This file contains perldoc(1) documentation. Search for `=head1'.
# See revision history at end of this file.
#
use just +1; # a JustLib application
use strict;
use integer;
use Htex::papers;
BEGIN { $Htex::a2ping::VERSION="2.77p" }
# Imp: gs(704?!) sometimes finds too small bbox, see Univers.eps
# Imp: respect bbox in METAPOST %! (not EPS), don't use Compute-GS T-
# Imp: -sPDFPassword=...
# Imp: `a2ping.pl -v jf.eps pdf1: t.pdf' PDF1: must be forced to have --below
# Imp: option to `clip' an EPS to the specified bbox -- does file size decrease?
# Imp: fix bug a2ping -v ~/a2ping_bug.ps a2ping_bug.pdf; running type1fix on
# all fonts with dff.pl has fixed the problem
# Imp: post-process PNG etc. written by sam2p
# Imp: better help and docs
# Imp: respect full /MediaBox for a PDF -> EPS|PDF1 conversion
# Imp: --ll x,y command line option
# Imp: Htex/a2ping.pa -v ../image/tuzv.ps t.pdf (1st and second page different)
# Imp: also save+restore /pdfmark ??
# Imp: fix /MediaBox an all PDF pages if !$ll_zero
# Imp: PDF -> PDF1 conversion with gs -sDEVICE=pdfwrite
# Imp: direct PDF to PCL5 conversion with gs
# Imp: remove %%BeginDefaults | %%PageMedia: plain | %%EndDefaults (pdftops(1))
# Imp: fix completely bogus margin and papersize handling:
# ../justlib2/Htex/a2ping.pa --duplex=force-short -v -p:a3 -r force-unknown tuzv.ps t.pdf
# Imp: careful distinction between PDF and PDF1
# Imp: psnup support (-1 -2 -3 -4 ...)
# Imp: idempotent PS -> PS, add other header
# Imp: use convert(1) etc.
# Imp: possibly disable compute-pipe
# Imp: $header_remove_p ??
# Imp: --leftright option instead of --below
# Imp: pdfboxes.pl, get offset from gs
# Imp: detect error messages from GS, abort...
# Imp: use all pdftops + gs + acroread
# Imp: possibly accept /PageSize from %%DocumentMedia
# Imp: /DocumentMedia seems to screw up sub-pt placement in gv(1)
#
# Dat: example: a2ping.pl --extra=-c:ijg:50 -r86 nn1.eps nn1.jpg
# Dat: calling ``showpage'' is not required for -sDEVICE=pdfwrite with gs 6.50,
# but -sDEVICE=pgmraw depends on it
# Dat: the functionality of pdfboxes.pl cannot be provided here with a shorter
# implementation, because gs always outputs the content stream of the PDF
# objects first
# Dat: pdftops -eps writes negative bbox correctly
# Dat: markedEPS: include pdfmarks
# Dat: gs 7.04 gdevdjet.[ch], gdevdljm.[ch]
# Dat: to be undeffed in setpagedevice: /.MarginsHWResolution /PageSize
# /ImagingBBox /HWResolution /HWSize /.MediaSize (we undef all)
### program identification
my $program = "a2ping.pl";
my $filedate="2004-04-28"; # my $filedate="2001/03/05";
my $copyright = "Written by <pts\@fazekas.hu> from April 2003.
This is free software, GNU GPL >=2.0. There is NO WARRANTY.
(epstopdf 2.7 Copyright 1998-2001 by Sebastian Rahtz et al.)\n";
# "Contains modifications by pts\@fazekas.hu";
my $title = "$program $Htex::a2ping::VERSION, $filedate -- $copyright\n";
### ghostscript command name
my($quote,$GS)=("'","gs");
($quote,$GS) = ("\"","gswin32c") if $^O eq 'MSWin32' or $^O =~ /cygwin/i;
# --- help functions
sub fnq($) {
my $fn=$_[0];
return $fn if $fn!~y@-a-zA-Z0-9/.+_@@c;
$fn=~s@'@\\'@g if $quote eq "'";
$quote.$fn.$quote
}
sub debug {
print STDERR "* @_\n" if $::opt_verbose;
}
sub warning {
print STDERR "$0: warning: @_\n";
}
sub error {
my $s=$title; $title="";
die "$s$0: @_\n";
}
# unlink temporary files?
my $tmpunlink_p=1;
my $tmpsig=1;
my %tmpfiles;
my $tmpdir=exists $ENV{TMPDIR} ? $ENV{TMPDIR} : '/tmp';
$tmpdir="." if (!-d $tmpdir or !-w $tmpdir) and -w '.';
sub cleanup() {
unlink keys %tmpfiles;
exit 125;
}
END { unlink keys %tmpfiles; }
sub temp_unlink($) {
if (exists $tmpfiles{$_[0]}) {
unlink $_[0] if $tmpunlink_p;
delete $tmpfiles{$_[0]};
}
}
sub temp_prefix() {
my $prog0=$program;
$prog0=~y@a-zA-Z0-9@_@c;
if ($tmpsig) {
$tmpsig=0;
$SIG{INT}=$SIG{TERM}=$SIG{HUP}=$SIG{QUIT}=\&cleanup;
}
return "$tmpdir/$prog0-$$-".int(rand(1<<30))."-"; # 30: nonnegative
}
#** @return arg rounded down to int
sub floor($) {
# Dat: Perl int() rounds towards zero
no integer;
$_[0] < 0 ? -int(-$_[0]) : int($_[0])
}
#** @return arg rounded up to int
sub ceil($) {
no integer;
$_[0]==int($_[0]) ? $_[0] : 1+ ($_[0] < 0 ? -int(-$_[0]) : int($_[0]))
}
just::main;
# ---
sub FL_PAGE1_STOP(){1} # is file format single-page?
sub FL_SET_PAGESIZE_OK(){2}
sub FL_PDFMARK(){4}
sub FL_NEED_SHOWPAGE(){8} # does gs -sDEVICE=... need showpage?
sub FL_SAMPLED(){16} # is it a sampled (raster, pixel-based)
sub FL_ANY_ORIGIN_OK(){32} # (llx,lly) may be anything, not just (0,0)
sub FL_HAS_ANTIALIAS(){64}
sub FL_VIA_SAM2P(){128} # sam2p(1) can convert PNM to such a format
sub FL_OK_SAM2P(){256}
my %fmts=( # Name=>[flags]
'EPS'=>[FL_PAGE1_STOP],
'markedEPS'=>[FL_PAGE1_STOP|FL_PDFMARK], # Imp: should we have FL_SET_PAGESIZE_OK?
'PDF1'=>[FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_PDFMARK],
'PDF'=>[FL_SET_PAGESIZE_OK|FL_PDFMARK|FL_ANY_ORIGIN_OK],
'PS'=>[FL_SET_PAGESIZE_OK|FL_ANY_ORIGIN_OK],
'markedPS'=>[FL_SET_PAGESIZE_OK|FL_PDFMARK|FL_ANY_ORIGIN_OK],
'PCL5'=>[FL_SET_PAGESIZE_OK|FL_ANY_ORIGIN_OK],
# ^^^ Dat: no FL_HAS_ANTIALIAS -- would need lj5gray, which is loonger
# ^^^ Dat: no FL_SAMPLED, because cannot set resolution
'PBM'=> [FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_OK_SAM2P], # Dat FL_HAS_ANTIALIAS produces obscure image
'PGM'=> [FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_OK_SAM2P],
'PPM'=> [FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_OK_SAM2P],
# Now come the FileFormats supported via sam2p
'PNG'=> [FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_VIA_SAM2P],
'XWD'=> [FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_VIA_SAM2P],
'BMP'=> [FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_VIA_SAM2P],
'TIFF'=>[FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_VIA_SAM2P],
'JPEG'=>[FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_VIA_SAM2P],
'GIF'=> [FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_VIA_SAM2P], # Imp: disable antialias for few colors?
'XPM'=> [FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_VIA_SAM2P], # Imp: disable antialias for few colors?
);
my %fmt_aliases=qw(MARKEDPS markedPS MARKEDEPS markedEPS PCL PCL5
UNMARKEDPS PS UNMARKEDEPS EPS EPDF PDF1 MEPS markedEPS);
# Dat: .ps will be unmarked PS
# Imp: sometimes markedEPS for .eps?
my %fmt_exts=qw(eps EPS epsi EPS epsf EPS eps2 EPS ps PS ps2 PS
pcl PCL5 pcl5 PCL5 pbm PBM pgm PGM pnm PPM ppm PPM pdf PDF png PNG
xwd XWD bmp BMP rle BMP tif TIFF tiff TIFF jpg JPEG jpe JPEG
jpg JPEG gif GIF xpm XPM);
### usage
# vvv deprecated options:
# --outfile=<file>: write result to <file>
# --debug: verbose debug informations (default: $bool[$::opt_verbose])
# --(no)filter: d. read standard input (default: false)
# --(no)gs d. run Ghostscript to create PDF
my $usage=
"${title}Usage: $program [options] <inputfile> [[<outformat>:] <outputfile>]
Run with --doc to read documentation as a UNIX man(1) page.
Options: --help print this help message
--(no)compress use compression (def: best)
--(no)hires scan HiResBoundingBox (def: yes)
--(no)exact scan ExactBoundingBox (def: no)
--(no)verbose verbose debug informations (def: no)
--(no)below allow below+left_from baseline (def: no)
--(no)tmpunlink unlink temporary files (def: yes)
--(no)antialias render shades at outlines (def: scale3no) (=scale3yes =no =yes)
--gs-cmd= path to Ghostscript (def: gs or gswin32c)
--gs-ccmd= path to Ghostscript, 4 bbox calc (def: gs or gswin32c)
--gsextra= extra arg to gs
--extra= extra arg to external prg (i.e pdftops)
--bboxfrom= adsc|compute-gs|pagesize (def: guess)
--papersize= unchanged|force-unknown|600bpx5cm (def: default) (bp)
--threshold= min color for 1 in 8->1 bit conv (def: 128)
Possible input formats: PS EPS PDF JPEG GIF TIFF PNG PNM PCX BMP LBM XPM TGA
Possible output formats: @{[sort keys %fmts]}
Examples for producing 'test.pdf':
* $program test.eps
* produce postscript | $program -v - test.pdf
Example: look for HiResBoundingBox and produce corrected PostScript:
* $program -d --nogs -hires test.ps>testcorr.ps
";
sub errorUsage {
die "$usage\U!\E!\U!\E Error: @_\n";
}
# --- @ARGV parsing
### default option values
my @extra=();
my @gsextra=();
#** Output file format (string)
my $FileFormat=undef;
$::opt_help=0;
$::opt_verbose=0;
my %vals_compression=map{$_=>1} qw(best none flate zip);
$::opt_compression='best';
#** Prefer %%HiResBoundingBox over %%BoundingBox, but emit both
$::opt_hires=1;
$::opt_exact=0;
# $::opt_filter=0; # deprecated
# $::opt_outputfile=undef; # deprecated
$::opt_below=undef;
$::opt_antialias=undef; # render shades at path outlines for better readability
$::opt_gs_cmd=undef;
$::opt_extra="";
$::opt_duplex="default";
$::opt_threshold=128;
my %vals_antialias=map{$_=>1} qw(no yes scale3yes scale3no);
my %vals_duplex=map{$_=>1} qw(force-unknown force-simplex force-long
force-short unchanged default-simplex default-long default-short);
# ^^^ short: duplex printing, will bind short edge of paper (ideal for
# duplexing psnup -2)
#** Dat: force-unknown is forced by /setpagedevice/load def
$::opt_resolution="default"; # unchanged force-unknown 600x600 (DPI)
$::opt_papersize="default"; # unchanged force-unknown 600bpx600cm (bp)
#** --bboxfrom=adsc sets %%BoundingBox from the 1st page if no ADSC comment in non-EPS ps
my %vals_bboxfrom=map{$_=>1} qw(adsc compute-gs guess pagesize);
$::opt_bboxfrom="guess";
my $InputFilename;
my $OutputFilename;
sub is_page1_stop() { 0!=($fmts{$FileFormat}[0]&FL_PAGE1_STOP) }
sub is_set_pagesize_ok() { 0!=($fmts{$FileFormat}[0]&FL_SET_PAGESIZE_OK) }
sub is_pdfmark() { 0!=($fmts{$FileFormat}[0]&FL_PDFMARK) }
sub is_need_showpage() { 0!=($fmts{$FileFormat}[0]&FL_NEED_SHOWPAGE) }
sub is_sampled() { 0!=($fmts{$FileFormat}[0]&FL_SAMPLED) }
sub is_any_origin_ok() { 0!=($fmts{$FileFormat}[0]&FL_ANY_ORIGIN_OK) }
sub is_has_antialias() { 0!=($fmts{$FileFormat}[0]&FL_HAS_ANTIALIAS) }
sub is_via_sam2p() { 0!=($fmts{$FileFormat}[0]&FL_VIA_SAM2P) }
sub is_ok_sam2p() { 0!=($fmts{$FileFormat}[0]&FL_OK_SAM2P) }
# ---
sub show_doc() {
# run `pod2man __FILE__ | man -l -', same as `perldoc __FILE', but perldoc(1)
# is missing from some Debian sites that have pod2man.
my @path=split/:+/,$ENV{PATH};
my $pod2man_='pod2man --center="a2ping: advanced PS, PDF, EPS converter" ';
$pod2man_=q~perl -ne 'if($a>1){print}elsif($a&&/^=head1/){$a=2}else{$a=!/\S/}' ~
if !grep { -x "$_/pod2man" } @path;
my $pager='';
for my $pageri ((defined $ENV{PAGER} ? $ENV{PAGER}: ''),'less','most','more','view - ','vim -R - ','vi - ','joe -rdonly -asis -','pager') {
next if $pageri!~/^(\S+)/;
my $pagert="/$1";
if (grep { -x $_.$pagert } @path) { $pager=$pageri; last }
}
$pager=q~perl -pe 's@\010_@@g;s@.\010@@gs' | ~.$pager
if substr($pager,-2)eq' ' or $pager=~/\A(?:view|vim?|joe|emacs|mcedit|nano|nano-tiny|ae)\b/;
# ^^^ Dat: these cannot handle underline/bold backspace directly
$ENV{PAGER}=$pager;
my $man='';
if (substr($pod2man_,0,5)ne 'perl ') {
$man=' | man -l -'; # calls $PAGER
if ((!grep { -x "$_/man" } @path) or qx(man -l 2>&1)=~/\binvalid option\b/) {
$man=' | nroff -Tlatin1 -mandoc'; # Linux, no need for eqn(1), tbl(1) etc.
if (!grep { -x "$_/nroff" } @path) { $man='' } # just write it
}
}
my $cmd=$pod2man_.fnq(__FILE__).$man;
if ($cmd!~/[|] man -l -\Z(?!\n)/) {
if (!length $pager) {
die unless open PIPE, "$cmd|";
print while sysread PIPE, $_, 4096;
die "$0: error showing doc\n" unless close PIPE;
exit 0;
}
$cmd.=' | $PAGER';
}
##die $cmd;
$ENV{LESS}="" if !defined $ENV{LESS};
$ENV{LESS}="$ENV{LESS}R"; # show ANSI escapes
die "$0: exec ($cmd) failed: $!\n" if !exec $cmd;
}
die $usage if !@ARGV or (1==@ARGV and $ARGV[0] eq '-h' or $ARGV[0] eq '--help'
or $ARGV[0] eq 'help');
show_doc() if 1==@ARGV and $ARGV[0] eq '--doc' or $ARGV[0] eq 'doc';
{ my($I,$optname,$optval);
my %optmap=qw(o outputfile outfile outputfile r resolution h help
f filter d verbose v verbose debug verbose p papersize
c compression compress compression h hires b below e exact x extra);
#** Options that have a mandatory argument
my %argopt1=qw(outputfile 1 duplex 1 resolution 1 extra 1 compression 1 gs-cmd 1
gs-ccmd 1
papersize 1 paper 1 bboxfrom 1 antialias 1 gsextra 1 threshold 1); # 1 arg
my %argnone=qw(help 1 verbose 1 noverbose 1 nocompress 1 noantialias 1); # 0 arg
my %argmaybe=qw(); # 0 or 1 arg
my %argbool=qw(hires 1 exact 1 below 1 gs 1 filter 1 tmpunlink 1
approx 1); # boolean arg
# Dat: --noverbose --nocompress
my $opts_ok=1;
for ($I=0; $I<@ARGV; $I++) {
if ($ARGV[$I]eq '--') {
$OutputFilename=$InputFilename if defined $InputFilename and
!defined $OutputFilename and $opts_ok;
$opts_ok=0;
} elsif ($opts_ok and $ARGV[$I]=~/\A--+(\w[\w-]*)(?:[:=](.*))?\Z(?!\n)/s) {
$optname=lc$1; $optval=$2;
} elsif ($opts_ok and $ARGV[$I]=~/\A-(\w)(.*)\Z(?!\n)/s) {
$optname=lc$1;
if (length($2)==0) { $optval=undef }
elsif (index(":=",substr($2,0,1))>=0) { $optval=substr($2,1) }
else { $optval=$2 }
} elsif ($opts_ok and !defined $FileFormat and defined $InputFilename and $ARGV[$I]=~s@\A(\w+):@@) {
my $fmtag=uc$1;
# errorUsage "invalid FileFormat tag: $fmtag" if $fmtag!~s@:\Z(?!\n)@@;
if (exists $fmts{$fmtag}) { $FileFormat=$fmtag }
elsif (exists $fmt_aliases{$fmtag}) { $FileFormat=$fmt_aliases{$fmtag} }
else { errorUsage "Unknown FileFormat tag: $fmtag" }
if (0!=length($ARGV[$I])) {
errorUsage "Multiple output filenames" if defined $OutputFilename;
$OutputFilename=$ARGV[$I];
}
next
} elsif (!defined $InputFilename) { $InputFilename=$ARGV[$I]; next }
elsif (!defined $OutputFilename) { $OutputFilename=$ARGV[$I]; next }
else { errorUsage "Too many arguments (multiple input/output files?)" }
$optname=$optmap{$optname} if exists $optmap{$optname};
if (exists $argopt1{$optname} and !defined $optval) {
errorUsage "Argument expected for --$optname" if $I==@ARGV;
$optval=$ARGV[++$I];
}
# Dat: $optname and $optval are now correct
errorUsage "No argument expected for --$optname=$optval" if exists $argnone{$optname} and defined $optval;
if (substr($optname,0,2)eq"no" and exists $argbool{substr($optname,2)}) {
$optname=substr($optname,2);
errorUsage "No argument expected for no --no$optname=$optval" if defined $optval;
$optval="no";
}
if (exists $argbool{$optname}) {
# same as sam2p GenBuffer::parseBool, understands:
# on true yes ja igen oui enable 1 true vrai? right sure allowed
# off false no nein nem non disable 0 false faux? wrong nope disallowed
$optval=(!defined($optval) or 0==length($optval)
or $optval=~/\Ao[nu]/i or $optval!~/\A[fndw0]/i) ? 1 : 0;
} elsif (!exists $argopt1{$optname} and !exists $argnone{$optname} and !exists $argmaybe{$optname}) {
errorUsage "Unknown option --$optname, see --help"
}
# vvv application-specific
if ($optname eq "help") { die $usage }
elsif ($optname eq "help") { show_doc() }
elsif ($optname eq "noverbose") { $::opt_verbose=0 }
elsif ($optname eq "nocompress") { $::opt_compression='none' }
elsif ($optname eq "verbose") { $::opt_verbose++ }
elsif ($optname eq "hires") { $::opt_hires =$optval }
elsif ($optname eq "exact") { $::opt_exact =$optval }
elsif ($optname eq "below") { $::opt_below =$optval }
elsif ($optname eq "approx") { $::opt_approx=$optval }
elsif ($optname eq "threshold") { $::opt_threshold=$optval+0 } # Imp: accept only int 0..256
elsif ($optname eq "filter") {
# errorUsage "Multiple input filenames" if defined $InputFilename;
# $InputFilename='-';
errorUsage "Multiple output filenames" if defined $OutputFilename;
$OutputFilename='-';
} elsif ($optname eq "tmpunlink") { $tmpunlink_p=$optval }
elsif ($optname eq "gs") { $FileFormat=$optval ? 'PDF1' : 'markedEPS' }
elsif ($optname eq "compression") {
errorUsage "--$optname expects one of: @{[keys%vals_compression]}" if !exists $vals_compression{$optval};
$::opt_compression=$optval;
$::opt_compression='zip' if $::opt_compression eq 'flate';
} elsif ($optname eq "outputfile") {
errorUsage "Multiple output filenames" if defined $OutputFilename;
$OutputFilename=$optval;
} elsif ($optname eq "gs-cmd") {
errorUsage "Multiple --gs-cmd" if defined $::opt_gs_cmd;
$::opt_gs_cmd=$optval;
} elsif ($optname eq "gs-ccmd") {
errorUsage "Multiple --gs-ccmd" if defined $::opt_gs_ccmd;
$::opt_gs_ccmd=$optval;
} elsif ($optname eq "extra") { push @extra, $optval }
elsif ($optname eq "gsextra") { push @gsextra, $optval }
elsif ($optname eq "duplex") {
errorUsage "--$optname expects one of: @{[keys%vals_duplex]}" if !exists $vals_duplex{$optval};
$::opt_duplex=$optval
} elsif ($optname eq "bboxfrom") {
errorUsage "--$optname expects one of: @{[keys%vals_bboxfrom]}" if !exists $vals_bboxfrom{$optval};
$::opt_bboxfrom=$optval
} elsif ($optname eq "noantialias") {
$::opt_antialias='no'
} elsif ($optname eq "antialias") {
errorUsage "--$optname expects one of: @{[keys%vals_antialias]}" if !exists $vals_antialias{$optval};
$::opt_antialias=$optval
} elsif ($optname eq "resolution") {
if ($optval eq "unchanged" or $optval eq "force-unknown") { }
elsif ($optval=~/^(\d+(?:[.]\d+)?)\Z(?!\n)/) { $optval="$1x$1" }
elsif ($optval=~/^(\d+(?:[.]\d+)?[x,]\d+(?:[.]\d+)?)\Z(?!\n)/) { }
else { errorUsage "--Resultion expects unchanged | force-unknown | DPI | XDPIxYDPI" }
$::opt_resolution=$optval
} elsif ($optname eq "papersize" or $optname eq"paper") {
if ($optval eq "unchanged" or $optval eq "force-unknown") { $::opt_papersize=$optval }
else {
my @L=Htex::papers::any($optval);
errorUsage "invalid or unknown for --papersize" if !@L;
$::opt_papersize="$L[1],$L[2]" # width, height
}
} else { die } # unreachable
} # NEXT opt
errorUsage "Too many arguments (multiple input/output files?)" if $I!=@ARGV;
# splice @ARGV, 0, $I;
}
$GS=$::opt_gs_cmd if defined $::opt_gs_cmd;
my $CGS=$GS;
$CGS=$::opt_gs_ccmd if defined $::opt_gs_ccmd;
$GS.= " -dSAFER"; # -dWRITESYSTEMDICT
$CGS.=" -dSAFER"; # -dWRITESYSTEMDICT
### get input and output filename
if (!defined $InputFilename and defined $OutputFilename) { # --filter
$InputFilename='-';
} elsif (!defined $InputFilename) {
errorUsage "Input filename missing"
} elsif (!defined $OutputFilename) {
$FileFormat='PDF1' if !defined $FileFormat;
if ($FileFormat eq 'PDF1' or $FileFormat eq 'PDF') {
if (($OutputFilename=$InputFilename) ne '-') {
$OutputFilename =~ s/\.[^\.]*$//;
$OutputFilename .= ".pdf";
}
} else {
$OutputFilename = '-'; # standard output
}
}
print STDERR $title if $::opt_verbose;
$title="";
# Dat: no more @ARGV
errorUsage "please specify <outformat>" if
!defined $FileFormat and ($OutputFilename!~m@[.]([^/.]+)\Z(?!\n)@ or
!defined($FileFormat=$fmt_exts{lc$1}));
$::opt_below=is_any_origin_ok() if !defined $::opt_below;
error "--below=1 invalid for FileFormat $FileFormat" if $::opt_below and
!is_any_origin_ok() and $FileFormat ne 'PDF1' and $FileFormat ne 'EPS' and
$FileFormat ne 'markedEPS';
error "--below=0 invalid for FileFormat $FileFormat" if !$::opt_below and
is_any_origin_ok();
$::opt_antialias=is_has_antialias() ?
(is_sampled() ? 'scale3no' : 'yes') : 'no' if
!defined $::opt_antialias;
if ($FileFormat eq 'PBM' and ($::opt_antialias eq 'scale3yes' or
$::opt_antialias eq 'scale3no')) {
} elsif ($::opt_antialias ne 'no' and !is_has_antialias()) {
$::opt_antialias='no';
warning "--AntiAlias ignored for FileFormat $FileFormat"
}
if ($::opt_antialias eq 'scale3no' or $::opt_antialias eq 'scale3yes') {
$::opt_resolution="72,72" if $::opt_resolution eq 'unchanged' or $::opt_resolution eq 'force-unknown' or $::opt_resolution eq 'default';
# ^^^ GS raster default
my @L=split/[,x]/,$::opt_resolution;
@L=(@L,@L); # Imp: ..
$L[0]*=3; $L[1]*=3;
$::opt_resolution="$L[0],$L[0]";
}
### option compress
my $GSOPTS=join(" ",map{fnq$_}@gsextra);
# $GSOPTS.=" -r72 -sPAPERSIZE=a4 "; # default -- will be overridden by `setpagedevice'
# ^^^ Dat: default does only harm; user should specify on command line
### option BoundingBox types
#**** pts ****
# scan all of them and find the best
{ my $BBprint = "%%BoundingBox:";
$BBprint = "%%HiResBoundingBox:" if $::opt_hires;
$BBprint = "%%ExactBoundingBox:" if $::opt_exact;
debug "Strongest BoundingBox comment:", $BBprint;
}
my $BBregex='%%(Hi[Rr]es|Exact|)BoundingBox:';
if (!is_set_pagesize_ok()) {
if ($::opt_papersize ne'default' and $::opt_papersize ne'force-unknown') {
error "Cannot set --PaperSize for FileFormat $FileFormat"
} else { $::opt_papersize='force-unknown' }
} elsif ($::opt_papersize eq'default') { $::opt_papersize='unchanged' }
if ($::opt_resolution eq'default') { $::opt_resolution='force-unknown' }
error "Cannot set --Resolution for FileFormat $FileFormat (must be markedPS or sampled)"
if $FileFormat ne 'markedPS' and !is_sampled()
and $::opt_resolution ne'force-unknown';
error "Bad --Resolution=$::opt_resolution" if $::opt_resolution ne 'unchanged'
and $::opt_resolution ne 'force-unknown' and $::opt_resolution!~/\A(\d+)+[,x](\d+)\Z(?!\n)/;
if ($FileFormat ne 'markedPS' and $FileFormat ne 'PCL5') {
if ($::opt_duplex ne'default' and $::opt_duplex ne'force-unknown') {
error "Cannot set --Duplex for FileFormat $FileFormat (must be markedPS or PCL5)"
} else { $::opt_duplex='force-unknown' }
} elsif ($::opt_duplex eq'default') { $::opt_duplex='force-unknown' }
debug "Doing --PaperSize $::opt_papersize" if $::opt_papersize ne 'force-unknown';
debug "Doing --Duplex $::opt_duplex" if $::opt_duplex ne 'force-unknown';
debug "Doing --Resolution $::opt_resolution" if $::opt_resolution ne 'force-unknown';
debug "Doing --AntiAlias=$::opt_antialias" if $::opt_antialias ne 'no';
### option outfile
if ($OutputFilename eq '-') {
debug "Output file: standard output";
} else {
debug "Output filename: $OutputFilename";
#error "$OutputFilename: won't overwrite input file with itself"
# if $OutputFilename eq $InputFilename;
}
### option gs
debug "Output FileFormat: $FileFormat";
$::opt_compression='zip' if $::opt_compression ne 'none';
if ($FileFormat eq 'PDF' or $FileFormat eq 'PDF1') {
debug "Ghostscript ps2pdf command: $GS $GSOPTS";
debug "Compression: $::opt_compression";
} elsif ($FileFormat eq 'PCL5') {
debug "Ghostscript ps2ljet command: $GS $GSOPTS";
} elsif (is_sampled()) {
debug "Ghostscript ps2sampled command: $GS $GSOPTS";
}
#**** pts ****
sub read_error() { error "read $InputFilename: $!" }
my $bytes_left=-1; # -1==unlimited
my $already_read=0;
sub dem1($){defined$_[0]?$_[0]:-1}
#** @param $_[0] number of bytes to read, or undef to read a line
#** @return the string read
sub readIN(;$) {
my $S;
## return "" if $bytes_left==0;
## print STDERR "READ($_[0])\n";
if (defined $_[0]) { read_error if 0>dem1 read IN, $S, $_[0] }
else {
$!=0; # clean up error code
$S=<IN>;
read_error if !defined($S) and $!;
$S="" if !defined $S; # EOF
}
if ($bytes_left<0) { # unlimited
} elsif (length($S)>=$bytes_left) {
$S=substr($S, 0, $bytes_left);
$bytes_left=0;
} else { $bytes_left-=length($S) }
$already_read+=length($S);
$S
}
sub open_OUT() {
error "Cannot write outfile '$OutputFilename'" unless
open(OUT, $OutputFilename eq '-' ? ">-" : "> $OutputFilename")
}
#** @param $_[0] temp file extension (e.g ".img")
#** @param $_[1] preprint
#** @param $_[2] bool: force pipe even if seekable?
sub fix_pipe_in($$$) {
my $c="";
if ($_[2] or (length($c=readIN(1))!=0 and !seek IN,-1,1)) { # we cannot seek back
# Dat: ^^^ test seekability instead of $InputFilename eq '-'
my($ext,$preprint)=@_;
my $tifn;
# $ext=$1 if $InputFilename=~/[.](\w+)\Z(?!\n)/; # never true
$tifn=temp_prefix()."M$ext";
error "Cannot open temp input: $tifn" unless open TI, "> $tifn";
$tmpfiles{$tifn}=1;
die unless print TI $preprint, $c;
print TI or die while length($_=readIN 4096);
die unless close TI;
$InputFilename=$tifn;
debug "Temp input file: $InputFilename";
die unless open IN, "< $tifn";
die unless seek IN, length($preprint), 0;
$already_read=length($preprint);
$bytes_left=-1; # unlimited, since readIN() has copied only part
# $bytes_left++ if $bytes_left>=0; # ungetc($c)
# temp_unlink $tifn; # do it later (at END{})
} else {
$already_read--; $bytes_left++ if $bytes_left>=0; # BUGFIX at Fri May 14 00:21:18 CEST 2004
}
}
my $temp_out_fn;
#** Does overwrite $temp_out_fn. Fine.
sub fix_force_out($) {
my($ext)=$_[0];
# $ext=$1 if $InputFilename=~/[.](\w+)\Z(?!\n)/; # never true
$temp_out_fn=temp_prefix()."O$ext";
# error "Cannot save output: $!" unless open SAVEOUT, ">&OUT"; # always STDOUT; maybe not open yet
error "Cannot open temp output: $temp_out_fn" unless open OUT, "> $temp_out_fn";
$tmpfiles{$temp_out_fn}=1;
# $OutputFilename=$temp_out_fn;
debug "Temp output file: $temp_out_fn";
# temp_unlink $temp_out_fn; # do it later (at END{})
return $temp_out_fn;
}
#** @param $_[0] temp file extension (e.g ".img")
#** @return new output filename
sub fix_pipe_out($) {
if (!defined $temp_out_fn) {
return $OutputFilename if $OutputFilename ne '-';
return fix_force_out($_[0]);
}
$temp_out_fn
}
sub fix_close_out() {
# error "closing filter out: $? $!" unless close OUT;
if (defined $temp_out_fn) {
my $buf;
die unless open FCO, "< $temp_out_fn";
print STDOUT $buf while sysread FCO, $buf, 4096;
die unless close FCO;
temp_unlink $temp_out_fn;
undef $temp_out_fn;
}
}
sub do_system {
my($progname)=splice@_,0,1;
debug "Running: $progname @extra @_";
error "prog $progname failed: $? $!"
if 0!=system $progname, @extra, @_; # Dat: non-zero exit() or not found
}
sub do_exec {
my($progname)=splice@_,0,1;
if (scalar keys %tmpfiles) {
# Cannot exec() right now, because we have to unlink some temporary files
# later.
do_system $progname, @_;
} else {
debug "Execing: $progname @extra @_";
1 if exec $progname, @extra, @_;
# ^^^ Dat: $OutputFilename eq '-' should be OK
error "exec failed: $!";
}
exit(0);
}
#sub shq($) {
# my $S=$_[0];
# return $S if $S!~y@A-Za-z0-9_,:./-@@c and length($S)>0;
# $S=~s@'@'\\''@g;
# return "'$S'"
#}
### open input file
if ($InputFilename eq '-') {
debug "Input file: standard input";
open(IN, "<&STDIN") or error "cannot open standard input";
} else {
# -f $InputFilename or error "input file missing: $InputFilename"; # Imp: named pipe?
open(IN,"< $InputFilename") or error "cannot open input file: $InputFilename";
debug "Input filename:", $InputFilename;
if ($InputFilename eq $OutputFilename) {
# error "same input and output file: $InputFilename";