releasing/cbrtools/perl/MLDBM/Serializer/Storable.pm
author lorewang
Wed, 01 Dec 2010 16:05:36 +0800
changeset 715 e0739b8406dd
parent 602 3145852acc89
permissions -rw-r--r--
Specify extenal tool with path
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
602
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     1
# Copyright (c) 1995-98 Gurusamy Sarathy.  All rights reserved.
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     2
#
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     3
# Copyright (c) 1998 Raphael Manfredi.
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     4
#
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     5
# This program is free software; you can redistribute it and/or
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     6
# modify it under the same terms as Perl itself.
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     7
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     8
package MLDBM::Serializer::Storable;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     9
BEGIN { @MLDBM::Serializer::Storable::ISA = qw(MLDBM::Serializer) }
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    10
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    11
use Storable;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    12
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    13
sub new {
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    14
    my $self = shift->SUPER::new();
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    15
    $self->DumpMeth(shift);
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    16
    # Storable doesn't honor other attributes
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    17
    $self;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    18
}
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    19
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    20
#
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    21
# Serialize a reference to supplied value
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    22
#
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    23
sub serialize {
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    24
    my $self = shift;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    25
    my $dumpmeth = $self->{'_dumpsub_'};
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    26
    &$dumpmeth(\$_[0]);
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    27
}
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    28
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    29
#
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    30
# Deserialize and de-reference
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    31
#
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    32
sub deserialize {
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    33
    my $obj = Storable::thaw($_[1]);		# Does not care whether portable
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    34
    defined($obj) ? $$obj : undef;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    35
}
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    36
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    37
#
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    38
# Change dump method when portability is requested
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    39
#
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    40
sub DumpMeth {
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    41
    my $self = shift;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    42
    $self->{'_dumpsub_'} = 
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    43
      ($_[0] && $_[0] eq 'portable' ? \&Storable::nfreeze : \&Storable::freeze);
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    44
    $self->_attrib('dumpmeth', @_);
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    45
}
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    46
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    47
1;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    48
__END__
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    49
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    50
=head1 AUTHORS
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    51
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    52
Gurusamy Sarathy <F<gsar@umich.edu>>.
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    53
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    54
Support for multiple serializing packages by
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    55
Raphael Manfredi <F<Raphael_Manfredi@grenoble.hp.com>>.
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    56
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    57
Copyright (c) 1995-98 Gurusamy Sarathy.  All rights reserved.
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    58
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    59
Copyright (c) 1998 Raphael Manfredi.
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    60
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    61
This program is free software; you can redistribute it and/or
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    62
modify it under the same terms as Perl itself.
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    63
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    64
=cut