line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package PDF::Cropmarks; |
2
|
|
|
|
|
|
|
|
3
|
4
|
|
|
4
|
|
376749
|
use utf8; |
|
4
|
|
|
|
|
20
|
|
|
4
|
|
|
|
|
21
|
|
4
|
4
|
|
|
4
|
|
101
|
use strict; |
|
4
|
|
|
|
|
13
|
|
|
4
|
|
|
|
|
75
|
|
5
|
4
|
|
|
4
|
|
13
|
use warnings; |
|
4
|
|
|
|
|
9
|
|
|
4
|
|
|
|
|
90
|
|
6
|
|
|
|
|
|
|
|
7
|
4
|
|
|
4
|
|
1993
|
use Moo; |
|
4
|
|
|
|
|
42724
|
|
|
4
|
|
|
|
|
18
|
|
8
|
4
|
|
|
4
|
|
6853
|
use Types::Standard qw/Maybe Str Object Bool StrictNum Int HashRef ArrayRef/; |
|
4
|
|
|
|
|
191655
|
|
|
4
|
|
|
|
|
39
|
|
9
|
4
|
|
|
4
|
|
5923
|
use File::Copy; |
|
4
|
|
|
|
|
6667
|
|
|
4
|
|
|
|
|
215
|
|
10
|
4
|
|
|
4
|
|
17
|
use File::Spec; |
|
4
|
|
|
|
|
5
|
|
|
4
|
|
|
|
|
55
|
|
11
|
4
|
|
|
4
|
|
1932
|
use File::Temp; |
|
4
|
|
|
|
|
31087
|
|
|
4
|
|
|
|
|
241
|
|
12
|
4
|
|
|
4
|
|
1200
|
use PDF::API2; |
|
4
|
|
|
|
|
318667
|
|
|
4
|
|
|
|
|
101
|
|
13
|
4
|
|
|
4
|
|
52
|
use PDF::API2::Util; |
|
4
|
|
|
|
|
2
|
|
|
4
|
|
|
|
|
460
|
|
14
|
4
|
|
|
4
|
|
17
|
use POSIX qw(); |
|
4
|
|
|
|
|
4
|
|
|
4
|
|
|
|
|
57
|
|
15
|
4
|
|
|
4
|
|
12
|
use File::Basename qw/fileparse/; |
|
4
|
|
|
|
|
4
|
|
|
4
|
|
|
|
|
229
|
|
16
|
4
|
|
|
4
|
|
1849
|
use namespace::clean; |
|
4
|
|
|
|
|
32277
|
|
|
4
|
|
|
|
|
15
|
|
17
|
4
|
|
|
4
|
|
3301
|
use Data::Dumper; |
|
4
|
|
|
|
|
13175
|
|
|
4
|
|
|
|
|
255
|
|
18
|
|
|
|
|
|
|
use constant { |
19
|
|
|
|
|
|
|
DEBUG => !!$ENV{AMW_DEBUG}, |
20
|
4
|
|
|
4
|
|
21
|
}; |
|
4
|
|
|
|
|
5
|
|
|
4
|
|
|
|
|
10286
|
|
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
=encoding utf8 |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
=head1 NAME |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
PDF::Cropmarks - Add cropmarks to existing PDFs |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
=head1 VERSION |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
Version 0.09 |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
=cut |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
our $VERSION = '0.09'; |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
=head1 SYNOPSIS |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
This module prepares PDF for printing adding the cropmarks, usually on |
39
|
|
|
|
|
|
|
a larger physical page, doing the same thing the LaTeX package "crop" |
40
|
|
|
|
|
|
|
does. It also takes care of the paper thickness, shifting the logical |
41
|
|
|
|
|
|
|
pages to compensate the folding. |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
It comes with a ready-made script, C. E.g. |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
$ pdf-cropmarks.pl --help # usage |
46
|
|
|
|
|
|
|
$ pdf-cropmarks.pl --paper a3 input.pdf output.pdf |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
To use the module in your code: |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
use strict; |
51
|
|
|
|
|
|
|
use warnings; |
52
|
|
|
|
|
|
|
use PDF::Cropmarks; |
53
|
|
|
|
|
|
|
PDF::Cropmarks->new(input => $input, |
54
|
|
|
|
|
|
|
output => $output, |
55
|
|
|
|
|
|
|
paper => $paper, |
56
|
|
|
|
|
|
|
# other options here |
57
|
|
|
|
|
|
|
)->add_cropmarks; |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
If everything went well (no exceptions thrown), you will find the new |
60
|
|
|
|
|
|
|
pdf in the output you provided. |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
=head1 ACCESSORS |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
The following options need to be passed to the constructor and are |
65
|
|
|
|
|
|
|
read-only. |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
=head2 input |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
The filename of the input. Required. |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
=head2 output |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
The filename of the output. Required. |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
=head2 paper |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
This module each logical page of the original PDF into a larger |
78
|
|
|
|
|
|
|
physical page, adding the cropmarks in the margins. With this option |
79
|
|
|
|
|
|
|
you can control the dimension of the output paper. |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
You can specify the dimension providing a (case insensitive) string |
82
|
|
|
|
|
|
|
with the paper name (2a, 2b, 36x36, 4a, 4b, a0, a1, a2, a3, a4, a5, |
83
|
|
|
|
|
|
|
a6, b0, b1, b2, b3, b4, b5, b6, broadsheet, executive, ledger, legal, |
84
|
|
|
|
|
|
|
letter, tabloid) or a string with width and height separated by a |
85
|
|
|
|
|
|
|
column, like C<11cm:200mm>. Supported units are mm, in, pt and cm. |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
An exception is thrown if the module is not able to parse the input |
88
|
|
|
|
|
|
|
provided. |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
=head2 Positioning |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
The following options control where the logical page is put on the |
93
|
|
|
|
|
|
|
physical one. They all default to true, meaning that the logical page |
94
|
|
|
|
|
|
|
is centered. Setting top and bottom to false, or inner and outer to |
95
|
|
|
|
|
|
|
false makes no sense (you achieve the same result specifing a paper |
96
|
|
|
|
|
|
|
with the same width or height) and thus ignored, resulting in a |
97
|
|
|
|
|
|
|
centering. |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=over 4 |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
=item top |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
=item bottom |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
=item inner |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
=item outer |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=back |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
=head2 twoside |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
Boolean, defaults to true. |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
This option affects the positioning, if inner or outer are set to |
116
|
|
|
|
|
|
|
false. If C is true (default), inner margins are considered |
117
|
|
|
|
|
|
|
the left ones on an the recto pages (the odd-numbered ones). If set to |
118
|
|
|
|
|
|
|
false, the left margin is always considered the inner one. |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
=head2 cropmark_length |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
Default: 12mm |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
The length of the cropmark line. |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
=head2 cropmark_offset |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
Default: 3mm |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
The distance from the logical page corner and the cropmark line. |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
=head2 font_size |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
Default: 8pt |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
The font size of the headers and footers with the job name, date, and |
137
|
|
|
|
|
|
|
page numbers. |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
=head2 signature |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
Default to 0, meaning that no signature is needed. If set to 1, means |
142
|
|
|
|
|
|
|
that all the pages should fit in a single signature, otherwise it |
143
|
|
|
|
|
|
|
should be a multiple of 4. |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
=head2 paper_thickness |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
When passing the signature option, the logical pages are shifted on |
148
|
|
|
|
|
|
|
the x axys by this amount to compensate the paper folding. Accept a |
149
|
|
|
|
|
|
|
measure. |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
This option is active only when the signature is set (default to |
152
|
|
|
|
|
|
|
false) and twoside is true (the default). Default to 0.1mm, which is |
153
|
|
|
|
|
|
|
appropriate for the common paper 80g/m2. You can do the math measuring |
154
|
|
|
|
|
|
|
a stack height and dividing by the number of sheets. |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
=head2 title |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
The (optional) job title to put on the markers. It defaults to the |
159
|
|
|
|
|
|
|
file basename. |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
=head2 cover |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
Relevant if signature is passed. Usually the last signature is filled |
164
|
|
|
|
|
|
|
with blank pages until it's full. With this option turned on, the last |
165
|
|
|
|
|
|
|
page of the document is moved to the end of the stack. If you have 13 |
166
|
|
|
|
|
|
|
pages, and a signature of 4, you will end up with 16 pages with |
167
|
|
|
|
|
|
|
cropmarks, and the last three empty. With this option you will have |
168
|
|
|
|
|
|
|
page 16 with the logical page 13 on it, while the pages 13-14-15 will |
169
|
|
|
|
|
|
|
be empty (but with cropmarks nevertheless). |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
=cut |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
has cropmark_length => (is => 'ro', isa => Str, default => sub { '12mm' }); |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
has cropmark_offset => (is => 'ro', isa => Str, default => sub { '3mm' }); |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
has font_size => (is => 'ro', isa => Str, default => sub { '8pt' }); |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
has cropmark_length_in_pt => (is => 'lazy', isa => StrictNum); |
180
|
|
|
|
|
|
|
has cropmark_offset_in_pt => (is => 'lazy', isa => StrictNum); |
181
|
|
|
|
|
|
|
has font_size_in_pt => (is => 'lazy', isa => StrictNum); |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
has signature => (is => 'rwp', isa => Int, default => sub { 0 }); |
184
|
|
|
|
|
|
|
has paper_thickness => (is => 'ro', isa => Str, default => sub { '0.1mm' }); |
185
|
|
|
|
|
|
|
has paper_thickness_in_pt => (is => 'lazy', isa => StrictNum); |
186
|
|
|
|
|
|
|
has cover => (is => 'ro', isa => Bool, default => sub { 0 }); |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
sub _build_paper_thickness_in_pt { |
189
|
10
|
|
|
10
|
|
1836
|
my $self = shift; |
190
|
10
|
|
|
|
|
87
|
return $self->_string_to_pt($self->paper_thickness); |
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
sub _build_cropmark_length_in_pt { |
194
|
10
|
|
|
10
|
|
2150
|
my $self = shift; |
195
|
10
|
|
|
|
|
65
|
return $self->_string_to_pt($self->cropmark_length); |
196
|
|
|
|
|
|
|
} |
197
|
|
|
|
|
|
|
sub _build_cropmark_offset_in_pt { |
198
|
10
|
|
|
10
|
|
1644
|
my $self = shift; |
199
|
10
|
|
|
|
|
38
|
return $self->_string_to_pt($self->cropmark_offset); |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
sub _build_font_size_in_pt { |
203
|
10
|
|
|
10
|
|
175545
|
my $self = shift; |
204
|
10
|
|
|
|
|
67
|
return $self->_string_to_pt($self->font_size); |
205
|
|
|
|
|
|
|
} |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
has thickness_page_offsets => (is => 'lazy', isa => HashRef[HashRef]); |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
sub _build_thickness_page_offsets { |
210
|
10
|
|
|
10
|
|
2250
|
my $self = shift; |
211
|
10
|
|
|
|
|
143
|
my $total_pages = $self->total_output_pages; |
212
|
10
|
|
|
|
|
138
|
my %out = map { $_ => 0 } (1 .. $total_pages); |
|
144
|
|
|
|
|
213
|
|
213
|
10
|
50
|
|
|
|
54
|
if (my $signature = $self->signature) { |
214
|
|
|
|
|
|
|
# convert to the real signature |
215
|
10
|
100
|
|
|
|
31
|
if ($signature == 1) { |
216
|
2
|
|
|
|
|
4
|
$signature = $total_pages; |
217
|
|
|
|
|
|
|
} |
218
|
10
|
50
|
|
|
|
31
|
die "Should have already died, signature not a multiple of four" if $signature % 4; |
219
|
10
|
|
|
|
|
17
|
my $half = $signature / 2; |
220
|
10
|
|
|
|
|
126
|
my $offset = $self->paper_thickness_in_pt * ($half / 2); |
221
|
10
|
|
|
|
|
314
|
my $original_offset = $self->paper_thickness_in_pt * ($half / 2); |
222
|
10
|
|
|
|
|
57
|
my $signature_number = 0; |
223
|
10
|
|
|
|
|
26
|
foreach my $page (1 .. $total_pages) { |
224
|
144
|
|
66
|
|
|
246
|
my $page_in_sig = $page % $signature || $signature; |
225
|
144
|
100
|
|
|
|
171
|
if ($page_in_sig == 1) { |
226
|
14
|
|
|
|
|
21
|
$offset = $original_offset; |
227
|
14
|
|
|
|
|
14
|
$signature_number++; |
228
|
|
|
|
|
|
|
} |
229
|
144
|
|
|
|
|
87
|
print "page in sig / $signature_number : $page_in_sig\n" if DEBUG; |
230
|
|
|
|
|
|
|
# odd pages triggers a stepping |
231
|
144
|
100
|
|
|
|
176
|
if ($page_in_sig % 2) { |
232
|
72
|
100
|
|
|
|
137
|
if ($page_in_sig > ($half + 1)) { |
|
|
100
|
|
|
|
|
|
233
|
22
|
|
|
|
|
301
|
$offset += $self->paper_thickness_in_pt; |
234
|
|
|
|
|
|
|
} |
235
|
|
|
|
|
|
|
elsif ($page_in_sig < $half) { |
236
|
36
|
|
|
|
|
494
|
$offset -= $self->paper_thickness_in_pt; |
237
|
|
|
|
|
|
|
} |
238
|
|
|
|
|
|
|
} |
239
|
144
|
|
|
|
|
409
|
my $rounded = $self->_round($offset); |
240
|
144
|
|
|
|
|
117
|
print "offset for page is $rounded\n" if DEBUG; |
241
|
144
|
|
|
|
|
330
|
$out{$page} = { |
242
|
|
|
|
|
|
|
offset => $rounded, |
243
|
|
|
|
|
|
|
signature => $signature_number, |
244
|
|
|
|
|
|
|
signature_page => $page_in_sig, |
245
|
|
|
|
|
|
|
}; |
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
} |
248
|
10
|
|
|
|
|
150
|
return \%out; |
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
has total_input_pages => (is => 'lazy', isa => Int); |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
sub _build_total_input_pages { |
254
|
17
|
|
|
17
|
|
1898
|
my $self = shift; |
255
|
17
|
|
|
|
|
214
|
my $count = $self->in_pdf_object->pages; |
256
|
17
|
|
|
|
|
651
|
return $count; |
257
|
|
|
|
|
|
|
} |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
has total_output_pages => (is => 'lazy', isa => Int); |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
sub _build_total_output_pages { |
262
|
17
|
|
|
17
|
|
2348
|
my $self = shift; |
263
|
17
|
|
|
|
|
216
|
my $total_input_pages = $self->total_input_pages; |
264
|
|
|
|
|
|
|
|
265
|
17
|
100
|
|
|
|
430
|
if (my $signature = $self->signature) { |
266
|
13
|
100
|
|
|
|
57
|
if ($signature == 1) { |
|
|
100
|
|
|
|
|
|
267
|
|
|
|
|
|
|
# all the pages on a single signature |
268
|
|
|
|
|
|
|
# round to the next multiple of 4 |
269
|
3
|
|
|
|
|
6
|
my $missing = 0; |
270
|
3
|
50
|
|
|
|
12
|
if (my $modulo = $total_input_pages % 4) { |
271
|
0
|
|
|
|
|
0
|
$missing = 4 - $modulo; |
272
|
|
|
|
|
|
|
} |
273
|
3
|
|
|
|
|
46
|
return $total_input_pages + $missing; |
274
|
|
|
|
|
|
|
} |
275
|
|
|
|
|
|
|
elsif ($signature % 4) { |
276
|
1
|
|
|
|
|
11
|
die "Signature must be 1 or a multiple of 4, but I got $signature"; |
277
|
|
|
|
|
|
|
} |
278
|
|
|
|
|
|
|
else { |
279
|
9
|
|
|
|
|
16
|
my $missing = 0; |
280
|
9
|
100
|
|
|
|
36
|
if (my $modulo = $total_input_pages % $signature) { |
281
|
6
|
|
|
|
|
14
|
$missing = $signature - $modulo; |
282
|
|
|
|
|
|
|
} |
283
|
9
|
|
|
|
|
141
|
return $total_input_pages + $missing; |
284
|
|
|
|
|
|
|
} |
285
|
|
|
|
|
|
|
} |
286
|
|
|
|
|
|
|
else { |
287
|
4
|
|
|
|
|
61
|
return $total_input_pages; |
288
|
|
|
|
|
|
|
} |
289
|
|
|
|
|
|
|
} |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
sub _measure_re { |
293
|
61
|
|
|
61
|
|
223
|
return qr{([0-9]+(\.[0-9]+)?)\s* |
294
|
|
|
|
|
|
|
(mm|in|pt|cm)}sxi; |
295
|
|
|
|
|
|
|
} |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
sub _string_to_pt { |
298
|
44
|
|
|
44
|
|
76
|
my ($self, $string) = @_; |
299
|
|
|
|
|
|
|
my %compute = ( |
300
|
24
|
|
|
24
|
|
88
|
mm => sub { $_[0] / (25.4 / 72) }, |
301
|
3
|
|
|
3
|
|
18
|
in => sub { $_[0] / (1 / 72) }, |
302
|
15
|
|
|
15
|
|
75
|
pt => sub { $_[0] / 1 }, |
303
|
2
|
|
|
2
|
|
11
|
cm => sub { $_[0] / (25.4 / 72) * 10 }, |
304
|
44
|
|
|
|
|
452
|
); |
305
|
44
|
|
|
|
|
119
|
my $re = $self->_measure_re; |
306
|
44
|
50
|
|
|
|
315
|
if ($string =~ $re) { |
307
|
44
|
|
|
|
|
73
|
my $size = $1; |
308
|
44
|
|
|
|
|
92
|
my $unit = lc($3); |
309
|
44
|
|
|
|
|
111
|
return $self->_round($compute{$unit}->($size)); |
310
|
|
|
|
|
|
|
} |
311
|
|
|
|
|
|
|
else { |
312
|
0
|
|
|
|
|
0
|
die "Unparsable measure string $string"; |
313
|
|
|
|
|
|
|
} |
314
|
|
|
|
|
|
|
} |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
=head1 METHODS |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
=head2 add_cropmarks |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
This is the only public method: create the new pdf from C and |
321
|
|
|
|
|
|
|
leave it in C |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
=cut |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
has input => (is => 'ro', isa => Str, required => 1); |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
has output => (is => 'ro', isa => Str, required => 1); |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
has paper => (is => 'ro', isa => Str, default => sub { 'a4' }); |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
has _tmpdir => (is => 'ro', |
332
|
|
|
|
|
|
|
isa => Object, |
333
|
|
|
|
|
|
|
default => sub { |
334
|
|
|
|
|
|
|
return File::Temp->newdir(CLEANUP => !DEBUG); |
335
|
|
|
|
|
|
|
}); |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
has in_pdf => (is => 'lazy', isa => Str); |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
has out_pdf => (is => 'lazy', isa => Str); |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
has basename => (is => 'lazy', isa => Str); |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
has timestamp => (is => 'lazy', isa => Str); |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
sub _build_basename { |
346
|
15
|
|
|
15
|
|
1760
|
my $self = shift; |
347
|
15
|
|
|
|
|
590
|
my $basename = fileparse($self->input, qr{\.pdf}i); |
348
|
15
|
|
|
|
|
246
|
return $basename; |
349
|
|
|
|
|
|
|
} |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
sub _build_timestamp { |
352
|
10
|
|
|
10
|
|
2078
|
my $now = localtime(); |
353
|
10
|
|
|
|
|
166
|
return $now; |
354
|
|
|
|
|
|
|
} |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
has top => (is => 'ro', isa => Bool, default => sub { 1 }); |
357
|
|
|
|
|
|
|
has bottom => (is => 'ro', isa => Bool, default => sub { 1 }); |
358
|
|
|
|
|
|
|
has inner => (is => 'ro', isa => Bool, default => sub { 1 }); |
359
|
|
|
|
|
|
|
has outer => (is => 'ro', isa => Bool, default => sub { 1 }); |
360
|
|
|
|
|
|
|
has twoside => (is => 'ro', isa => Bool, default => sub { 1 }); |
361
|
|
|
|
|
|
|
has _is_closed => (is => 'rw', isa => Bool, default => sub { 0 }); |
362
|
|
|
|
|
|
|
sub _build_in_pdf { |
363
|
17
|
|
|
17
|
|
1457
|
my $self = shift; |
364
|
17
|
|
|
|
|
246
|
my $name = File::Spec->catfile($self->_tmpdir, 'in.pdf'); |
365
|
17
|
50
|
|
|
|
276
|
copy ($self->input, $name) or die "Cannot copy input to $name $!"; |
366
|
17
|
|
|
|
|
7368
|
return $name; |
367
|
|
|
|
|
|
|
} |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
sub _build_out_pdf { |
370
|
10
|
|
|
10
|
|
2043
|
my $self = shift; |
371
|
10
|
|
|
|
|
209
|
return File::Spec->catfile($self->_tmpdir, 'out.pdf'); |
372
|
|
|
|
|
|
|
} |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
has in_pdf_object => (is => 'lazy', isa => Object); |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
sub _build_in_pdf_object { |
378
|
17
|
|
|
17
|
|
2094
|
my $self = shift; |
379
|
17
|
|
|
|
|
27
|
my $input = eval { PDF::API2->open($self->in_pdf) }; |
|
17
|
|
|
|
|
217
|
|
380
|
17
|
50
|
|
|
|
874156
|
if ($input) { |
381
|
17
|
|
|
|
|
552
|
return $input; |
382
|
|
|
|
|
|
|
} |
383
|
|
|
|
|
|
|
else { |
384
|
0
|
0
|
|
|
|
0
|
die "Cannot open " . $self->in_pdf . " $@" unless $input; |
385
|
|
|
|
|
|
|
} |
386
|
|
|
|
|
|
|
} |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
has out_pdf_object => (is => 'lazy', isa => Object); |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
sub _build_out_pdf_object { |
391
|
17
|
|
|
17
|
|
5122
|
my $self = shift; |
392
|
17
|
|
|
|
|
125
|
my $pdf = PDF::API2->new; |
393
|
17
|
|
|
|
|
8978
|
my $now = POSIX::strftime(q{%Y%m%d%H%M%S+00'00'}, localtime(time())); |
394
|
17
|
|
66
|
|
|
399
|
$pdf->info(Creator => 'PDF::Cropmarks', |
395
|
|
|
|
|
|
|
Producer => 'PDF::API2', |
396
|
|
|
|
|
|
|
Title => $self->title || $self->basename, |
397
|
|
|
|
|
|
|
CreationDate => $now, |
398
|
|
|
|
|
|
|
ModDate => $now); |
399
|
17
|
|
|
|
|
2061
|
$pdf->mediabox($self->_paper_dimensions); |
400
|
17
|
|
|
|
|
1981
|
return $pdf; |
401
|
|
|
|
|
|
|
} |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
sub _paper_dimensions { |
404
|
17
|
|
|
17
|
|
24
|
my $self = shift; |
405
|
17
|
|
|
|
|
55
|
my $paper = $self->paper; |
406
|
17
|
|
|
|
|
76
|
my %sizes = PDF::API2::Util::getPaperSizes(); |
407
|
17
|
|
|
|
|
1339
|
my $measure_re = $self->_measure_re; |
408
|
17
|
100
|
|
|
|
133
|
if (my $dimensions = $sizes{lc($self->paper)}) { |
|
|
50
|
|
|
|
|
|
409
|
15
|
|
|
|
|
134
|
return @$dimensions; |
410
|
|
|
|
|
|
|
} |
411
|
|
|
|
|
|
|
elsif ($paper =~ m/\A\s* |
412
|
|
|
|
|
|
|
$measure_re |
413
|
|
|
|
|
|
|
\s*:\s* |
414
|
|
|
|
|
|
|
$measure_re |
415
|
|
|
|
|
|
|
\s*\z/sxi) { |
416
|
|
|
|
|
|
|
# 3 + 3 captures |
417
|
2
|
|
|
|
|
5
|
my $xsize = $1; |
418
|
2
|
|
|
|
|
4
|
my $xunit = $3; |
419
|
2
|
|
|
|
|
4
|
my $ysize = $4; |
420
|
2
|
|
|
|
|
4
|
my $yunit = $6; |
421
|
2
|
|
|
|
|
8
|
return ($self->_string_to_pt($xsize . $xunit), |
422
|
|
|
|
|
|
|
$self->_string_to_pt($ysize . $yunit)); |
423
|
|
|
|
|
|
|
} |
424
|
|
|
|
|
|
|
else { |
425
|
0
|
|
|
|
|
0
|
die "Cannot get dimensions from $paper, using A4"; |
426
|
|
|
|
|
|
|
} |
427
|
|
|
|
|
|
|
} |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
sub add_cropmarks { |
430
|
10
|
|
|
10
|
1
|
7059
|
my $self = shift; |
431
|
10
|
50
|
|
|
|
182
|
die "add_cropmarks already called!" if $self->_is_closed; |
432
|
10
|
|
|
|
|
1143
|
my $needed = $self->total_output_pages - $self->total_input_pages; |
433
|
10
|
50
|
|
|
|
342
|
die "Something is off, pages needed: $needed pages" if $needed < 0; |
434
|
10
|
|
|
|
|
134
|
my @sequence = (1 .. $self->total_input_pages); |
435
|
10
|
100
|
|
|
|
79
|
if ($needed) { |
436
|
5
|
|
|
|
|
9
|
my $last; |
437
|
5
|
100
|
|
|
|
25
|
if ($self->cover) { |
438
|
2
|
|
|
|
|
3
|
$last = pop @sequence; |
439
|
|
|
|
|
|
|
} |
440
|
5
|
|
|
|
|
49
|
while ($needed > 0) { |
441
|
16
|
|
|
|
|
14
|
push @sequence, undef; |
442
|
16
|
|
|
|
|
23
|
$needed--; |
443
|
|
|
|
|
|
|
} |
444
|
5
|
100
|
|
|
|
16
|
if ($last) { |
445
|
2
|
|
|
|
|
4
|
push @sequence, $last; |
446
|
|
|
|
|
|
|
} |
447
|
|
|
|
|
|
|
} |
448
|
10
|
|
|
|
|
14
|
my $as_page_number = 0; |
449
|
10
|
|
|
|
|
14
|
print Dumper(\@sequence) if DEBUG; |
450
|
10
|
|
|
|
|
19
|
foreach my $src_page_number (@sequence) { |
451
|
140
|
|
|
|
|
65843
|
$as_page_number++; |
452
|
|
|
|
|
|
|
# and set it as page_number |
453
|
140
|
|
|
|
|
458
|
$self->_import_page($src_page_number, $as_page_number); |
454
|
|
|
|
|
|
|
} |
455
|
10
|
|
|
|
|
5144
|
print "Saving " . $self->out_pdf . "\n" if DEBUG; |
456
|
10
|
|
|
|
|
235
|
$self->out_pdf_object->saveas($self->out_pdf); |
457
|
10
|
|
|
|
|
2315910
|
$self->in_pdf_object->end; |
458
|
10
|
|
|
|
|
18534
|
$self->out_pdf_object->end; |
459
|
10
|
|
|
|
|
123
|
print "Objects closed\n" if DEBUG; |
460
|
10
|
50
|
|
|
|
168
|
move($self->out_pdf, $self->output) |
461
|
|
|
|
|
|
|
or die "Cannot copy " . $self->out_pdf . ' to ' . $self->output; |
462
|
10
|
|
|
|
|
1685
|
$self->_is_closed(1); |
463
|
10
|
|
|
|
|
334
|
return $self->output; |
464
|
|
|
|
|
|
|
} |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
sub _round { |
467
|
612
|
|
|
612
|
|
1999081
|
my ($self, $float) = @_; |
468
|
612
|
|
|
|
|
521
|
print "Rounding $float\n" if DEBUG; |
469
|
612
|
100
|
|
|
|
1135
|
return 0 unless $float; |
470
|
580
|
100
|
100
|
|
|
1439
|
if ($float < 0.001 && $float > -0.001) { |
471
|
28
|
|
|
|
|
27
|
return 0; |
472
|
|
|
|
|
|
|
} |
473
|
552
|
|
|
|
|
5262
|
return sprintf('%.3f', $float); |
474
|
|
|
|
|
|
|
} |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
has output_dimensions => (is => 'lazy', isa => ArrayRef); |
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
has title => (is => 'ro', isa => Maybe[Str]); |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
sub _build_output_dimensions { |
481
|
5
|
|
|
5
|
|
1769
|
my $self = shift; |
482
|
|
|
|
|
|
|
# get the first page |
483
|
5
|
|
|
|
|
88
|
my $in_page = $self->in_pdf_object->openpage(1); |
484
|
5
|
|
|
|
|
185
|
return [ $in_page->get_mediabox ]; |
485
|
|
|
|
|
|
|
} |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
sub _import_page { |
488
|
140
|
|
|
140
|
|
181
|
my ($self, $src_page_number, $page_number) = @_; |
489
|
140
|
100
|
|
|
|
3112
|
my $in_page = (defined $src_page_number ? $self->in_pdf_object->openpage($src_page_number) : undef); |
490
|
140
|
|
|
|
|
235528
|
my $page = $self->out_pdf_object->page; |
491
|
140
|
|
|
|
|
49348
|
my ($llx, $lly, $urx, $ury) = $page->get_mediabox; |
492
|
140
|
50
|
|
|
|
6446
|
die "mediabox origins for output pdf should be zero" if $llx + $lly; |
493
|
140
|
|
|
|
|
139
|
print "$llx, $lly, $urx, $ury\n" if DEBUG; |
494
|
140
|
100
|
|
|
|
536
|
my ($inllx, $inlly, $inurx, $inury) = ($in_page ? $in_page->get_mediabox : @{$self->output_dimensions}); |
|
16
|
|
|
|
|
312
|
|
495
|
140
|
|
|
|
|
4753
|
print "$inllx, $inlly, $inurx, $inury\n" if DEBUG; |
496
|
140
|
50
|
|
|
|
418
|
die "mediabox origins for input pdf should be zero" if $inllx + $inlly; |
497
|
|
|
|
|
|
|
# place the content into page |
498
|
|
|
|
|
|
|
|
499
|
140
|
|
|
|
|
707
|
my $offset_x = $self->_round(($urx - $inurx) / 2); |
500
|
140
|
|
|
|
|
418
|
my $offset_y = $self->_round(($ury - $inury) / 2); |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
# adjust offset if bottom or top are missing. Both missing doesn't |
503
|
|
|
|
|
|
|
# make much sense |
504
|
140
|
|
|
|
|
245
|
my ($top_middle_mark, $bottom_middle_mark, |
505
|
|
|
|
|
|
|
$left_middle_mark, $right_middle_mark) = (1, 1, 1, 1); |
506
|
|
|
|
|
|
|
|
507
|
140
|
50
|
66
|
|
|
1337
|
if (!$self->bottom && !$self->top) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
508
|
|
|
|
|
|
|
# warn "bottom and top are both false, centering\n"; |
509
|
|
|
|
|
|
|
} |
510
|
|
|
|
|
|
|
elsif (!$self->bottom) { |
511
|
28
|
|
|
|
|
50
|
$offset_y = 0; |
512
|
28
|
|
|
|
|
41
|
$bottom_middle_mark = 0; |
513
|
|
|
|
|
|
|
} |
514
|
|
|
|
|
|
|
elsif (!$self->top) { |
515
|
24
|
|
|
|
|
55
|
$offset_y *= 2; |
516
|
24
|
|
|
|
|
39
|
$top_middle_mark = 0; |
517
|
|
|
|
|
|
|
} |
518
|
|
|
|
|
|
|
|
519
|
140
|
50
|
66
|
|
|
1352
|
if (!$self->inner && !$self->outer) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
520
|
|
|
|
|
|
|
# warn "inner and outer are both false, centering\n"; |
521
|
|
|
|
|
|
|
} |
522
|
|
|
|
|
|
|
elsif (!$self->inner) { |
523
|
|
|
|
|
|
|
# even pages |
524
|
56
|
100
|
100
|
|
|
365
|
if ($self->twoside and !($page_number % 2)) { |
525
|
22
|
|
|
|
|
51
|
$offset_x *= 2; |
526
|
22
|
|
|
|
|
43
|
$right_middle_mark = 0; |
527
|
|
|
|
|
|
|
} |
528
|
|
|
|
|
|
|
else { |
529
|
34
|
|
|
|
|
43
|
$offset_x = 0; |
530
|
34
|
|
|
|
|
52
|
$left_middle_mark = 0; |
531
|
|
|
|
|
|
|
} |
532
|
|
|
|
|
|
|
} |
533
|
|
|
|
|
|
|
elsif (!$self->outer) { |
534
|
|
|
|
|
|
|
# odd pages |
535
|
28
|
100
|
100
|
|
|
170
|
if ($self->twoside and !($page_number % 2)) { |
536
|
8
|
|
|
|
|
12
|
$offset_x = 0; |
537
|
8
|
|
|
|
|
17
|
$left_middle_mark = 0; |
538
|
|
|
|
|
|
|
} |
539
|
|
|
|
|
|
|
else { |
540
|
20
|
|
|
|
|
44
|
$offset_x *= 2; |
541
|
20
|
|
|
|
|
96
|
$right_middle_mark = 0; |
542
|
|
|
|
|
|
|
} |
543
|
|
|
|
|
|
|
} |
544
|
|
|
|
|
|
|
|
545
|
140
|
|
|
|
|
233
|
my $signature_mark = ''; |
546
|
140
|
100
|
100
|
|
|
865
|
if ($self->signature && $self->twoside) { |
547
|
92
|
|
|
|
|
2125
|
my $spec = $self->thickness_page_offsets->{$page_number}; |
548
|
92
|
|
|
|
|
915
|
my $paper_thickness = $spec->{offset}; |
549
|
92
|
50
|
|
|
|
260
|
die "$page_number not defined in " . Dumper($self->thickness_page_offsets) |
550
|
|
|
|
|
|
|
unless defined $paper_thickness; |
551
|
|
|
|
|
|
|
# recto pages, increase |
552
|
92
|
100
|
|
|
|
238
|
if ($page_number % 2) { |
553
|
46
|
|
|
|
|
108
|
$offset_x += $paper_thickness; |
554
|
|
|
|
|
|
|
} |
555
|
|
|
|
|
|
|
# verso pages, decrease |
556
|
|
|
|
|
|
|
else { |
557
|
46
|
|
|
|
|
102
|
$offset_x -= $paper_thickness; |
558
|
|
|
|
|
|
|
} |
559
|
92
|
|
|
|
|
337
|
$signature_mark = ' #' . $spec->{signature} . '/' . $spec->{signature_page}; |
560
|
|
|
|
|
|
|
} |
561
|
|
|
|
|
|
|
|
562
|
140
|
|
|
|
|
135
|
print "Offsets are $offset_x, $offset_y\n" if DEBUG; |
563
|
140
|
100
|
|
|
|
298
|
if ($in_page) { |
564
|
124
|
|
|
|
|
2298
|
my $xo = $self->out_pdf_object->importPageIntoForm($self->in_pdf_object, |
565
|
|
|
|
|
|
|
$src_page_number); |
566
|
124
|
|
|
|
|
1017050
|
my $gfx = $page->gfx; |
567
|
124
|
|
|
|
|
13457
|
$gfx->formimage($xo, $offset_x, $offset_y); |
568
|
|
|
|
|
|
|
} |
569
|
140
|
|
|
|
|
30101
|
if (DEBUG) { |
570
|
|
|
|
|
|
|
my $line = $page->gfx; |
571
|
|
|
|
|
|
|
$line->strokecolor('black'); |
572
|
|
|
|
|
|
|
$line->linewidth(0.5); |
573
|
|
|
|
|
|
|
$line->rectxy($offset_x, $offset_y, |
574
|
|
|
|
|
|
|
$offset_x + $inurx, $offset_y + $inury); |
575
|
|
|
|
|
|
|
$line->stroke; |
576
|
|
|
|
|
|
|
} |
577
|
140
|
|
|
|
|
363
|
my $crop = $page->gfx; |
578
|
140
|
|
|
|
|
13716
|
$crop->strokecolor('black'); |
579
|
140
|
|
|
|
|
12673
|
$crop->linewidth(0.5); |
580
|
140
|
|
|
|
|
6784
|
my $crop_width = $self->cropmark_length_in_pt; |
581
|
140
|
|
|
|
|
3133
|
my $crop_offset = $self->cropmark_offset_in_pt; |
582
|
|
|
|
|
|
|
# left bottom corner |
583
|
140
|
|
|
|
|
1769
|
$self->_draw_line($crop, |
584
|
|
|
|
|
|
|
($offset_x - $crop_offset, $offset_y), |
585
|
|
|
|
|
|
|
($offset_x - $crop_width - $crop_offset, $offset_y)); |
586
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
|
588
|
140
|
|
|
|
|
7236
|
$self->_draw_line($crop, |
589
|
|
|
|
|
|
|
($offset_x, $offset_y - $crop_offset), |
590
|
|
|
|
|
|
|
($offset_x, $offset_y - $crop_offset - $crop_width)); |
591
|
|
|
|
|
|
|
|
592
|
140
|
100
|
|
|
|
7306
|
if ($bottom_middle_mark) { |
593
|
112
|
|
|
|
|
459
|
$self->_draw_line($crop, |
594
|
|
|
|
|
|
|
($offset_x + ($inurx / 2), |
595
|
|
|
|
|
|
|
$offset_y - $crop_offset), |
596
|
|
|
|
|
|
|
($offset_x + ($inurx / 2), |
597
|
|
|
|
|
|
|
$offset_y - $crop_offset - ($crop_width / 2))); |
598
|
|
|
|
|
|
|
} |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
# right bottom corner |
601
|
140
|
|
|
|
|
5981
|
$self->_draw_line($crop, |
602
|
|
|
|
|
|
|
($offset_x + $inurx + $crop_offset, $offset_y), |
603
|
|
|
|
|
|
|
($offset_x + $inurx + $crop_offset + $crop_width, |
604
|
|
|
|
|
|
|
$offset_y)); |
605
|
140
|
|
|
|
|
7216
|
$self->_draw_line($crop, |
606
|
|
|
|
|
|
|
($offset_x + $inurx, |
607
|
|
|
|
|
|
|
$offset_y - $crop_offset), |
608
|
|
|
|
|
|
|
($offset_x + $inurx, |
609
|
|
|
|
|
|
|
$offset_y - $crop_offset - $crop_width)); |
610
|
|
|
|
|
|
|
|
611
|
140
|
100
|
|
|
|
7459
|
if ($right_middle_mark) { |
612
|
98
|
|
|
|
|
422
|
$self->_draw_line($crop, |
613
|
|
|
|
|
|
|
($offset_x + $inurx + $crop_offset, |
614
|
|
|
|
|
|
|
$offset_y + ($inury/2)), |
615
|
|
|
|
|
|
|
($offset_x + $inurx + $crop_offset + ($crop_width / 2), |
616
|
|
|
|
|
|
|
$offset_y + ($inury/2))); |
617
|
|
|
|
|
|
|
} |
618
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
# top right corner |
620
|
140
|
|
|
|
|
5128
|
$self->_draw_line($crop, |
621
|
|
|
|
|
|
|
($offset_x + $inurx + $crop_offset, |
622
|
|
|
|
|
|
|
$offset_y + $inury), |
623
|
|
|
|
|
|
|
($offset_x + $inurx + $crop_offset + $crop_width, |
624
|
|
|
|
|
|
|
$offset_y + $inury)); |
625
|
|
|
|
|
|
|
|
626
|
140
|
|
|
|
|
7209
|
$self->_draw_line($crop, |
627
|
|
|
|
|
|
|
($offset_x + $inurx, |
628
|
|
|
|
|
|
|
$offset_y + $inury + $crop_offset), |
629
|
|
|
|
|
|
|
($offset_x + $inurx, |
630
|
|
|
|
|
|
|
$offset_y + $inury + $crop_offset + $crop_width)); |
631
|
|
|
|
|
|
|
|
632
|
140
|
100
|
|
|
|
7216
|
if ($top_middle_mark) { |
633
|
116
|
|
|
|
|
529
|
$self->_draw_line($crop, |
634
|
|
|
|
|
|
|
($offset_x + ($inurx / 2), |
635
|
|
|
|
|
|
|
$offset_y + $inury + $crop_offset), |
636
|
|
|
|
|
|
|
($offset_x + ($inurx / 2), |
637
|
|
|
|
|
|
|
$offset_y + $inury + $crop_offset + ($crop_width / 2))); |
638
|
|
|
|
|
|
|
} |
639
|
|
|
|
|
|
|
|
640
|
|
|
|
|
|
|
# top left corner |
641
|
140
|
|
|
|
|
6515
|
$self->_draw_line($crop, |
642
|
|
|
|
|
|
|
($offset_x, $offset_y + $inury + $crop_offset), |
643
|
|
|
|
|
|
|
($offset_x, |
644
|
|
|
|
|
|
|
$offset_y + $inury + $crop_offset + $crop_width)); |
645
|
|
|
|
|
|
|
|
646
|
140
|
|
|
|
|
7575
|
$self->_draw_line($crop, |
647
|
|
|
|
|
|
|
($offset_x - $crop_offset, |
648
|
|
|
|
|
|
|
$offset_y + $inury), |
649
|
|
|
|
|
|
|
($offset_x - $crop_offset - $crop_width, |
650
|
|
|
|
|
|
|
$offset_y + $inury)); |
651
|
|
|
|
|
|
|
|
652
|
140
|
100
|
|
|
|
7473
|
if ($left_middle_mark) { |
653
|
98
|
|
|
|
|
414
|
$self->_draw_line($crop, |
654
|
|
|
|
|
|
|
($offset_x - $crop_offset, |
655
|
|
|
|
|
|
|
$offset_y + ($inury / 2)), |
656
|
|
|
|
|
|
|
($offset_x - $crop_offset - ($crop_width / 2), |
657
|
|
|
|
|
|
|
$offset_y + ($inury / 2))); |
658
|
|
|
|
|
|
|
} |
659
|
|
|
|
|
|
|
# and stroke |
660
|
140
|
|
|
|
|
5301
|
$crop->stroke; |
661
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
# then add the text |
663
|
140
|
|
|
|
|
3712
|
my $text = $page->text; |
664
|
140
|
|
|
|
|
32001
|
my $marker = sprintf('Pg %.4d', $page_number); |
665
|
140
|
|
|
|
|
4388
|
$text->font($self->out_pdf_object->corefont('Courier'), |
666
|
|
|
|
|
|
|
$self->_round($self->font_size_in_pt)); |
667
|
140
|
|
|
|
|
25968
|
$text->fillcolor('black'); |
668
|
|
|
|
|
|
|
|
669
|
|
|
|
|
|
|
# bottom left |
670
|
140
|
|
|
|
|
14297
|
$text->translate($offset_x - (($crop_width + $crop_offset)), |
671
|
|
|
|
|
|
|
$offset_y - (($crop_width + $crop_offset))); |
672
|
140
|
|
|
|
|
44293
|
$text->text($marker); |
673
|
|
|
|
|
|
|
|
674
|
|
|
|
|
|
|
# bottom right |
675
|
140
|
|
|
|
|
23604
|
$text->translate($inurx + $offset_x + $crop_offset, |
676
|
|
|
|
|
|
|
$offset_y - (($crop_width + $crop_offset))); |
677
|
140
|
|
|
|
|
39241
|
$text->text($marker); |
678
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
# top left |
680
|
140
|
|
|
|
|
15887
|
$text->translate($offset_x - (($crop_width + $crop_offset)), |
681
|
|
|
|
|
|
|
$offset_y + $inury + $crop_width); |
682
|
140
|
|
|
|
|
35778
|
$text->text($marker); |
683
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
# top right |
685
|
140
|
|
|
|
|
15622
|
$text->translate($inurx + $offset_x + $crop_offset, |
686
|
|
|
|
|
|
|
$offset_y + $inury + $crop_width); |
687
|
140
|
|
|
|
|
35270
|
$text->text($marker); |
688
|
|
|
|
|
|
|
|
689
|
140
|
|
66
|
|
|
18969
|
my $text_marker = ($self->title || $self->basename) |
690
|
|
|
|
|
|
|
. ' ' . $self->timestamp . |
691
|
|
|
|
|
|
|
' page ' . $page_number . $signature_mark; |
692
|
|
|
|
|
|
|
# and at the top and and the bottom add jobname + timestamp |
693
|
140
|
|
|
|
|
4027
|
$text->translate(($inurx / 2) + $offset_x, |
694
|
|
|
|
|
|
|
$offset_y + $inury + $crop_width); |
695
|
140
|
|
|
|
|
36095
|
$text->text_center($text_marker); |
696
|
|
|
|
|
|
|
|
697
|
140
|
|
|
|
|
71789
|
$text->translate(($inurx / 2) + $offset_x, |
698
|
|
|
|
|
|
|
$offset_y - ($crop_width + $crop_offset)); |
699
|
140
|
|
|
|
|
35750
|
$text->text_center($text_marker); |
700
|
|
|
|
|
|
|
} |
701
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
sub _draw_line { |
703
|
1544
|
|
|
1544
|
|
1915
|
my ($self, $gfx, $from_x, $from_y, $to_x, $to_y) = @_; |
704
|
1544
|
|
|
|
|
1253
|
if (DEBUG) { |
705
|
|
|
|
|
|
|
print "Printing line from ($from_x, $from_y) to ($to_x, $to_y)\n"; |
706
|
|
|
|
|
|
|
} |
707
|
1544
|
|
|
|
|
2586
|
$gfx->move($from_x, $from_y); |
708
|
1544
|
|
|
|
|
85013
|
$gfx->line($to_x, $to_y); |
709
|
1544
|
|
|
|
|
78104
|
my $radius = 3; |
710
|
1544
|
|
|
|
|
3077
|
$gfx->circle($to_x, $to_y, $radius); |
711
|
1544
|
|
|
|
|
2716934
|
$gfx->move($to_x - $radius, $to_y); |
712
|
1544
|
|
|
|
|
84223
|
$gfx->line($to_x + $radius, $to_y); |
713
|
1544
|
|
|
|
|
80242
|
$gfx->move($to_x, $to_y - $radius); |
714
|
1544
|
|
|
|
|
79686
|
$gfx->line($to_x, $to_y + $radius); |
715
|
|
|
|
|
|
|
} |
716
|
|
|
|
|
|
|
|
717
|
|
|
|
|
|
|
sub DESTROY { |
718
|
17
|
|
|
17
|
|
266428
|
my $self = shift; |
719
|
17
|
100
|
|
|
|
402
|
unless ($self->_is_closed) { |
720
|
7
|
|
|
|
|
708
|
$self->in_pdf_object->end; |
721
|
7
|
|
|
|
|
4184
|
$self->out_pdf_object->end; |
722
|
|
|
|
|
|
|
} |
723
|
|
|
|
|
|
|
} |
724
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
=head1 AUTHOR |
726
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
Marco Pessotto, C<< >> |
728
|
|
|
|
|
|
|
|
729
|
|
|
|
|
|
|
=head1 BUGS |
730
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
Please report any bugs or feature requests to the CPAN's RT or at |
732
|
|
|
|
|
|
|
L. If you find |
733
|
|
|
|
|
|
|
a bug, please provide a minimal example file which reproduces the |
734
|
|
|
|
|
|
|
problem. |
735
|
|
|
|
|
|
|
|
736
|
|
|
|
|
|
|
=head1 LICENSE |
737
|
|
|
|
|
|
|
|
738
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify |
739
|
|
|
|
|
|
|
it under the terms of either: the GNU General Public License as |
740
|
|
|
|
|
|
|
published by the Free Software Foundation; or the Artistic License. |
741
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
=cut |
743
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
1; |