Storable.pm 3.7 KB

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