#!/usr/bin/perl -w
#
# $Id: String.pm,v 1.1.1.1 2003/10/28 16:04:38 andy Exp $
#
# This code is copyright 1999-2000 by Scott Guelich <scott@scripted.com>
# and is distributed according to the same conditions as Perl itself
# Please visit http://www.scripted.com/wddx/ for more information
#
package WDDX::String;
# Auto-inserted by build scripts
$VERSION = "1.01";
use strict;
use Carp;
require WDDX;
{ my $i_hate_the_w_flag_sometimes = [
$WDDX::PACKET_HEADER,
$WDDX::PACKET_FOOTER,
$WDDX::String::VERSION
] }
1;
#/-----------------------------------------------------------------------
# Public Methods
#
sub new {
my( $class, $value ) = @_;
croak "You must supply a value when creating a new $class object\n"
unless defined $value;
croak "WDDX strings may not contain null characters (\\0)\n"
if $value =~ /\0/;
my $self = {
value => $value,
};
bless $self, $class;
return $self;
}
sub type {
return "string";
}
sub as_packet {
my( $self ) = @_;
my $output = $WDDX::PACKET_HEADER .
$self->_serialize .
$WDDX::PACKET_FOOTER;
}
sub as_scalar {
my( $self ) = @_;
return $self->_deserialize;
}
sub as_javascript {
my( $self, $js_var ) = @_;
local $_ = $self->{value};
# Escape for JavaScript... forget anything?
s/\\/\\\\/g;
s/\n/\\n/g;
s/\r/\\r/g;
s/\t/\\t/g;
s/"/\\"/g;
return "$js_var=\"$_\";";
}
#/-----------------------------------------------------------------------
# Private Methods
#
sub is_parser {
return 0;
}
sub _serialize {
my( $self ) = @_;
my $val = $self->xml_encode;
my $output = "<string>$val</string>";
return $output;
}
sub _deserialize {
my( $self ) = @_;
return $self->{value};
}
sub xml_encode {
my $self = shift;
local $_ = $self->{value};
s/&/&/g;
s/</</g;
s/>/>/g;
s/'/'/g;
s/"/"/g;
s|([\000-\037])|<char code='@{[ sprintf "%02X", ord($1) ]}'/>|g;
return $_;
}
#/-----------------------------------------------------------------------
# Parsing Code
#
package WDDX::String::Parser;
sub new {
return bless { value => "" }, shift;
}
sub start_tag {
my( $self, $element, $attribs ) = @_;
if ( $element eq "char" ) {
$self->append_data( $self->char_decode( $attribs->{code} ) );
}
elsif ( $element ne "string" ) {
die "<$element> not allowed within <string> element\n";
}
return $self;
}
sub end_tag {
my( $self, $element ) = @_;
if ( $element eq "string" ) {
$self = new WDDX::String( $self->{value} );
}
elsif ( $element ne "char" ) {
die "</$element> not allowed within <string> element\n";
}
return $self;
}
sub append_data {
my( $self, $data ) = @_;
$self->{value} .= $data;
}
sub char_decode {
my( $self, $code ) = @_;
die "Invalid character code\n" unless $code =~ /^[01][0-9a-f]$/i;
return chr hex $code;
}
sub is_parser {
return 1;
}