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   80540 use strict;
  18         54  
  18         546  
19 18     18   91 use warnings;
  18         36  
  18         680  
20              
21             our $VERSION = '1.01';
22              
23 18     18   101 use Carp;
  18         35  
  18         1119  
24              
25 18     18   535 use Dpkg::Gettext;
  18         32  
  18         1015  
26 18     18   526 use Dpkg::ErrorHandling;
  18         39  
  18         1718  
27              
28             use overload
29 18         154 '""' => \&_stringify,
30 18     18   10465 'fallback' => 1;
  18         8459  
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 571 my ($self, $file, %opts) = @_;
80 111   100     596 $opts{compression} //= 1;
81 111 50       582 unless ($self->can('parse')) {
82 0         0 croak ref($self) . ' cannot be loaded, it lacks the parse method';
83             }
84 111         298 my ($desc, $fh) = ($file, undef);
85 111 50       338 if ($file eq '-') {
86 0         0 $fh = \*STDIN;
87 0         0 $desc = g_('');
88             } else {
89 111 100       331 if ($opts{compression}) {
90 97         3999 require Dpkg::Compression::FileHandle;
91 97         773 $fh = Dpkg::Compression::FileHandle->new();
92             }
93 111 50       1042 open($fh, '<', $file) or syserr(g_('cannot read %s'), $file);
94             }
95 111         744 my $res = $self->parse($fh, $desc, %opts);
96 104 50       430 if ($file ne '-') {
97 104 50       545 close($fh) or syserr(g_('cannot close %s'), $file);
98             }
99 104         788 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 30742 my ($self, $file, %opts) = @_;
114 6   50     112 $opts{compression} //= 1;
115 6 50       90 unless ($self->can('output')) {
116 0         0 croak ref($self) . ' cannot be saved, it lacks the output method';
117             }
118 6         14 my $fh;
119 6 50       42 if ($file eq '-') {
120 0         0 $fh = \*STDOUT;
121             } else {
122 6 50       34 if ($opts{compression}) {
123 6         2422 require Dpkg::Compression::FileHandle;
124 6         74 $fh = Dpkg::Compression::FileHandle->new();
125             }
126 6 50       40 open($fh, '>', $file) or syserr(g_('cannot write %s'), $file);
127             }
128 6         84 $self->output($fh, %opts);
129 6 50       34 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   3686 my $self = shift;
142 57 50       394 unless ($self->can('output')) {
143 0         0 croak ref($self) . ' cannot be stringified, it lacks the output method';
144             }
145 57         221 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;