Commit | Line | Data |
4536f655 |
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 ; |