scripts/Dpkg/Interface/Storable.pm

   1 # Copyright © 2010 Raphaël Hertzog <hertzog@debian.org>
   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 <https://www.gnu.org/licenses/>.
  15
  16 =encoding utf8
  17
  18 =head1 NAME
  19
  20 Dpkg::Interface::Storable - common methods related to object serialization
  21
  22 =head1 DESCRIPTION
  23
  24 Dpkg::Interface::Storable is only meant to be used as parent
  25 class for other classes. It provides common methods that are
  26 all implemented on top of two basic methods parse() and output().
  27
  28 =cut
  29
  30 package Dpkg::Interface::Storable 1.01;
  31
  32 use strict;
  33 use warnings;
  34
  35 use Carp;
  36
  37 use Dpkg::Gettext;
  38 use Dpkg::ErrorHandling;
  39
  40 use overload
  41     '""' => \&_stringify,
  42     'fallback' => 1;
  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 L<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     my ($self, $file, %opts) = @_;
  80     $opts{compression} //= 1;
  81     unless ($self->can('parse')) {
  82         croak ref($self) . ' cannot be loaded, it lacks the parse method';
  83     }
  84     my ($desc, $fh) = ($file, undef);
  85     if ($file eq '-') {
  86         $fh = \*STDIN;
  87         $desc = g_('<standard input>');
  88     } else {
  89         if ($opts{compression}) {
  90             require Dpkg::Compression::FileHandle;
  91             $fh = Dpkg::Compression::FileHandle->new();
  92         }
  93         open($fh, '<', $file) or syserr(g_('cannot read %s'), $file);
  94     }
  95     my $res = $self->parse($fh, $desc, %opts);
  96     if ($file ne '-') {
  97         close($fh) or syserr(g_('cannot close %s'), $file);
  98     }
  99     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 L<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     my ($self, $file, %opts) = @_;
 114     $opts{compression} //= 1;
 115     unless ($self->can('output')) {
 116         croak ref($self) . ' cannot be saved, it lacks the output method';
 117     }
 118     my $fh;
 119     if ($file eq '-') {
 120         $fh = \*STDOUT;
 121     } else {
 122         if ($opts{compression}) {
 123             require Dpkg::Compression::FileHandle;
 124             $fh = Dpkg::Compression::FileHandle->new();
 125         }
 126         open($fh, '>', $file) or syserr(g_('cannot write %s'), $file);
 127     }
 128     $self->output($fh, %opts);
 129     if ($file ne '-') {
 130         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     my $self = shift;
 142     unless ($self->can('output')) {
 143         croak ref($self) . ' cannot be stringified, it lacks the output method';
 144     }
 145     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;