File Coverage

blib/lib/Paper/Specs.pm
Criterion Covered Total %
statement 8 50 16.0
branch 0 36 0.0
condition 0 17 0.0
subroutine 3 9 33.3
pod 6 6 100.0
total 17 118 14.4


line stmt bran cond sub pod time code
1              
2             package Paper::Specs;
3 1     1   1177 use strict;
  1         2  
  1         40  
4 1     1   4 use vars qw($VERSION %brands $brand $units $layout %units $strict $debug);
  1         1  
  1         908  
5              
6             $VERSION='0.10';
7              
8             $units = 'in';
9             $layout = 'normal';
10             $brand = '';
11             $strict = 1;
12             $debug = 0;
13              
14             =head1 NAME
15              
16             Paper::Specs - Size and layout information for paper stock, forms, and labels.
17              
18             =head1 SYNOPSIS
19              
20             use Paper::Specs units => 'cm';
21             my $form = Paper::Specs->find( brand => 'Avery', code => '1234');
22              
23             use Paper::Specs units => 'cm', brand => 'Avery';
24             my $form = Paper::Specs->find( code => '1234');
25              
26             # location of first label on sheet
27             my ($xpos, $ypos) = $form->label_location( 1, 1);
28             my ($h, $w) = $form->label_size;
29              
30             =head1 IMPORTANT NOTES
31              
32             I appologise in advance for the hasty nature of this code. I want to
33             get it out to support some other code I am writing. I promise to revisit
34             it shortly to clear up the rough patches - however your valuable input
35             is most welcome.
36              
37             CAVEAT ALPHA CODE - This is a preliminary module and will be subject to
38             fluctuations in API and structure based on feedback from users.
39              
40             I expect that there will be some interest in this code and it should
41             firm up quickly.
42              
43             If this module does not deliver what you are looking for then you
44             are encouraged to contact the author and voice your needs!
45              
46             OTHER LABELS - I know about the Labels.xml file which is part of OpenOffice
47             but have not figured out how it is encoded. I have the gLabels specifications
48             file too. I plan to use these to help populate the data for this module.
49              
50             =head1 Paper::Specs methods
51              
52             =over
53              
54             =item Import options
55              
56             You can supply any of the methods for this class when it is imported:
57              
58             use Paper::Specs
59             strict => 1,
60             units => 'cm';
61              
62             =cut
63              
64             sub import {
65              
66 1     1   9 my $class=shift;
67              
68 1         12 while ( @_ ) {
69 0           my ($arg, $val) = (shift, shift);
70 0 0         $class->$arg($val) if UNIVERSAL::can( $class, $arg);
71             }
72              
73             }
74              
75             =item @forms = Paper::Specs->find( criteria )
76              
77             Returns a list of forms that matches the criteria. There are
78             two fields for criteria: brand and code. The brand can be set
79             for the class via the Paper::Specs->brand method.
80              
81             You must supply at least a brand or a code to find. If no
82             brand is supplied then all known brands will be searched.
83              
84             If you set the module to strict, its default, the find must
85             return extactly zero or one forms as a scalar. Otherwise
86             it will throw an exception.
87              
88             See the beginning of this module for examples of finds.
89              
90             =cut
91              
92             sub find {
93              
94 0     0 1   my $self = shift;
95 0 0         my $class = ref($self) ? ref($self) : $self;
96              
97              
98 0           my %opts = @_;
99 0   0       my $brand = $opts{'brand'} || $brand;
100 0           my $code = $opts{'code'};
101              
102 0 0 0       die "We need a code or a brand to search for\n" unless $code || $brand;
103              
104 0           my @found=();
105 0   0       foreach my $brand ( ($brand || $self->brands) ) {
106              
107 0           my $sclass = "${class}::${brand}";
108 0           eval "use $sclass";
109             # skip ones that do not load - lame but effective for now
110 0 0         if ($Paper::Specs::debug) {
111 0 0         warn $@ if $@;
112             }
113 0 0         next if $@;
114              
115 0           push @found, $sclass->find( $code );
116              
117             }
118              
119 0 0         if ($self->strict) {
120              
121 0 0 0       if (@found && scalar(@found) == 1) {
122 0           return $found[0];
123             }
124              
125 0 0         if (@found) {
126 0           die 'More than one form matches and $self is in strict mode\n';
127             }
128              
129 0           return ();
130              
131             } else {
132 0 0         return wantarray ? @found : \@found;
133             }
134              
135             }
136              
137             # Nice to snoop the lib for all installed Paper modules
138             # next iteration of code, this is good enough for now
139             %brands=(
140             'standard' => 1,
141             #'APLI' => 1,
142             #'Agipa' => 1,
143             #'Alpi' => 1,
144             #'Ascom' => 1,
145             'Avery' => 1,
146             #'DataBecker' => 1,
147             #'Ednet' => 1,
148             #'Epson' => 1,
149             #'Great Gizmos' => 1,
150             #'Herlitz' => 1,
151             #'Herma' => 1,
152             #'Imation-SoniX' => 1,
153             #'LeLabel' => 1,
154             #'Leitz' => 1,
155             #'Memorex' => 1,
156             #'Meritline' => 1,
157             #'Neato' => 1,
158             #'Sigel' => 1,
159             #'Southworth' => 1,
160             #'Stomper' => 1,
161             #'Zweckform' => 1,
162             #'unknown' => 1,
163             'photo' => 1,
164             );
165              
166             =item @brands = Paper::Specs->brands
167              
168             Returns a list or reference to a list of the brands for the paper forms that
169             this module is aware of. One brand, 'standard' is reserved for well known paper
170             formats such as letter, A4, etc.
171              
172             =cut
173              
174             sub brands {
175              
176 0 0   0 1   return wantarray ? ( keys %brands ) : [ keys %brands ];
177              
178             }
179              
180             =item $new_value = Paper::Specs->convert( value, units )
181              
182             Converts 'value' which is in 'units' to new value which is in Paper::Specs->units units.
183              
184             =cut
185              
186             sub convert {
187              
188 0     0 1   my $value = shift;
189 0   0       my $src_units = shift || 'in';
190              
191 0           return $value / $units{$src_units} * $units{$units};
192              
193             }
194              
195             %units = (
196             'in' => 1,
197             'cm' => 2.54,
198             'mm' => 25.4,
199             'pt' => 72,
200             );
201              
202             =item $units = Paper::Specs->units( units )
203              
204             Gets/sets the units that you wish to work with in your code. If you are
205             using metric then you might want 'mm' or 'cm'. If you are using empirial
206             then you might want 'in' or 'pt' (points = 1/72 in).
207              
208             Current units supported are: in, cm, mm, and pt.
209              
210             =cut
211              
212             sub units {
213              
214 0     0 1   my $self=shift;
215              
216 0 0         if (@_) {
217 0 0         $units = shift if exists $units{$_[0]};
218             }
219              
220 0           return $units;
221              
222             }
223              
224             =item Paper::Specs->layout( 'normal' | 'pdf' )
225              
226             This sets the co-ordinate system for some forms such as labels. 'normal' puts
227             (0,0) at the top left corner. 'pdf' puts (0,0) at the lower left corner.
228              
229             As well 'pdf' calls units('pt'). You can reset this afterwards if you are working
230             in a different unit system.
231              
232             =cut
233              
234              
235             sub layout {
236              
237 0     0 1   my $self=shift;
238              
239 0 0         if (@_) {
240 0           $layout = lc shift;
241 0 0 0       $layout = 'normal' unless $layout eq 'normal' || $layout eq 'pdf';
242 0 0         if ( $layout eq 'pdf' ) {
243 0           $self->units('pt');
244             }
245             }
246              
247 0           return $layout;
248              
249             }
250              
251             =item Paper::Specs->strict( 0 | 1 )
252              
253             Sets the strictness of this module. If it is strict then it will throw exceptions via 'die' for things
254             like finding more than one form on a find method.
255              
256             The default is to be strict.
257              
258             =cut
259              
260             sub strict {
261              
262 0     0 1   my $self=shift;
263 0 0         if (@_) {
264 0 0         $strict = $_[0] ? 1 : 0;
265             }
266 0           return $strict;
267              
268             }
269              
270             =back
271              
272             =head1 Paper::Specs items
273              
274             You get little object references back when you find specifications. These
275             objects can supply you with information that you are looking for but do not
276             actually store any values.
277              
278             You should test that the object is of the type you are looking for
279              
280             if ($form->type ne 'label') {
281             die "Feed me labels Seymore\n";
282             }
283              
284             Other than that - most forms should be based on a sheet (of paper) but will have
285             different methods depending on what they are.
286              
287             =head1 Paper::Specs::sheet methods / $form->type eq 'sheet'
288              
289             These methods apply forms of type 'sheet' and all that are derived from it. (all other forms and stock)
290              
291             =over 4
292              
293             =item ($h, $w) = $form->sheet_size
294              
295             Returns the height and width of your sheet.
296              
297             =item $size = $form->sheet_width
298              
299             Width of the stock
300              
301             =item $size = $form->sheet_height
302              
303             Height of the stock
304              
305             =back
306              
307             =head1 Paper::Specs::label methods / $form->type eq 'label'
308              
309             These methods apply to forms of type 'label' and all that are derived from it.
310              
311             Inherits methods from Paper::Specs::sheet.
312              
313             =over 4
314              
315             =item ( $width, $height ) = $form->label_size
316              
317             Returns just that; a list with the width and height of a label in it
318              
319             =item ( $x, $y ) = $form->label_location( $r, $c )
320              
321             Returns the location of the upper left corner for label at row $r and col $c
322             based on your current format/co-ordinate system.
323              
324             =item $size = $form->margin_left
325              
326             Space between left edge of paper and first column of labels.
327              
328             =item $size = $form->margin_right
329              
330             Space between right edge of paper and last column of labels.
331              
332             =item $size = $form->margin_top
333              
334             Space between top edge of paper and first row of labels.
335              
336             =item $size = $form->margin_bottom
337              
338             Space between bottom edge of paper and last row of labels.
339              
340             =item $size = $form->label_height
341              
342             Height of one label
343              
344             =item $size = $form->label_width
345              
346             Width of one label
347              
348             =item $count = label_rows
349              
350             Number of rows of labels on a sheet
351              
352             =item $count = label_cols
353              
354             Number of columns of labels on a sheet
355              
356             =item $size = $form->gutter_cols
357              
358             Inner space between labels - column gutter.
359              
360             =item $size = $form->gutter_rows
361              
362             Inner space between labels - row gutter.
363              
364             =back
365              
366             =head1 SEE ALSO
367              
368             Paper::Specs homepage - L
369              
370             =head1 BUGS
371              
372             Please report your bugs and suggestions for improvement to .
373              
374             =head1 AUTHORS
375              
376             Originally written by Jay Lawrence
377              
378             From version 0.06 onwards this module is maintained by Jon Allen (JJ) / L
379              
380             =head1 COPYRIGHT and LICENCE
381              
382             Copyright (c)2001-2003 - Jay Lawrence, Infonium Inc. All rights reserved.
383              
384             Modifications from version 0.06 onwards Copyright (c) 2004-2005 Jon Allen (JJ).
385              
386             This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
387              
388             Software distributed on an 'AS IS' basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. This software
389             is not affiliated with the Apache Software Foundation (ASF).
390              
391             =cut
392              
393             1;