File Coverage

blib/lib/PDF/Labels.pm
Criterion Covered Total %
statement 1 3 33.3
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 2 4 50.0


line stmt bran cond sub pod time code
1             #!/bin/perl
2             #
3             # @(#)Labels.pm 1.8 01/02/10
4             #
5             # Perl package of routines to produce mailing label PDFs
6             #
7              
8             # PDF::Labels - create Mailing Labels in PDF files
9             # Author: Owen DeLong
10             # Version: 0.01
11             # Copyright 2001 Owen DeLong
12             #
13             # bugs:
14             # - ...
15              
16             package PDF::Labels;
17              
18 1     1   2119 use PDF::Create;
  0            
  0            
19             use strict;
20             use vars qw(@ISA @EXPORT $VERSION $DEBUG);
21             use Exporter;
22              
23             @ISA = qw(Exporter);
24             @EXPORT = qw();
25             $VERSION = 1.8;
26             $DEBUG = 0;
27              
28             # Remainder of code appears at end of documentation
29              
30             =head1 NAME
31              
32             PDF::Labels - Routines to produce formatted pages of mailing labels in PDF
33              
34             =head1 SYNOPSIS
35              
36             use PDF::Labels;
37              
38             Requires: PDF::Create
39              
40             =head1 DESCRIPTION
41              
42             =head2 GENERAL
43              
44             Provides package PDF::Labels
45              
46             Package Global Variables:
47              
48             @PDF::Labels:PageFormats is a list of known page formats. Each
49             page format is a : delimited list of fields which provide the
50             following properties about a page of labels:
51              
52             pagewidth Width of actual page in inches
53             pageheight Height of actual page in inches
54             pagexoffset Offset from left edge of page to left
55             edge of first column of labels in inches
56             pageyoffset Offset from bottom edge of page to
57             bottom edge of lowest row of labels
58             xlabels Number of labels in each row
59             ylabels Number of labels in each column
60             labelwidth Width of each label in inches, including
61             margin
62             labelheight Height of each label in inches, including
63             margin
64             labelxmar Minimum Distance to offset printing from
65             left and right edges of label
66             labelymar Minimum distance to offset printing from
67             top and bottom edges of label
68             fontsize Size of font to use with this label
69             linespacing Line spacing (points) to use with this
70             label
71              
72             =head2 SYNTAX
73              
74             Example
75              
76             use PDF::Create;
77             use PDF::Labels;
78              
79             $pdf = new PDF::Labels(
80             $PDF::Labels::PageFormats[0],
81             filename=>'labels.pdf',
82             Author=>'PDF Labelmaker',
83             Title=>'My Labels'
84             );
85              
86             $pdf->setlabel(5); # Start with label 5 on first page
87              
88             $pdf->label('John Doe', '1234 Some Street',
89             'Anytown, ID', '12345');
90             $pdf->label('Jane Doe', '5493 Other Drive',
91             'Nowhere, CA', '92213');
92             $pdf->label('Bob Smith', '392 Cedar Lane',
93             'Deep Shit, AR', '72134');
94              
95             $pdf->close();
96              
97             The above example will produce 3 labels on an 8.5x11 sheet with
98             three labels in a row and 10 rows of labels. The labels are
99             2.625"x1". This is a common sheet-feed label. In this case, the
100             three labels will be the last label of the second row and the
101             first two labels of the third row. The labels can be moved by
102             changing the parameter to the setlabel call.
103              
104             Creation
105              
106             $pdf = new PDF::Labels(
107             $PageFormat,
108             PDF::Create parameters
109             )
110              
111             $PageFormat is a string containing a single element of PageFormats
112             or a custom page format specification in the same format.
113              
114             PDF::Create parameters are described in the PDF::Create pod.
115              
116             Setup
117              
118             $pdf->setlabel(n)
119              
120             n is a number from 0 to maxlabels. Subsequent calls to create
121             labels will create labels starting from this position on the
122             page. Position 0 is the upper left label, working across each
123             row down in columns.
124              
125             i.e. 0 1 2
126             3 4 5
127             6 7 8
128             ...
129              
130             Setlabel will not go backwards. If n is less than the current
131             cursor position, a new page will be created.
132              
133             Label Creation
134              
135             $pdf->label('string1', 'string2', 'string3'[, 'string4'...])
136              
137             As much of each string as possible will be placed on a seperate
138             line of the label. If there are more strings than the label can
139             hold, extra strings will not be printed.
140              
141             @(#) Labels.pm Last updated 01/02/10 18:59:54 (SCCS Version 1.8)
142              
143             =head1 AUTHOR
144              
145             Owen DeLong, owen@delong.com
146              
147             =cut
148              
149              
150             @PDF::Labels::PageFormats=(
151             # pw:ph:xof:yof:x:yl:lwid:lh:lxma:lymar:fs:ls # Page quan labelsize
152             # Sheet labels (laser or inkjet)
153             "8.5:11:0.2:0.5:3:10:2.75:1:0.25:0.15:10:12", # 8.5x11 3x10 2.75x1"
154             "8.5:11:0.2:0.5:2:10:4.25:1:0.25:0.15:10:12", # 8.5x11 2x10 4x1"
155             "8.5:11:0.25:0.4:4:20:2.0625:0.5:0.25:0.1:6:7", # 8.5x11 4x20 1.75x0.5"
156             # Pin feed labels (dot matrix)
157             "4.25:5:0:0:1:5:3.5:1:0.25:0.135:12:14" # 4.25x5 1x5 3.5x.9375"
158             );
159              
160             @PDF::Labels::FriendlyNames=(
161             "8.5x11 3 columns, 10 rows, 2.65x1 inch labels",
162             "8.5x11 2 columns, 10 rows, 4x1 inch labels",
163             "8.5x11 4 columns, 20 rows, 2x1/2 inch labels",
164             "Pin Feed 3.5x1 inch labels, single column, 5 per fanfold"
165             );
166              
167             # creation routine
168             sub new {
169             my $this = shift;
170             my $PageFormat = shift;
171             my %params = @_;
172              
173             my $class = ref($this) || $this;
174             my $self = {};
175             bless $self, $class;
176             $self->{'data'}='';
177             $self->{'PageFormat'}=$PageFormat;
178             my ($pw, $ph, $xof, $yof, $xl, $yl, $lw, $lh, $lxm, $lym, $fp, $ls)=
179             split(/:/, $PageFormat);
180             $self->{'PageWidth'}=$pw;
181             $self->{'PageHeight'}=$ph;
182             $self->{'Xoffset'}=$xof;
183             $self->{'Yoffset'}=$yof;
184             $self->{'Xlabels'}=$xl;
185             $self->{'Ylabels'}=$yl;
186             $self->{'LabelWidth'}=$lw;
187             $self->{'LabelHeight'}=$lh;
188             $self->{'LabelXMargin'}=$lxm;
189             $self->{'LabelYMargin'}=$lym;
190             $self->{'FontSize'}=$fp;
191             $self->{'LineSpacing'}=$ls;
192              
193             $self->{'PDF'}=new PDF::Create(%params) || die('Couldn\'t create PDF');
194             if (!defined($self->{'PDF'}->{'fh'}))
195             {
196             print "ERROR NO FH!\n";
197             }
198              
199             $self->{'rootpage'}=$self->{'PDF'}->new_page(
200             'MediaBox' => [0,0,$self->{'PageWidth'}*72,
201             $self->{'PageHeight'}*72],
202             );
203              
204             $self->{'NormalFont'}=$self->{'PDF'}->font(
205             'Basefont' => 'Helvetica'
206             );
207              
208             $self->{'BoldFont'}=$self->{'PDF'}->font(
209             'Basefont' => 'Helvetica-Bold'
210             );
211              
212              
213             $self->{'Pages'}=[];
214              
215             push(@{$self->{'Pages'}}, $self->{'rootpage'}->new_page());
216              
217             $self->{'CurrentLabel'}=0;
218              
219             return($self);
220             }
221              
222             sub close {
223             my $self = shift;
224             my %params = @_;
225              
226             $self->{'PDF'}->close();
227             }
228              
229             sub setlabel {
230             my $self = shift;
231             my $lnum = shift;
232              
233             my $maxlabel = ($self->{'Xlabels'} * $self->{'Ylabels'}) - 1;
234             if ($lnum > $maxlabel)
235             {
236             return(-1);
237             }
238             if ($lnum < $self->{'CurrentLabel'})
239             {
240             print "$lnum Requires new page ($self->{'CurrentLabel'})\n";
241             $self->newpage();
242             }
243             $self->{'CurrentLabel'}=$lnum;
244             return($lnum);
245             }
246              
247             sub label {
248             my $self = shift;
249              
250             my $lnum = $self->{'CurrentLabel'};
251             my $y = int($lnum/$self->{'Xlabels'});
252             my $x = $lnum%$self->{'Xlabels'};
253              
254             my $fn=$self->{'NormalFont'};
255             my $fb=$self->{'BoldFont'};
256              
257             my $fs=$self->{'FontSize'};
258             my $ls=$self->{'LineSpacing'};
259              
260             my $lw=($self->{'LabelWidth'}-$self->{'LabelXMargin'}*2) *72;
261             my $lh=($self->{'LabelHeight'}-$self->{'LabelYMargin'}) *72;
262             my $linecount=int($lh-($self->{'LabelYMargin'}*72))/$ls;
263              
264             my $X=($x*$self->{'LabelWidth'}+$self->{'LabelXMargin'}+
265             $self->{'Xoffset'})*72;
266             my $Y=(($self->{'Ylabels'}-$y-1)*$self->{'LabelHeight'}+
267             $self->{'LabelYMargin'}+$self->{'Yoffset'})*72;
268              
269             my $q;
270              
271             $q=0;
272             foreach(@_)
273             {
274             $q++;
275             next unless $linecount; # Skip lines beyond bottom of label.
276             # Should add code here to check width of test
277             ${$self->{'Pages'}}[scalar(@{$self->{'Pages'}})-1]->string(
278             $fn, $fs, $X, $Y+$linecount*$ls, $_);
279             $linecount--;
280             }
281             # ${$self->{'Pages'}}[scalar(@{$self->{'Pages'}})-1]->newpath();
282             # ${$self->{'Pages'}}[scalar(@{$self->{'Pages'}})-1]->rectangle(
283             # $X, $Y, $lw, $lh);
284             # ${$self->{'Pages'}}[scalar(@{$self->{'Pages'}})-1]->stroke();
285              
286             $self->{'CurrentLabel'}++;
287             if ($self->{'CurrentLabel'} >= $self->{'Xlabels'}*$self->{'Ylabels'})
288             {
289             $self->newpage();
290             $self->{'CurrentLabel'}=0;
291             }
292             return(1);
293             }
294              
295             sub newpage()
296             {
297             my $self = shift;
298              
299             push(@{$self->{'Pages'}}, $self->{'rootpage'}->new_page());
300             return(1);
301             }
302