File Coverage

blib/lib/Dpkg/Interface/Storable.pm
Criterion Covered Total %
statement 46 52 88.4
branch 14 26 53.8
condition 3 4 75.0
subroutine 9 9 100.0
pod 2 2 100.0
total 74 93 79.5


line stmt bran cond sub pod time code
1             # Copyright © 2010 Raphaël Hertzog
2             #
3             # This program is free software; you can redistribute it and/or modify
4             # it under the terms of the GNU General Public License as published by
5             # the Free Software Foundation; either version 2 of the License, or
6             # (at your option) any later version.
7             #
8             # This program is distributed in the hope that it will be useful,
9             # but WITHOUT ANY WARRANTY; without even the implied warranty of
10             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11             # GNU General Public License for more details.
12             #
13             # You should have received a copy of the GNU General Public License
14             # along with this program. If not, see .
15              
16             package Dpkg::Interface::Storable;
17              
18 18     18   79364 use strict;
  18         50  
  18         547  
19 18     18   93 use warnings;
  18         36  
  18         731  
20              
21             our $VERSION = '1.01';
22              
23 18     18   134 use Carp;
  18         40  
  18         1156  
24              
25 18     18   590 use Dpkg::Gettext;
  18         73  
  18         1065  
26 18     18   567 use Dpkg::ErrorHandling;
  18         42  
  18         1826  
27              
28             use overload
29 18         215 '""' => \&_stringify,
30 18     18   11270 'fallback' => 1;
  18         8977  
31              
32             =encoding utf8
33              
34             =head1 NAME
35              
36             Dpkg::Interface::Storable - common methods related to object serialization
37              
38             =head1 DESCRIPTION
39              
40             Dpkg::Interface::Storable is only meant to be used as parent
41             class for other classes. It provides common methods that are
42             all implemented on top of two basic methods parse() and output().
43              
44             =head1 BASE METHODS
45              
46             Those methods must be provided by the class that wish to inherit
47             from Dpkg::Interface::Storable so that the methods provided can work.
48              
49             =over 4
50              
51             =item $obj->parse($fh[, $desc])
52              
53             This methods initialize the object with the data stored in the
54             filehandle. $desc is optional and is a textual description of
55             the filehandle used in error messages.
56              
57             =item $string = $obj->output([$fh])
58              
59             This method returns a string representation of the object in $string
60             and it writes the same string to $fh (if it's defined).
61              
62             =back
63              
64             =head1 PROVIDED METHODS
65              
66             =over 4
67              
68             =item $obj->load($filename, %opts)
69              
70             Initialize the object with the data stored in the file. The file can be
71             compressed, it will be decompressed on the fly by using a
72             Dpkg::Compression::FileHandle object. If $opts{compression} is false the
73             decompression support will be disabled. If $filename is "-", then the
74             standard input is read (no compression is allowed in that case).
75              
76             =cut
77              
78             sub load {
79 111     111 1 752 my ($self, $file, %opts) = @_;
80 111   100     694 $opts{compression} //= 1;
81 111 50       694 unless ($self->can('parse')) {
82 0         0 croak ref($self) . ' cannot be loaded, it lacks the parse method';
83             }
84 111         331 my ($desc, $fh) = ($file, undef);
85 111 50       355 if ($file eq '-') {
86 0         0 $fh = \*STDIN;
87 0         0 $desc = g_('');
88             } else {
89 111 100       310 if ($opts{compression}) {
90 97         4231 require Dpkg::Compression::FileHandle;
91 97         855 $fh = Dpkg::Compression::FileHandle->new();
92             }
93 111 50       1122 open($fh, '<', $file) or syserr(g_('cannot read %s'), $file);
94             }
95 111         761 my $res = $self->parse($fh, $desc, %opts);
96 104 50       404 if ($file ne '-') {
97 104 50       560 close($fh) or syserr(g_('cannot close %s'), $file);
98             }
99 104         823 return $res;
100             }
101              
102             =item $obj->save($filename, %opts)
103              
104             Store the object in the file. If the filename ends with a known
105             compression extension, it will be compressed on the fly by using a
106             Dpkg::Compression::FileHandle object. If $opts{compression} is false the
107             compression support will be disabled. If $filename is "-", then the
108             standard output is used (data are written uncompressed in that case).
109              
110             =cut
111              
112             sub save {
113 6     6 1 5124 my ($self, $file, %opts) = @_;
114 6   50     76 $opts{compression} //= 1;
115 6 50       72 unless ($self->can('output')) {
116 0         0 croak ref($self) . ' cannot be saved, it lacks the output method';
117             }
118 6         32 my $fh;
119 6 50       28 if ($file eq '-') {
120 0         0 $fh = \*STDOUT;
121             } else {
122 6 50       36 if ($opts{compression}) {
123 6         2008 require Dpkg::Compression::FileHandle;
124 6         50 $fh = Dpkg::Compression::FileHandle->new();
125             }
126 6 50       28 open($fh, '>', $file) or syserr(g_('cannot write %s'), $file);
127             }
128 6         58 $self->output($fh, %opts);
129 6 50       40 if ($file ne '-') {
130 6 50       32 close($fh) or syserr(g_('cannot close %s'), $file);
131             }
132             }
133              
134             =item "$obj"
135              
136             Return a string representation of the object.
137              
138             =cut
139              
140             sub _stringify {
141 57     57   4218 my $self = shift;
142 57 50       473 unless ($self->can('output')) {
143 0         0 croak ref($self) . ' cannot be stringified, it lacks the output method';
144             }
145 57         211 return $self->output();
146             }
147              
148             =back
149              
150             =head1 CHANGES
151              
152             =head2 Version 1.01 (dpkg 1.19.0)
153              
154             New options: The $obj->load() and $obj->save() methods support a new
155             compression option.
156              
157             =head2 Version 1.00 (dpkg 1.15.6)
158              
159             Mark the module as public.
160              
161             =cut
162              
163             1;