package WDDX;
=head1 NAME
WDDX.pm - Module for reading and writing WDDX packets
=head1 VERSION
Version 1.02
$Header: /home/cvs/wddx/WDDX.pm,v 1.4 2003/12/02 03:41:10 andy Exp $
=cut
use vars qw( $VERSION );
$VERSION = "1.02";
=head1 NAME
=head1 SYNOPSIS
use WDDX;
my $wddx = new WDDX;
# Serialization example
my $wddx_hash = $wddx->hash( {
str => $wddx->string( "Welcome to WDDX!\n" ),
num => $wddx->number( -12.456 ),
date => $wddx->datetime( date ),
bool => $wddx->boolean( 1 ),
arr => $wddx->array( [
$wddx->boolean( 0 ),
$wddx->number( 10 ),
$wddx->string( "third element" ),
] ),
rec => $wddx->recordset(
[ "NAME", "AGE" ],
[ "string", "number" ],
[
[ "John Doe", 34 ],
[ "Jane Doe", 25 ],
[ "Fred Doe", 90 ],
]
),
obj => $wddx->hash( {
str => $wddx->string( "a string" ),
num => $wddx->number( 3.14159 ),
} ),
bin => $wddx->binary( $img_data ),
null => $wddx->null(),
} );
print $wddx->header;
print $wddx->serialize( $wddx_hash );
# Deserialization example
my $wddx_request = $wddx->deserialize( $packet );
# Assume that our code expects an array
$wddx_request->type eq "array" or die "Invalid request";
my $array_ref = $wddx_request->as_arrayref;
=head1 DESCRIPTION
=head2 About WDDX
From L:
=over 4
The Web Distributed Data Exchange, or WDDX, is a free, open XML-based
technology that allows Web applications created with any platform to
easily exchange data with one another over the Web.
=back
=head2 WDDX and Perl
WDDX defines basic data types that mirror the data types available in
other common programming languages. Many of these data types don't
have corresponding data types in Perl. To Perl, strings, numbers,
booleans, and dates are just scalars. However, in order to communicate
effectively with other languages (and this is the point of WDDX), you
do have to learn the basic WDDX data types. Here is a table that maps
the WDDX data type to Perl, along with the intermediate object WDDX.pm
represents it as:
WDDX Type WDDX.pm Data Object Perl Type
--------- ------------------- ---------
String WDDX::String Scalar
Number WDDX::Number Scalar
Boolean WDDX::Boolean Scalar (1 or "")
Datetime WDDX::Datetime Scalar (seconds since epoch)
Null WDDX::Null Scalar (undef)
Binary WDDX::Binary Scalar
Array WDDX::Array Array
Struct WDDX::Struct Hash
Recordset WDDX::Recordset WDDX::Recordset
In languages that have data types similar to the WDDX data types, the
WDDX modules allow you to convert directly from a variable to a WDDX
packet and vice versa. This Perl implementation is different; here you
must always go through an intermediate stage where the data is
represented by an object with a corresponding data type. These objects
can be converted to a WDDX packet, converted to a basic Perl type, or
converted to JavaScript code (which will recreate the data for you in
JavaScript). We will refer to these objects as I
throughout this documentation.
=head1 Requirements
This module requires L and L, which are
both available on CPAN at L. Windows users note:
These modules use compiled code, but I have been told that they are both
included with recent distributions of ActiveState Perl.
=cut
use strict;
use Carp;
require WDDX::Parser;
require WDDX::Boolean;
require WDDX::Number;
require WDDX::Datetime;
require WDDX::String;
require WDDX::Array;
require WDDX::Recordset;
require WDDX::Struct;
require WDDX::Null;
require WDDX::Binary;
# Each of these must have a corresponding WDDX::* class;
# These are lowerclass while the WDDX::* name will have initial cap
@WDDX::Data_Types = qw( boolean number string datetime null
array struct recordset binary );
$WDDX::XML_HEADER = "\n" .
"\n";
$WDDX::PACKET_HEADER = "";
$WDDX::PACKET_FOOTER = "";
# if this is defined, serialize() uses it to indent packet
$WDDX::INDENT = undef;
# Create struct() as an alias to the hash() method:
*struct = \&hash;
{ my $i_hate_the_w_flag_sometimes = [
\@WDDX::Data_Types,
$WDDX::XML_HEADER,
$WDDX::PACKET_HEADER,
$WDDX::PACKET_FOOTER,
$WDDX::INDENT,
\&struct,
$WDDX::VERSION
] }
1;
=head1 METHODS
=head2 new
This creates a new WDDX object. You need one of these to do pretty much
anything else. It doesn't take any arguments.
=cut
sub new {
my $this = shift;
my $class = ref( $this ) || $this;
# Currently no properties maintained in WDDX object
my $self = bless [], $class;
return $self;
}
=head2 C<< $wddx->deserialize( $string_or_filehandle ) >>
This method deserializes a WDDX packet and returns a data object. Note
that you can pass either a string or a reference to an open filehandle
containing a packet (XML::Parser is flexible this way):
$wddx_obj = $wddx->deserialize( $packet ); # OR
$wddx_obj = $wddx->deserialize( \*HANDLE );
If WDDX.pm or the underlying L finds any errors with the
structure of the WDDX packet, then it will C with an error
message that identifies the problem. If you don't want this to terminate
your script, you will have to place this call within an C block
to trap the C.
=cut
sub deserialize {
my( $self, $xml ) = @_;
my $parser = new WDDX::Parser();
return $parser->parse( $xml, $self );
}
=head2 C<< $wddx->serialize( $wddx_obj ) >>
This accepts a data object as an argument and returns a WDDX packet.
This method calls the as_packet() method on the data object
it receives. However, this method does provide one feature that
C does not. If C<$WDDX::INDENT> is set to a defined value,
then the generated WDDX packet is indented using C<$WDDX::INDENT>
as the unit of indentation. Otherwise packets are generated without
extra whitespace.
Note that the generated packet is not a valid XML document without the
header, see below.
=cut
sub serialize {
my( $self, $data ) = @_;
croak "You may only serialize WDDX data objects" unless
eval { $data->can( "as_packet" ) };
my $packet = eval { $data->as_packet };
croak _shift_blame( $@ ) if $@;
return defined( $WDDX::INDENT ) ? _xml_indent( $packet ) : $packet;
}
=head2 C<< $wddx->header >>
This returns a header that should accompany every serialized packet you
send.
=cut
sub header {
return $WDDX::XML_HEADER;
}
sub string {
my( $this, $value ) = @_;
return new WDDX::String( $value );
}
sub number {
my( $this, $value ) = @_;
return new WDDX::Number( $value );
}
sub datetime {
my( $this, $value ) = @_;
return new WDDX::Datetime( $value );
}
sub boolean {
my( $this, $value ) = @_;
return new WDDX::Boolean( $value );
}
sub hash {
my( $this, $hashref ) = @_;
my $var = eval {
new WDDX::Struct( $hashref );
};
croak _shift_blame( $@ ) if $@;
return $var;
}
sub array {
my( $this, $arrayref ) = @_;
my $var = eval {
new WDDX::Array( $arrayref );
};
croak _shift_blame( $@ ) if $@;
return $var;
}
sub recordset {
my( $this, $names, $types, $tableref ) = @_;
my $var = eval {
new WDDX::Recordset( $names, $types, $tableref );
};
croak _shift_blame( $@ ) if $@;
return $var;
}
sub binary {
my( $this, $value ) = @_;
return new WDDX::Binary( $value );
}
sub null {
my( $this, $value ) = @_;
return new WDDX::Null( $value );
}
############################################################
#
# Public Utility Methods (make life easier)
#
sub scalar2wddx {
my( $wddx, $scalar, $type ) = @_;
$type = defined( $type ) ? lc $type : "string";
croak "Will not encode a reference as a scalar" if ref $scalar;
my $var = eval "WDDX::\u$type->new( \$scalar )" or
croak "Unable to create object of type WDDX::\u$type: " .
_shift_blame( $@ );
return $var;
}
sub hash2wddx {
my( $wddx, $hashref, $coderef ) = @_;
my $new_hash = {};
$coderef = sub { "" } unless
defined( $coderef ) && eval { &$coderef || 1 };
while ( my( $name, $val ) = each %$hashref ) {
eval { $val->can( "_serialize" ) } and do {
$new_hash->{$name} = $val;
next;
};
my $type = lc $coderef->( $name => $val, "HASH" );
if ( $type ) {
ref( $val ) eq "HASH" and do {
$new_hash->{$name} = $wddx->hash2wddx ( $val, sub { $type } );
next;
};
ref( $val ) eq "ARRAY" and do {
$new_hash->{$name} = $wddx->array2wddx( $val, sub { $type } );
next;
};
my $var = eval "WDDX::\u$type->new( \$val )" or
croak "Unable to create object of type WDDX::\u$type: " .
_shift_blame( $@ );
$new_hash->{$name} = $var;
next;
}
ref( $val ) eq "HASH" and do {
$new_hash->{$name} = hash2wddx ( $wddx, $val, $coderef );
next;
};
ref( $val ) eq "ARRAY" and do {
$new_hash->{$name} = array2wddx( $wddx, $val, $coderef );
next;
};
# Scalars treated as strings by default
$new_hash->{$name} = $wddx->string( $val );
}
return $wddx->hash( $new_hash );
}
sub array2wddx {
my( $wddx, $arrayref, $coderef ) = @_;
my $new_array = [];
$coderef = sub { "" } unless
defined( $coderef ) && eval { &$coderef || 1 };
for ( my $i = 0; $i < @$arrayref; $i++ ) {
my $val = $arrayref->[$i];
eval { $val->can( "_serialize" ) } and do {
push @$new_array, $val;
next;
};
my $type = lc $coderef->( $i => $val, "ARRAY" );
if ( $type ) {
ref( $val ) eq "HASH" and do {
push @$new_array, hash2wddx( $wddx, $val, sub { $type } );
next;
};
ref( $val ) eq "ARRAY" and do {
push @$new_array, array2wddx( $wddx, $val, sub { $type } );
next;
};
my $var = eval "WDDX::\u$type->new( $i => \$val )" or
croak "Unable to create object of type WDDX::\u$type: " .
_shift_blame( $@ );
push @$new_array, $var;
next;
}
ref( $val ) eq "HASH" and do {
push @$new_array, hash2wddx( $wddx, $val, $coderef );
next;
};
ref( $val ) eq "ARRAY" and do {
push @$new_array, array2wddx( $wddx, $val, $coderef );
next;
};
# Scalars treated as strings by default
push @$new_array, $wddx->string( $val );
}
return $wddx->array( $new_array );
}
sub wddx2perl {
my( $self, $wddx_obj ) = @_;
my $result;
$result = $wddx_obj->as_scalar if $wddx_obj->can( "as_scalar" );
$result = $wddx_obj->as_hashref if $wddx_obj->type eq "hash";
$result = $wddx_obj->as_arrayref if $wddx_obj->type eq "array";
$result = $wddx_obj if $wddx_obj->type eq "recordset";
return $result;
}
############################################################
#
# Private Subs
#
# Takes a die message and strips any internal line refs
# This is necessary because we call public methods that invoke croak
# and croak would blame us even though we're just the messenger...
sub _shift_blame {
my $msg = shift;
$msg =~ s/ at \S*WDDX.*\.pm line \d+//g;
$msg =~ s/\n\nFile '.*'; Line \d+//g; # MacPerl thinks different
chomp $msg;
return $msg;
}
# This uses regex matches to do indentation based on whether tag
# starts with or or >
# It's called by serialize() if $WDDX::INDENT is defined
sub _xml_indent {
my $xml = shift;
my $indent = $WDDX::INDENT;
my $level = 0;
# It ain't pretty but it works...
$xml =~ s{ (>?)\s*(< ([?!/]?) [^>/]* (/?) ) }{
# print "Matched: $&\n 1: $1\n 2: $2\n 3: $3\n 4: $4\n";
$level-- if $3 eq "/" && not $4;
my $result = $1 ? "$1\n" . ( $indent x $level ) . $2 : $2;
$level++ unless $3 || $4;
$result;
}egx;
return $xml;
}
__END__
=head1 WDDX DATA OBJECTS
=head2 Common Methods
All of the WDDX data objects share the following common methods:
=over
=item $wddx_obj->type
This returns the data type of the object. It is lowercase and maps
to the package name without the WDDX prefix. For example, type will
return "string" for WDDX::String objects, "datetime" for WDDX::Datetime
objects, etc.
=item $wddx_obj->as_packet
This returns a WDDX packet for the object. You can also do this by
passing the object to the C<$wddx->serialize> method. See the warning
in C<$wddx->header>.
=item $wddx_obj->as_javascript( $js_varname )
This method takes the name of a JavaScript variable and returns the
actual JavaScript code to assign this data object to the given
JavaScript variable. No temporary variables are created to avoid
any danger of variable name collisions.
Example:
$options[0] = $wddx->string( "First Choice" );
$options[1] = $wddx->string( "Second Choice" );
$options[2] = $wddx->string( "Third Choice" );
$w_array = $wddx->array( \@options );
print $w_array->as_javascript( "myArray" );
This prints the text (new lines added for readability):
myArray=new Array();
myArray[0]="First Choice";
myArray[1]="Second Choice";
myArray[2]="Third Choice";
All data types are supported, and arrays and hashes (structs) can nest
to any level. Recordset and binary objects require the JavaScript
WddxRecordset and WddxBinary constructors. The easiest way to include
these is to add a reference to the wddx.js file:
wddx.js is the WDDX library for JavaScript. It is available as part of
the WDDX SDK at http://www.wddx.org/.
=back
=head2 WDDX::String
=over
=item $wddx->string( 'Just a bunch of text...' )
This creates a WDDX string object. Strings contain 8 bit characters,
can be any length, and should not include embedded nulls. However,
control characters and characters that have special meaning for XML
(like E, E, and E) are safely encoded for you.
=item $w_string->as_scalar
This returns the value of the WDDX::String as a Perl scalar.
=back
=head2 WDDX::Number
=over
=item $wddx->number( 3.14159 )
This creates a WDDX number object. Numbers are restricted to
+/-1.7e308 and if you exceed these bounds this method dies with an
error. Floating point numbers are restricted to 15 digits of accuracy
past the decimal. If you exceed this then the number is truncated to
15 digits with a warning. If you pass a non-numeric scalar to this,
then it is simply treated as a number: Perl will attempt to translate
it, will probably use zero, and will issue a warning.
=item $w_number->as_scalar
This returns the value of the WDDX::Number as a Perl scalar.
=back
=head2 WDDX::Boolean
=over
=item $wddx->boolean( 1 )
This creates a WDDX boolean object. It simply tests the argument in a
boolean context, so "0" and "" are false and anything else is true.
=item $w_boolean->as_scalar
This returns the value of the WDDX::Boolean as a Perl scalar. True
is represented by 1 and false is represented by an empty string.
=back
=head2 WDDX::Datetime
=over
=item $wddx->datetime
This creates a WDDX Datetime object.
=item $w_datetime->use_timezone_info( 1 )
This sets or reads the flag that says whether to include the
timezone info (local hour and minute offset from UTC) in WDDX
packets created from this object. By default this is turned on
for new objects. You can turn it off by passing a false (but not
undef) argument to this method.
When a WDDX::Datetime object is deserialized from a packet, this
method will indicate whether timezone information was present in that
packet.
=item $w_datetime->as_scalar
This returns the value of the WDDX::Datetime as a Perl scalar. It
contains the number of seconds since the epoch localized for the
current machine (like Perl's built-in C