releasing/cbrtools/perl/MLDBM/Serializer/Data/Dumper.pm
changeset 602 3145852acc89
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/releasing/cbrtools/perl/MLDBM/Serializer/Data/Dumper.pm	Fri Jun 25 18:37:20 2010 +0800
@@ -0,0 +1,88 @@
+# Copyright (c) 1995-98 Gurusamy Sarathy.  All rights reserved.
+#
+# Copyright (c) 1998 Raphael Manfredi.
+# 
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package MLDBM::Serializer::Data::Dumper;
+BEGIN { @MLDBM::Serializer::Data::Dumper::ISA = qw(MLDBM::Serializer) }
+
+use Data::Dumper '2.08';		# Backward compatibility
+use Carp;
+
+#
+# Create a Data::Dumper serializer object.
+#
+sub new {
+    my $self = shift->SUPER::new();
+    my $meth = shift || "";
+    $meth = (defined(&Data::Dumper::Dumpxs) ? 'Dumpxs' : 'Dump')
+      unless $meth =~ /^Dump(xs)?$/;
+    $self->DumpMeth($meth);
+    $self->RemoveTaint(shift);
+    $self->Key(shift);
+    $self;
+}
+
+#
+# Serialize $val if it is a reference, or if it does begin with our magic
+# key string, since then at retrieval time we expect a Data::Dumper string.
+# Otherwise, return the scalar value.
+#
+sub serialize {
+    my $self = shift;
+    my ($val) = @_;
+    return undef unless defined $val;
+    return $val unless ref($val) or $val =~ m|^\Q$self->{'key'}|o;
+    my $dumpmeth = $self->{'dumpmeth'};
+    local $Data::Dumper::Indent = 0;
+    local $Data::Dumper::Purity = 1;
+    local $Data::Dumper::Terse = 1;
+    return $self->{'key'} . Data::Dumper->$dumpmeth([$val], ['M']);
+}
+
+#
+# If the value is undefined or does not begin with our magic key string,
+# return it as-is. Otherwise, we need to recover the underlying data structure.
+#
+sub deserialize {
+    my $self = shift;
+    my ($val) = @_;
+    return undef unless defined $val;
+    return $val unless $val =~ s|^\Q$self->{'key'}||o;
+    my $M = "";
+    ($val) = $val =~ /^(.*)$/s if $self->{'removetaint'};
+    # Disambiguate hashref (perl may treat it as a block)
+    my $N = eval($val =~ /^\{/ ? '+'.$val : $val);
+    return $M ? $M : $N unless $@;
+    carp "MLDBM error: $@\twhile evaluating:\n $val";
+}
+
+sub DumpMeth	{ my $s = shift; $s->_attrib('dumpmeth', @_); }
+sub RemoveTaint	{ my $s = shift; $s->_attrib('removetaint', @_); }
+sub Key		{ my $s = shift; $s->_attrib('key', @_); }
+
+# avoid used only once warnings
+{
+    local $Data::Dumper::Terse;
+}
+
+1;
+__END__
+
+=head1 AUTHORS
+
+Gurusamy Sarathy <F<gsar@umich.edu>>.
+
+Support for multiple serializing packages by
+Raphael Manfredi <F<Raphael_Manfredi@grenoble.hp.com>>.
+
+Copyright (c) 1995-98 Gurusamy Sarathy.  All rights reserved.
+
+Copyright (c) 1998 Raphael Manfredi.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=cut