lib/Stem/Codec.pm

   1 #  File: Stem/Codec/.pm
   2
   3 #  This file is part of Stem.
   4 #  Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
   5
   6 #  Stem is free software; you can redistribute it and/or modify
   7 #  it under the terms of the GNU General Public License as published by
   8 #  the Free Software Foundation; either version 2 of the License, or
   9 #  (at your option) any later version.
  10
  11 #  Stem is distributed in the hope that it will be useful,
  12 #  but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 #  GNU General Public License for more details.
  15
  16 #  You should have received a copy of the GNU General Public License
  17 #  along with Stem; if not, write to the Free Software
  18 #  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  19
  20 #  For a license to use the Stem under conditions other than those
  21 #  described here, to purchase support for this software, or to purchase a
  22 #  commercial warranty contract, please contact Stem Systems at:
  23
  24 #       Stem Systems, Inc.              781-643-7504
  25 #       79 Everett St.                  info@stemsystems.com
  26 #       Arlington, MA 02474
  27 #       USA
  28
  29 package Stem::Codec ;
  30
  31 use strict ;
  32
  33 use Stem::Class ;
  34
  35 my $attr_spec = [
  36
  37         {
  38                 'name'          => 'codec',
  39                 'default'       => 'Data::Dumper',
  40                 'help'          => <<HELP,
  41 This is the name of the Codec:: subclass that will be used in this cell
  42 HELP
  43         },
  44         {
  45                 'name'          => 'object',
  46                 'type'          => 'object',
  47                 'help'          => <<HELP,
  48 If an object is passed in, the filter will use it for callbacks
  49 HELP
  50         },
  51
  52         {
  53                 'name'          => 'encode_method',
  54                 'default'       => 'encoded_data',
  55                 'help'          => <<HELP,
  56 HELP
  57         },
  58
  59         {
  60                 'name'          => 'decode_method',
  61                 'default'       => 'decoded_data',
  62                 'help'          => <<HELP,
  63 HELP
  64         },
  65
  66 ] ;
  67
  68
  69 ###########
  70 # This POD section is autoegenerated. Any edits to it will be lost.
  71
  72 =head2 Constructor Attributes for Class Stem::Codec::Data::Dumper
  73
  74 =over 4
  75
  76
  77 =item * Attribute - B<object>
  78
  79 =over 4
  80
  81
  82 =item Description:
  83 If an object is passed in, the filter will use it for callbacks
  84
  85
  86 =item Its B<type> is: object
  87
  88 =back
  89
  90 =item * Attribute - B<encode_method>
  91
  92 =over 4
  93
  94
  95 =item It B<defaults> to: encoded_data
  96
  97 =back
  98
  99 =item * Attribute - B<decode_method>
 100
 101 =over 4
 102
 103
 104 =item It B<defaults> to: decoded_data
 105
 106 =back
 107
 108 =back
 109
 110 =cut
 111
 112 # End of autogenerated POD
 113 ###########
 114
 115 my %loaded_codecs ;
 116
 117 sub new {
 118
 119         my( $class ) = shift ;
 120
 121         my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
 122         return $self unless ref $self ;
 123
 124         my $err = $self->load_codec() ;
 125         return $err if $err ;
 126
 127         return $self ;
 128 }
 129
 130 sub load_codec {
 131
 132         my( $self ) = @_ ;
 133
 134         my $codec = $self->{codec} ;
 135
 136         return if $loaded_codecs{ $codec } ;
 137
 138         my $codec_class = "Stem::Codec::$codec" ;
 139
 140         eval "require $codec_class" ;
 141
 142         return "Can't load Stem codec '$codec_class' $@" if $@ ;
 143
 144         $loaded_codecs{ $codec } = {
 145
 146                 encoder => $codec_class->make_encoder(),
 147                 decoder => $codec_class->make_decoder(),
 148         } ;
 149
 150         return ;
 151 }
 152
 153 sub encode {
 154
 155         my $self = shift ;
 156
 157         return unless @_ ;
 158
 159         my $encoder = $loaded_codecs{ $self->{codec} }{encoder} ;
 160
 161 # make sure scalars and scalar refs have a ref taken to them as codecs
 162 # always take a ref. we do ref on scalar refs so we can tell at decode
 163 # time that REF is a scalar ref but SCALAR is a plain scalar
 164
 165 #print "IN $_[0] REF ", ref $_[0], "\n" ;
 166
 167         my $data_ref = ( ! ref $_[0] || ref $_[0] eq 'SCALAR' ) ?
 168                 \$_[0] : $_[0] ;
 169
 170 #print "DATA REF $data_ref\n" ;
 171
 172         my $encoded_text = $encoder->( $data_ref ) ;
 173
 174         if ( my $obj = $self->{'object'} ) {
 175
 176                 my $method = $self->{'encode_method'} ;
 177                 $obj->$method( $encoded_text ) ;
 178         }
 179
 180         return $encoded_text ;
 181 }
 182
 183 sub decode {
 184
 185         my $self = shift ;
 186
 187         my $decoder = $loaded_codecs{ $self->{codec} }{decoder} ;
 188
 189         my $decoded_data = $decoder->( $_[0] ) ;
 190
 191         $decoded_data = ${$decoded_data} if
 192                 ref $decoded_data eq 'SCALAR' ||
 193                 ref $decoded_data eq 'REF' ;
 194
 195         if ( my $obj = $self->{'object'} ) {
 196
 197                 my $method = $self->{'decode_method'} ;
 198                 $obj->$method( $decoded_data ) ;
 199         }
 200
 201         return( $decoded_data ) ;
 202 }
 203
 204 1 ;