AMF-Perl
view release on metacpan or search on metacpan
Revision history for Perl extension AMF::Perl.
0.15 Sun Sep 19 13:01:35 EDT 2004
Converted examples (except for Petmarket) to ActionScript 2.0 under Flash MX 2004.
Patches from Kostas Chatzikokolakis about error checking of input data length.
WriteUTF() writes the string length as long for lengths > 65535.
Also, check for (defined $s) and not just ($s) in writeUTF.
0.14 Sun Jul 11 18:59:36 EDT 2004
Really fixed the number 16 issue (forgot to include the change in 0.13).
Added Richard Boulton's change to readDouble() and writeDouble() to take into account endian-ness.
Changed the behavior of amf_throw() to enable die() to work.
0.13 Sun Jun 20 15:52:57 EDT 2004
Started duplicating changes in this file.
AMF::Perl
Made printing output a separate function, requested by Scott Penrose.
Added and exported amf_throw() that invokes _onStatus callback in Actionscript.
AMF::Perl::IO::OutputStream
Added '$s="" unless $s' in writeUTF() to avoid warnings.
AMF::Perl::IO::InputStream
Improved the check in readDouble to append "0" to the string instead of skipping
the value. Otherwise the number 16 did not go through.
Added defined($thisByte) in readInt, otherwise the character "0" (say, in string length of 30)
did not go through.
Examples / Basic
Added a button that triggers an exception, thrown in DataEcho.pm
Examples / Petmarket
Fixed catalogservice.pm to not break when search string is not found.
0.12 Thu Apr 29 17:20:07 EDT 2004
doc/examples/sql/DataGlue.as view on Meta::CPAN
_global.DataGlue.prototype.getLength = function()
{
return this.dataProvider.getLength();
}
_global.DataGlue.prototype.format = function(formatString, record)
{
var tokens = formatString.split("#");
var result = "";
for (var i = 0; i < tokens.length; i += 2)
{
result += tokens[i];
result += (tokens[i+1] == "") ? "#" : record[tokens[i+1]];
}
return result;
}
_global.DataGlue.getItemAt_FormatString = function(index)
{
var record = this.dataProvider.getItemAt(index);
lib/AMF/Perl.pm view on Meta::CPAN
$self->output($response);
return $self;
}
sub output
{
my ($self, $response) = @_;
my $resLength = length $response;
if($ENV{MOD_PERL})
{
my $MP2 = ($mod_perl::VERSION >= 1.99);
my $r = Apache->request();
#$r->header_out("Content-Length", $resLength);
#$r->send_http_header("application/x-amf");
$r->content_type("application/x-amf");
$r->headers_out->{'Content-Length'} = $resLength;
$r->send_http_header unless $MP2;
lib/AMF/Perl/App/Executive.pm view on Meta::CPAN
}
}
sub doMethodCall_registered
{
my ($self, $package, $method, $a) = @_;
my $serviceobject = $self->{services}->{$package};
if(length($package) == 0)
{
# TODO: handle non packaged functions
#trigger_error("ERROR: no package in call",E_USER_ERROR);
return;
}
elsif(!$serviceobject)
{
print STDERR "Package ".$package." not registerd on server\n";
return;
}
lib/AMF/Perl/App/Executive.pm view on Meta::CPAN
}
return $serviceobject->$method(@$a);
}
}
sub strrpos
{
my ($string)=@_;
my $reversed = reverse $string;
my $firstDotIndex = index($reversed, ".");
return length($string)-$firstDotIndex-1;
}
1;
lib/AMF/Perl/IO/Deserializer.pm view on Meta::CPAN
AMF::Perl::IO::Deserializer
=head1 DESCRIPTION
Package used to turn the binary data into physical perl objects.
=head1 CHANGES
=head2 Sun Sep 19 13:01:35 EDT 2004
=item Patch from Kostas Chatzikokolakis about error checking of input data length.
=head2 Sat Mar 13 16:31:31 EST 2004
=item Patch from Kostas Chatzikokolakis handling encoding.
=head2 Sun Mar 9 18:17:31 EST 2003
=item The return value of readArray should be \@ret, not @ret.
=head2 Tue Mar 11 21:55:41 EST 2003
lib/AMF/Perl/IO/Deserializer.pm view on Meta::CPAN
# ignore the first two bytes -- version or something
$self->{inputStream}->readInt();
# find the total number of header elements
$self->{header_count} = $self->{inputStream}->readInt();
# loop over all of the header elements
while($self->{header_count}--)
{
my $name = $self->{inputStream}->readUTF();
# find the must understand flag
my $required = $self->readBoolean();
# grab the length of the header element
my $length = $self->{inputStream}->readLong();
# grab the type of the element
my $type = $self->{inputStream}->readByte();
# turn the element into real data
my $content = $self->readData($type);
# save the name/value into the headers array
$self->{amfdata}->addHeader($name, $required, $content);
}
}
sub readBody
{
my ($self)=@_;
# find the total number of body elements
$self->{body_count} = $self->{inputStream}->readInt();
# loop over all of the body elements
while($self->{body_count}--)
{
my $method = $self->readString();
# the target that the client understands
my $target = $self->readString();
# grab the length of the body element
my $length = $self->{inputStream}->readLong();
# grab the type of the element
my $type = $self->{inputStream}->readByte();
# turn the argument elements into real data
my $data = $self->readData($type);
# add the body element to the body object
$self->{amfdata}->addBody($method, $target, $data);
}
}
lib/AMF/Perl/IO/Deserializer.pm view on Meta::CPAN
# return the array
return \%ret;
}
# reads and array object and converts the binary data into a Perl array
sub readArray
{
my ($self)=@_;
# init the array object
my @ret;
# get the length of the array
my $length = $self->{inputStream}->readLong();
die "Malformed AMF data, array length too big" if $length > $self->{inputStream}{content_length};
# loop over all of the elements in the data
for (my $i=0; $i<$length; $i++)
{
# grab the type for each element
my $type = $self->{inputStream}->readByte();
# grab each element
push @ret, $self->readData($type);
}
# return the data
return \@ret;
}
lib/AMF/Perl/IO/Deserializer.pm view on Meta::CPAN
}
my $hr = floor($int / 60);
my $min = $int % 60;
my $timezone = "GMT " . -$hr . ":" . abs($min);
# end nastiness
# is there a nice way to return entire date(milliseconds and timezone) in PHP???
return $ms;
}
# XML comes in as a plain string except it has a long displaying the length instead of a short?
sub readXML
{
my ($self)=@_;
# reads XML
my $rawXML = $self->{inputStream}->readLongUTF();
from_to($rawXML, "utf8", $self->{encoding}) if $self->{encoding};
# maybe parse the XML into a PHP XML structure??? or leave it to the developer
# return the xml
lib/AMF/Perl/IO/InputStream.pm view on Meta::CPAN
AMF::Perl::IO::InputStream
=head1 DESCRIPTION
InputStream package built to handle getting the binary data from the raw input stream.
=head1 CHANGES
=head2 Sun Sep 19 13:01:35 EDT 2004
=item Patch from Kostas Chatzikokolakis about error checking of input data length.
=head2 Tue Jun 22 19:28:30 EDT 2004
=item Improved the check in readDouble to append "0" to the string instead of skipping
the value. Otherwise the number 16 did not go through.
=item Added defined($thisByte) in readInt, otherwise the character "0" (say, in string length of 30)
did not go through.
=head2 Sat Mar 13 16:39:29 EST 2004
=item Changed calls to ord() in readByte() and concatenation readDouble()
to prevent the appearance of the "uninitialized" warning.
=head2 Sun May 11 16:41:52 EDT 2003
=item Rewrote readInt to get rid of the "uninitialized" warning when reading bytes of value 0.
lib/AMF/Perl/IO/InputStream.pm view on Meta::CPAN
#InputStream constructor
sub new
{
my ($proto, $rd )=@_;
my $self={};
bless $self, $proto;
$self->{current_byte}=0;
# store the stream in this object
my @array = split //, $rd;
$self->{raw_data} = \@array;
# grab the total length of this stream
$self->{content_length} = @{$self->{raw_data}};
if (unpack("h*", pack("s", 1)) =~ /01/)
{
$self->{byteorder} = 'big-endian';
}
else
{
$self->{byteorder} = 'little-endian';
}
return $self;
}
# returns a single byte value.
sub readByte
{
my ($self)=@_;
# boundary check
die "Malformed AMF data, cannot readByte\n"
if $self->{current_byte} > $self->{content_length} - 1;
# return the next byte
my $nextByte = $self->{raw_data}->[$self->{current_byte}];
my $result;
$result = ord($nextByte) if $nextByte;
$self->{current_byte} += 1;
return $result;
}
# returns the value of 2 bytes
sub readInt
{
my ($self)=@_;
# boundary check
die "Malformed AMF data, cannot readInt\n"
if $self->{current_byte} > $self->{content_length} - 2;
# read the next 2 bytes, shift and add
my $thisByte = $self->{raw_data}->[$self->{current_byte}];
my $nextByte = $self->{raw_data}->[$self->{current_byte}+1];
my $thisNum = defined($thisByte) ? ord($thisByte) : 0;
my $nextNum = defined($nextByte) ? ord($nextByte) : 0;
my $result = (($thisNum) << 8) | $nextNum;
lib/AMF/Perl/IO/InputStream.pm view on Meta::CPAN
return $result;
}
# returns the value of 4 bytes
sub readLong
{
my ($self)=@_;
# boundary check
die "Malformed AMF data, cannot readLong\n"
if $self->{current_byte} > $self->{content_length} - 4;
my $byte1 = $self->{current_byte};
my $byte2 = $self->{current_byte}+1;
my $byte3 = $self->{current_byte}+2;
my $byte4 = $self->{current_byte}+3;
# read the next 4 bytes, shift and add
my $result = ((ord($self->{raw_data}->[$byte1]) << 24) |
(ord($self->{raw_data}->[$byte2]) << 16) |
(ord($self->{raw_data}->[$byte3]) << 8) |
ord($self->{raw_data}->[$byte4]));
$self->{current_byte} = $self->{current_byte} + 4;
return $result;
}
sub readDouble
{
my ($self)=@_;
# boundary check
die "Malformed AMF data, cannot readDouble\n"
if $self->{current_byte} > $self->{content_length} - 8;
# container to store the reversed bytes
my $invertedBytes = "";
if ($self->{byteorder} eq 'little-endian')
{
# create a loop with a backwards index
for(my $i = 7 ; $i >= 0 ; $i--)
{
# grab the bytes in reverse order from the backwards index
my $nextByte = $self->{raw_data}->[$self->{current_byte}+$i];
$nextByte = "0" unless $nextByte;
lib/AMF/Perl/IO/InputStream.pm view on Meta::CPAN
# unpack the bytes
my @zz = unpack("d", $invertedBytes);
# return the number from the associative array
return $zz[0];
}
# returns a UTF string
sub readUTF
{
my ($self) = @_;
# get the length of the string (1st 2 bytes)
my $length = $self->readInt();
# boundary check
die "Malformed AMF data, cannot readUTF\n"
if $self->{current_byte} > $self->{content_length} - $length;
# grab the string
my @slice = @{$self->{raw_data}}[$self->{current_byte}.. $self->{current_byte}+$length-1];
my $val = join "", @slice;
# move the seek head to the end of the string
$self->{current_byte} += $length;
# return the string
return $val;
}
# returns a UTF string with a LONG representing the length
sub readLongUTF
{
my ($self) = @_;
# get the length of the string (1st 4 bytes)
my $length = $self->readLong();
# boundary check
die "Malformed AMF data, cannot readLongUTF\n"
if $self->{current_byte} > $self->{content_length} - $length;
# grab the string
my @slice = @{$self->{raw_data}}[$self->{current_byte} .. $self->{current_byte}+$length-1];
my $val = join "", @slice;
# move the seek head to the end of the string
$self->{current_byte} += $length;
# return the string
return $val;
}
1;
lib/AMF/Perl/IO/OutputStream.pm view on Meta::CPAN
AMF::Perl::IO::OutputStream
=head1 DESCRIPTION
Class used to convert the perl stuff into binary
==head1 CHANGES
=head2 Sun Sep 19 12:59:11 EDT 2004
=item Check for (defined $s) and not just ($s) in writeUTF.
=item Write string length as long if it is over 65535.
=head2 Sun Jun 20 13:32:31 EDT 2004
=item Added $s="" unless $s in writeUTF to avoid warnings.
=head2 Sun Jul 11 18:45:40 EDT 2004
=item Added the check for endianness.
=cut
lib/AMF/Perl/IO/OutputStream.pm view on Meta::CPAN
{
my ($self, $l)=@_;
# use pack with the N flag
$self->{outBuffer} .= pack("N", $l);
}
# write a string
sub writeUTF
{
my ($self, $s)=@_;
$s = "" unless defined($s);
# write the string length - max 65536
if (length($s) <= 65535)
{
$self->writeInt(length($s));
}
else
{
$self->writeLong(length($s));
}
# write the string chars
$self->{outBuffer} .= $s;
}
#write a long string
sub writeLongUTF
{
my ($self, $s)=@_;
# write the string length - max 65536
$self->writeLong(length($s));
# write the string chars
$self->{outBuffer} .= $s;
}
sub writeDouble
{
my ($self, $d)=@_;
# pack the bytes
my $b = pack("d", $d);
my @b = split //, $b;
( run in 0.290 second using v1.01-cache-2.11-cpan-65fba6d93b7 )