chiark - git - mdw - dpkg/blob - 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 package Dpkg::Interface::Storable;
  17
  18 use strict;
  19 use warnings;
  20
  21 our $VERSION = '1.00';
  22
  23 use Carp;
  24
  25 use Dpkg::Gettext;
  26 use Dpkg::ErrorHandling;
  27 use Dpkg::Compression::FileHandle;
  28
  29 use overload
  30     '""' => \&_stringify,
  31     'fallback' => 1;
  32
  33 =encoding utf8
  34
  35 =head1 NAME
  36
  37 Dpkg::Interface::Storable - common methods related to object serialization
  38
  39 =head1 DESCRIPTION
  40
  41 Dpkg::Interface::Storable is only meant to be used as parent
  42 class for other objects. It provides common methods that are
  43 all implemented on top of two basic methods parse() and output().
  44
  45 =head1 BASE METHODS
  46
  47 Those methods must be provided by the object that wish to inherit
  48 from Dpkg::Interface::Storable so that the methods provided can work.
  49
  50 =over 4
  51
  52 =item $obj->parse($fh, $desc)
  53
  54 This methods initialize the object with the data stored in the
  55 filehandle. $desc is optional and is a textual description of
  56 the filehandle used in error messages.
  57
  58 =item $string = $obj->output($fh)
  59
  60 This method returns a string representation of the object in $string
  61 and it writes the same string to $fh (if it's defined).
  62
  63 =back
  64
  65 =head1 PROVIDED METHODS
  66
  67 =over 4
  68
  69 =item $obj->load($filename)
  70
  71 Initialize the object with the data stored in the file. The file can be
  72 compressed, it will be uncompressed on the fly by using a
  73 Dpkg::Compression::FileHandle object. 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, @options) = @_;
  80     unless ($self->can('parse')) {
  81         croak ref($self) . ' cannot be loaded, it lacks the parse method';
  82     }
  83     my ($desc, $fh) = ($file, undef);
  84     if ($file eq '-') {
  85         $fh = \*STDIN;
  86         $desc = g_('<standard input>');
  87     } else {
  88         $fh = Dpkg::Compression::FileHandle->new();
  89         open($fh, '<', $file) or syserr(g_('cannot read %s'), $file);
  90     }
  91     my $res = $self->parse($fh, $desc, @options);
  92     if ($file ne '-') {
  93         close($fh) or syserr(g_('cannot close %s'), $file);
  94     }
  95     return $res;
  96 }
  97
  98 =item $obj->save($filename)
  99
 100 Store the object in the file. If the filename ends with a known
 101 compression extension, it will be compressed on the fly by using a
 102 Dpkg::Compression::FileHandle object. If $filename is "-", then the
 103 standard output is used (data are written uncompressed in that case).
 104
 105 =cut
 106
 107 sub save {
 108     my ($self, $file, @options) = @_;
 109     unless ($self->can('output')) {
 110         croak ref($self) . ' cannot be saved, it lacks the output method';
 111     }
 112     my $fh;
 113     if ($file eq '-') {
 114         $fh = \*STDOUT;
 115     } else {
 116         $fh = Dpkg::Compression::FileHandle->new();
 117         open($fh, '>', $file) or syserr(g_('cannot write %s'), $file);
 118     }
 119     $self->output($fh, @options);
 120     if ($file ne '-') {
 121         close($fh) or syserr(g_('cannot close %s'), $file);
 122     }
 123 }
 124
 125 =item "$obj"
 126
 127 Return a string representation of the object.
 128
 129 =cut
 130
 131 sub _stringify {
 132     my $self = shift;
 133     unless ($self->can('output')) {
 134         croak ref($self) . ' cannot be stringified, it lacks the output method';
 135     }
 136     return $self->output();
 137 }
 138
 139 =back
 140
 141 =head1 CHANGES
 142
 143 =head2 Version 1.00 (dpkg 1.15.6)
 144
 145 Mark the module as public.
 146
 147 =cut
 148
 149 1;