Storable.pm 3.7 KB

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