# File: Stem/Codec/.pm # This file is part of Stem. # Copyright (C) 1999, 2000, 2001 Stem Systems, Inc. # Stem is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # Stem is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # You should have received a copy of the GNU General Public License # along with Stem; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # For a license to use the Stem under conditions other than those # described here, to purchase support for this software, or to purchase a # commercial warranty contract, please contact Stem Systems at: # Stem Systems, Inc. 781-643-7504 # 79 Everett St. info@stemsystems.com # Arlington, MA 02474 # USA package Stem::Codec ; use strict ; use Stem::Class ; my $attr_spec = [ { 'name' => 'codec', 'default' => 'Data::Dumper', 'help' => < 'object', 'type' => 'object', 'help' => < 'encode_method', 'default' => 'encoded_data', 'help' => < 'decode_method', 'default' => 'decoded_data', 'help' => < =over 4 =item Description: If an object is passed in, the filter will use it for callbacks =item Its B is: object =back =item * Attribute - B =over 4 =item It B to: encoded_data =back =item * Attribute - B =over 4 =item It B to: decoded_data =back =back =cut # End of autogenerated POD ########### my %loaded_codecs ; sub new { my( $class ) = shift ; my $self = Stem::Class::parse_args( $attr_spec, @_ ) ; return $self unless ref $self ; my $err = $self->load_codec() ; return $err if $err ; return $self ; } sub load_codec { my( $self ) = @_ ; my $codec = $self->{codec} ; return if $loaded_codecs{ $codec } ; my $codec_class = "Stem::Codec::$codec" ; eval "require $codec_class" ; return "Can't load Stem codec '$codec_class' $@" if $@ ; $loaded_codecs{ $codec } = { encoder => $codec_class->make_encoder(), decoder => $codec_class->make_decoder(), } ; return ; } sub encode { my $self = shift ; return unless @_ ; my $encoder = $loaded_codecs{ $self->{codec} }{encoder} ; # make sure scalars and scalar refs have a ref taken to them as codecs # always take a ref. we do ref on scalar refs so we can tell at decode # time that REF is a scalar ref but SCALAR is a plain scalar #print "IN $_[0] REF ", ref $_[0], "\n" ; my $data_ref = ( ! ref $_[0] || ref $_[0] eq 'SCALAR' ) ? \$_[0] : $_[0] ; #print "DATA REF $data_ref\n" ; my $encoded_text = $encoder->( $data_ref ) ; if ( my $obj = $self->{'object'} ) { my $method = $self->{'encode_method'} ; $obj->$method( $encoded_text ) ; } return $encoded_text ; } sub decode { my $self = shift ; my $decoder = $loaded_codecs{ $self->{codec} }{decoder} ; my $decoded_data = $decoder->( $_[0] ) ; $decoded_data = ${$decoded_data} if ref $decoded_data eq 'SCALAR' || ref $decoded_data eq 'REF' ; if ( my $obj = $self->{'object'} ) { my $method = $self->{'decode_method'} ; $obj->$method( $decoded_data ) ; } return( $decoded_data ) ; } 1 ;