AMF-Perl
view release on metacpan or search on metacpan
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: AMF-Perl
version: 0.15
version_from: lib/AMF/Perl.pm
installdirs: site
requires:
DBI: 0.01
Encode: 0.01
Exception::Class: 0.01
distribution_type: module
generated_by: ExtUtils::MakeMaker version 6.17
doc/code.html view on Meta::CPAN
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<meta http-equiv="content-type"
content="text/html; charset=ISO-8859-1">
<title>AMF::Perl - Flash Remoting in Perl and Python</title>
<style>
body {
scrollbar-3d-light-color: #000000;
scrollbar-arrow-color: #000066;
scrollbar-base-color: #003366;
scrollbar-dark-shadow-color: #FFFFFF;
scrollbar-face-color: #003366;
scrollbar-highlight-color: #FFFFFF;
doc/code.html view on Meta::CPAN
def echoDate(self, arg):
return arg
def echoXML(self, arg):
return arg
def methodTable(self):
table = {}
table["echoNormal"]= {
"description" : "Echoes the passed argument back to Flash (no need to set the return type)",
"access" : "remote", # available values are private, public, remote
}
table["echoDate"] = {
"description" : "Echoes a Flash Date Object (the returnType needs setting)",
"access" : "remote", # available values are private, public, remote
"returns" : "date"
}
table["echoXML"] = {
"description" : "Echoes a Flash XML Object (the returnType needs setting)",
"access" : "private", # available values are private, public, remote
doc/examples/basic/basic.html view on Meta::CPAN
<body>
<center>
<table cellspacing=10><tr>
<td align=left width=400 valign=top>
<H2>This is an example of <a href=http://www.simonf.com/amfperl/>AMF::Perl</a> in action.</H2>
<br>
<p>
Download Flash 7 player from <a href="http://www.macromedia.com/shockwave/download/alternates/">here</a> if you don't have it. It even works on Linux!
<p>
This shows various data types passed through AMF to the perl backend and sent back.
The most interesting this is not so much what it does, but how it works. The Perl script utilizes the "service discovery" approach - you simply put Perl modules into a certain directory, and they are automatically registered as services.
<br><br>
This example also shows how to throw exceptions, handled by functionName_onStatus in the Flash client (as opposed to functionName_onResult, which is called normally). Simply include in your Perl code
<pre>
use AMF::Perl qw/amf_throw/;
</pre>
and then call <em>amf_throw()</em> with a string or an arbitrary object as a parameter.
<br><br>
If you call <em>die "Error message"</em>, it will be also caught in the same way and sent as an error to Flash.
doc/examples/basic/basicservices/DataEcho.pm view on Meta::CPAN
# The code is based on the -PHP project (http://amfphp.sourceforge.net/)
=head1 NAME
DataEcho
==head1 DESCRIPTION
Service class used in conjusction with basic.pl
All AMF::Perl service classes must define the method table, where the user can supply optional description and return type.
If you want to return an error message, handled by functionName_onStatus in the Flash client (as opposed to functionName_onResult, which is normal), include
use AMF::Perl qw/amf_throw/;
and then call amf_throw() with a string or an arbitrary object as a parameter.
==head1 CHANGES
doc/examples/basic/basicservices/DataEcho.pm view on Meta::CPAN
my $self={};
bless $self, $proto;
return $self;
}
sub methodTable
{
return {
"echoNormal" => {
"description" => "Echoes the passed argument back to Flash (no need to set the return type)",
"access" => "remote", # available values are private, public, remote
},
"echoDate" => {
"description" => "Echoes a Flash Date Object (the returnType needs setting)",
"access" => "remote", # available values are private, public, remote
"returns" => "date"
},
"echoXML" => {
"description" => "Echoes a Flash XML Object (the returnType needs setting)",
"access" => "remote", # available values are private, public, remote
doc/examples/cpu/cpu.html view on Meta::CPAN
<center>
<table width=800 cellspacing=10><tr>
<td align=left width=400 valign=top>
<H2>This is an example of <a href=http://www.simonf.com/amfperl/>AMF::Perl</a> in action.</H2>
<br>
<p>
Download Flash 7 player from <a href="http://www.macromedia.com/shockwave/download/alternates/">here</a> if you don't have it. It even works on Linux!
<p>
These are the 1, 5 and 15 minute load values on this web server. Press Refresh to see the current load.
If you want to use this on your server, but do not have Macromedia authoring tools, you can type your URL instead of the default URL that you see in this Flash movie.
<br>
<a href=cpu.pl>This is the server-side Perl script cpu.pl.</a>
</td>
<td width=400>
<OBJECT classid="clsid:D27CDB6E-AE6D-11cf-96B8-444553540000"
codebase="http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=6,0,40,0" id="CpuExample" width=400 height=400>
<PARAM NAME=movie VALUE="cpu.swf">
<PARAM NAME=quality VALUE=high>
<PARAM NAME=bgcolor VALUE=#FFFFFF>
doc/examples/petmarket/petmarket.sql view on Meta::CPAN
homecountry varchar(50) default NULL,
homezip varchar(10) default NULL,
homephone varchar(20) default NULL,
shippingstreet1 varchar(50) default NULL,
shippingstreet2 varchar(50) default NULL,
shippingcity varchar(50) default NULL,
shippingcountry varchar(50) default NULL,
shippingzip varchar(10) default NULL,
shippingphone varchar(20) default NULL,
creditcardnumber varchar(50) default NULL,
creditcardtype varchar(50) default NULL,
creditcardexpiry varchar(50) default NULL
) TYPE=MyISAM;
--
-- Dumping data for table 'user_details'
--
doc/examples/petmarket/petmarket/api/stringresourcesservice.pm view on Meta::CPAN
$strings{"CHARGE_SUMMARY_GRAND_TOTAL_LBL_str"}="Total Charges:";
$strings{"VALIDATE_EMAIL_ERR_TITLE_str"}="E-mail not valid";
$strings{"VALIDATE_EMAIL_ERR_MSG_str"}="E-mail entered is not valid.\nPlease try again.";
$strings{"VALIDATE_PASS_ERR_TITLE_str"}="Password invalid";
$strings{"VALIDATE_PASS_MISMATCH_ERR_MSG_str"}="Passwords do not match.\nPlease try again.";
$strings{"VALIDATE_PASS_INVALID_ERR_MSG_str"}="Invalid password.\nPlease try again.";
$strings{"VALIDATE_CREATE_USER_FAILED_TITLE_str"}="Failed to create user";
$strings{"VALIDATE_CREATE_USER_FAILED_MSG_str"}="An account using this E-mail address already exists.";
$strings{"VALIDATE_LOGIN_USER_FAILED_TITLE_str"}="Failed to log in";
$strings{"VALIDATE_LOGIN_USER_FAILED_MSG_str"}="Unable to log in.\nPlease check the E-mail address and password and try again.";
$strings{"VALIDATE_FIRST_NAME_ERROR_MSG_str"}="Please type in your first name.";
$strings{"VALIDATE_FIRST_NAME_ERROR_TITLE_str"}="Invalid first name";
$strings{"VALIDATE_LAST_NAME_ERROR_MSG_STR"}="Please type in your last name.";
$strings{"VALIDATE_LAST_NAME_ERROR_TITLE_STR"}="Invalid last name";
$strings{"VALIDATE_ADDRESS_ERROR_MSG_str"}="Please type in an address.";
$strings{"VALIDATE_ADDRESS_ERROR_TITLE_str"}="Invalid address";
$strings{"VALIDATE_CITY_ERROR_MSG_str"}="Please type in a city.";
$strings{"VALIDATE_CITY_ERROR_TITLE_str"}="Invalid city";
$strings{"VALIDATE_ZIPCODE_ERROR_MSG_str"}="Please enter a valid 5 digit Zip code.";
$strings{"VALIDATE_ZIPCODE_ERROR_TITLE_str"}="Invalid Zip code";
$strings{"VALIDATE_PHONE_ERROR_MSG_str"}="Please enter a valid 10 digit telephone number.";
$strings{"VALIDATE_PHONE_ERROR_TITLE_str"}="Invalid phone number";
$strings{"VALIDATE_SELECT_CC_TYPE_ERROR_MSG_str"}="Please select a credit card from the list.";
$strings{"VALIDATE_SELECT_CC_MO_ERROR_MSG_str"}="Please select a credit card expiry month from the list.";
$strings{"VALIDATE_SELECT_CC_YR_ERROR_MSG_str"}="Please select a credit card expiry year from the list.";
$strings{"VALIDATE_CC_EXPIRED_ERROR_MSG_str"}="Please select a credit card expiry date that is not in the past.";
$strings{"VALIDATE_INVALID_CC_ERROR_MSG_str"}="Invalid credit card number. Please enter valid credit card number.";
doc/examples/petmarket/petmarket/api/userservice.pm view on Meta::CPAN
"access" => "remote",
},
"updateUser" => {
"description" => "Add a user with the given credentials",
"access" => "remote",
},
};
}
my @userFields = ("firstname", "lastname", "homestreet1", "homestreet2", "homecity", "homestate", "homecountry", "homezip", "homephone", "creditcardnumber", "creditcardtype", "creditcardexpiry");
my @shippingFields = ("shippingstreet1", "shippingstreet2", "shippingcity", "shippingcountry", "shippingzip", "shippingphone");
my @fields = ("email", "password", @userFields, @shippingFields);
sub authenticate
{
my ($self, $email, $password) = @_;
my $ary_ref = $self->dbh->selectall_arrayref("SELECT count(*) FROM user_details where email='$email' AND password='$password'");
doc/examples/sql/DataGlue.as view on Meta::CPAN
// let a user-supplied function handle formatting of each data record
_global.DataGlue.bindFormatFunction = function (dataConsumer, dataProvider, formatFunction)
{
var proxy = new DataGlue(dataProvider);
proxy.formatFunction = formatFunction;
proxy.getItemAt = _global.DataGlue.getItemAt_FormatFunction;
dataConsumer.setDataProvider(proxy);
}
_global.DataGlue.prototype.addView = function(viewRef)
{
return this.dataProvider.addView(viewRef);
}
_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;
}
doc/examples/sql/DataGlue.as view on Meta::CPAN
}
_global.DataGlue.getItemAt_FormatFunction = function(index)
{
var record = this.dataProvider.getItemAt(index);
if (record == "in progress" || record==undefined)
return record;
return this.formatFunction(record);
}
_global.DataGlue.prototype.getItemID = function(index)
{
return this.dataProvider.getItemID(index);
}
_global.DataGlue.prototype.addItemAt = function(index, value)
{
return this.dataProvider.addItemAt(index, value);
}
_global.DataGlue.prototype.addItem = function(value)
{
return this.dataProvider.addItem(value);
}
_global.DataGlue.prototype.removeItemAt = function(index)
{
return this.dataProvider.removeItemAt(index);
}
_global.DataGlue.prototype.removeAll = function()
{
return this.dataProvider.removeAll();
}
_global.DataGlue.prototype.replaceItemAt = function(index, itemObj)
{
return this.dataProvider.replaceItemAt(index, itemObj);
}
_global.DataGlue.prototype.sortItemsBy = function(fieldName, order)
{
return this.dataProvider.sortItemsBy(fieldName, order);
}
doc/examples/sql/README.txt view on Meta::CPAN
Installation notes on the ParkServices example.
1. Make sure you have access to a mysql database and that the DBI and DBD::Mysql modules are installed.
2. Import the park.sql script into your database.
3. Don't forget to put DataGlue.as in the same directory as the Flash movie.
4. Recompile the Flash movie to point to the location of your park.pl script.
Note that normally AMF::Perl tries to guess whether you are sending a number.
And if the database used is Mysql, AMF::Perl will retrieve column types
from the statement handle. This is done so that the server could send back
primitive data types in a recordset as numbers or strings avoiding the
guessing (which may be wrong if you do intend to send a number as a string).
doc/examples/sql/parkservices/ParkService.pm view on Meta::CPAN
my ($self, $val) = @_;
$self->{dbh} = $val if $val;
return $self->{dbh};
}
sub methodTable
{
return {
"getParkTypes" => {
"description" => "Returns list of park types",
"access" => "remote",
"returns" => "AMFObject"
},
"getParksList" => {
"description" => "Shows list of parks given a park type",
"access" => "remote",
"returns" => "AMFObject"
},
"getParkDetails" => {
"description" => "Return details on a park give the parkname",
"access" => "remote",
"returns" => "AMFObject"
}
};
}
sub getParkTypes()
{
my ($self) = @_;
return $self->recordset->query("SELECT Distinct(parktype) FROM tblparks WHERE parktype is not NULL order by parktype");
}
sub getParksList
{
my ($self, $parkType) = @_;
my $select = "SELECT parkName,city,state,parktype FROM tblparks ";
$select .= " WHERE parktype='$parkType' " if $parkType;
$select .= "ORDER BY parkname";
return $self->recordset->query($select);
}
sub getParkDetails
{
my ($self, $thisParkName) = @_;
return $self->recordset->query("SELECT * FROM tblparks WHERE parkname='".$thisParkName."'");
}
doc/index.html view on Meta::CPAN
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<meta http-equiv="content-type"
content="text/html; charset=ISO-8859-1">
<title>AMF::Perl - Flash Remoting in Perl and Python</title>
<style>
body {
scrollbar-3d-light-color: #000000;
scrollbar-arrow-color: #000066;
scrollbar-base-color: #003366;
scrollbar-dark-shadow-color: #FFFFFF;
scrollbar-face-color: #003366;
scrollbar-highlight-color: #FFFFFF;
doc/index.html view on Meta::CPAN
<br>
September 19, 2004. <a href="AMF-0.04.tar.gz">An alpha implementation of AMF in <B style="color:black;background-color:#A0FFFF">Python</B>. Version 0.04.</a>
<br><br>
<a href="code.html">Usage instructions and code samples.</a><br>
<br>
<h2>What is this?</h2>
<h3> Short version<br>
</h3>
<a href="http://www.macromedia.com/software/flashremoting/">Flash
Remoting</a> is a way for Flash movies running in a web browser to
request structured data from the web server. The following data types
are supported - strings, numbers, dates, arrays, dictionaries/hashes,
objects, recordsets. Flash clients talk with the server using the AMF
protocol, which is proprietary to Macromedia. However, it's not that
hard to decode. <br>
<br>
Using AMF::Perl, it is possible to send arbitrary
data between client and server using very few lines of code. There is no
need to pack complicated data structures into CGI form parameteres or
XML strings. The coding time can be spent on better things - data
preparation and graphical presentation, not data delivery.<br>
doc/updates.html view on Meta::CPAN
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<meta http-equiv="content-type"
content="text/html; charset=ISO-8859-1">
<title>AMF::Perl - Flash Remoting in Perl</title>
<style>
body {
scrollbar-3d-light-color: #000000;
scrollbar-arrow-color: #000066;
scrollbar-base-color: #003366;
scrollbar-dark-shadow-color: #FFFFFF;
scrollbar-face-color: #003366;
scrollbar-highlight-color: #FFFFFF;
doc/updates.html view on Meta::CPAN
<tr><td>
<h2><a href="http://www.simonf.com/amfperl">AMF::Perl</a> update history</h2>
<br><br>September 19, 2004. Version 0.15 uploaded. Converted examples to ActionScript 2.0, better input error checking.
<br><br>Jul 11, 2004. Version 0.14 uploaded. Endianness, better exception handling.
<br><br>Jul 06, 2004. Version 0.13 uploaded. Small bug fixes, exception handling.
<br><br>Apr 29, 2004. Version 0.12 uploaded. Changed "use Apache2" to "require Apache2".
<br><br>Apr 24, 2004. Flash::FLAP renamed to AMF::Perl. Version 0.11 uploaded (0.10 was an interim release). Hopefully complete mod_perl 1 and 2 handling. Mysql column type determination.
<br><br>Mar 13, 2004. Version 0.09 uploaded. Fixed a couple of "uninitialized" warnings, accepted patches for POD documentation, smarter detection of numbers and dates in Serializer and text encoding.
<br><br>Aug 3, 2003. Version 0.08 uploaded. Petstore example implemented!!! Also, rewrote Flash::FLAP::new() to accept both Flash::FLAP->new and $flap->new.
<br><br>Jul 26, 2003. Version 0.07 uploaded. Fixed a bug that would wrongly detect end-of-file in the input data on Windows and replaced the "our" keyword that is not backwards-compatible. Created pseudo_query() in Util::Object that encapsulates th...
<br><br>Jun 22, 2003. Version 0.06 uploaded. Added an example that talks to a database on the server side. This is implemented via Flash::FLAP::Sql::MysqlRecordSet.pm. Got rid of a couple of "uninitialized" warnings.
<br><br>Apr 29, 2003. Version 0.05 uploaded. It supports Windows and mod_perl 1.
<br><br>Apr 14, 2003 - FLAP renamed to Flash::FLAP. Version 0.03 uploaded. Added ser
vice discovery - now you can register a directory and put Perl packages in it. Every
package will be considered a service. Macromedia Service Browser support added.
<br>
<br>
Mar 11, 2003 - FLAP-0.02 uploaded. Verified trasfer of basic data types from Flash to Perl. Parameters are now sent to Perl functions as an array, not an array ref.
</tr>
</tbody>
</table>
</div>
<br>
<br>
</body>
</html>
lib/AMF/Perl.pm view on Meta::CPAN
=head1 ABSTRACT
Macromedia Flash Remoting server-side support.
=head1 DESCRIPTION
This file accepts the data and deserializes it using the InputStream and Deserializer classes.
Then the gateway builds the executive class which then loads the targeted class file
and executes the targeted method via flash remoting.
After the target uri executes the the gateway determines the data type of the data
and serializes and returns the data back to the client.
=head2 EXPORT
None by default.
=head1 SEE ALSO
There is a mailing list for AMF::Perl. You can subscribe here:
lib/AMF/Perl.pm view on Meta::CPAN
=head1 COPYRIGHT AND LICENSE
Copyright (c) 2003 by Vsevolod (Simon) Ilyushchenko. All rights reserved.
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
The code is based on the -PHP project (http://amfphp.sourceforge.net/)
ORIGINAL PHP Remoting CONTRIBUTORS
Musicman - original design
Justin - gateway architecture, class structure, datatype io additions
John Cowen - datatype io additions, class structure
Klaasjan Tukker - modifications, check routines, and register-framework
==head1 CHANGES
=head2 Sun Jul 11 18:45:40 EDT 2004
=item Chaned eval{} and amf_throw() to enable die() to work as well (instead of amf_throw()).
=head2 Sun Jun 20 13:32:31 EDT 2004
lib/AMF/Perl.pm view on Meta::CPAN
$self->{exec}->setTarget( $body->{"target"} );
#/Simon
# execute the method and pass it the arguments
my ($results, $returnType);
# try
eval
{
$results = $self->{exec}->doMethodCall( $body->{"value"} );
# get the return type
$returnType = $self->{exec}->getReturnType();
};
if ( $@ )
{
$results = UNIVERSAL::isa( $@, 'AMFException' ) ? $@->error : constructException($@);
$self->{"response"} = "/onStatus";
$returnType = "AMFObject";
}
lib/AMF/Perl.pm view on Meta::CPAN
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;
$r->print($response);
}
else
{
print <<EOF;
Content-Type: application/x-amf
Content-Length: $resLength
lib/AMF/Perl/App/Executive.pm view on Meta::CPAN
=head1 DESCRIPTION
Executive package figures out whether to call an explicitly
registered package or to look one up in a registered directory.
Then it executes the desired method in the package.
=head1 CHANGES
=head2 Wed Apr 14 11:06:28 EDT 2004
=item Added return type determination for registered methods.
=head2 Sun Mar 23 13:27:00 EST 2003
=over 4
=item Synching with AMF-PHP:
=item Replaced packagepath, packagename, packageConstruct with classpath, classname, classConstruct.
=item Added _instanceName, _origClassPath and _headerFilter.
lib/AMF/Perl/App/Executive.pm view on Meta::CPAN
# the directory which should be used for the basic packages default "../"
# my $_basecp = "../";
# the classpath which is the path of the file from $_basecp
#my $_classpath;
# the string name of the package derived from the classpath
#my $_classname;
# the object we build from the package
#my $_classConstruct;
# the method to execute in the construct
#my $_methodname;
# the defined return type
#my $_returnType;
# the instance name to use for this gateway executive
#my $_instanceName;
# the list with registered service-packagees
#my $services = {};
# The original incoming classpath
#my $_target;
# The original classpath
#my $_origClassPath;
# switch to take different actions based on the header
lib/AMF/Perl/App/Executive.pm view on Meta::CPAN
$self->{_classname} = $trunced;
}
sub registerService
{
my ($self, $package, $servicepackage) = @_;
$self->{services}->{$package} = $servicepackage;
}
# returns the return type for this method
sub getReturnType
{
my ($self)=@_;
return $self->{_returnType};
}
# execute the method using dynamic inclusion of Perl files
sub doMethodCall
{
my ($self, $a) = @_;
lib/AMF/Perl/App/Executive.pm view on Meta::CPAN
{
# check the instance names to see if they match. If so, then let this happen
if (!exists($methodrecord{'instance'}) || $self->{_instanceName} != $methodrecord{'instance'})
{
# if they don't match then print STDERR with this error
print STDERR "Access error for " . $self->{_headerFilter} . ".\n";
return;
}
}
# check to see if an explicit return type was defined
if (exists($methodrecord{'returns'}))
{
$self->{_returnType} = $methodrecord{'returns'};
}
# set the default return type of "unknown"
else
{
$self->{_returnType} = "unknown";
}
# set to see if the access was set and the method as remote permissions.
if ( (exists($methodrecord{'access'})) && (lc ($methodrecord{'access'}) eq "remote"))
{
# finally check to see if the method existed
if ($self->{_classConstruct}->can($method))
{
lib/AMF/Perl/App/Executive.pm view on Meta::CPAN
return;
}
else
{
$self->{_returnType} = "unknown";
if ($serviceobject->can("methodTable") && exists ($serviceobject->methodTable->{$method}))
{
# create a shortcut to the methodTable
my %methodrecord = %{$serviceobject->methodTable->{$method}};
# check to see if an explicit return type was defined
if (exists($methodrecord{'returns'}))
{
$self->{_returnType} = $methodrecord{'returns'};
}
# set the default return type of "unknown"
else
{
$self->{_returnType} = "unknown";
}
}
return $serviceobject->$method(@$a);
}
}
sub strrpos
lib/AMF/Perl/IO/Deserializer.pm view on Meta::CPAN
=item The return value of readArray should be \@ret, not @ret.
=head2 Tue Mar 11 21:55:41 EST 2003
=item Fixed reading keys of objects.
=item Added floor(), as Perl lacks it.
=head2 Sun Apr 6 14:24:00 2003
=item Added code to read objects of type 8. Useful for decoding real AMF server packages, but hardly anywhere else.
=cut
use strict;
use Encode qw/from_to/;
# the number of headers in the packet
my $header_count;
# the content of the headers
lib/AMF/Perl/IO/Deserializer.pm view on Meta::CPAN
# 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);
}
}
# reads an object and converts the binary data into a Perl object
sub readObject
{
my ($self)=@_;
# init the array
my %ret;
# grab the key
my $key = $self->{inputStream}->readUTF();
for (my $type = $self->{inputStream}->readByte(); $type != 9; $type = $self->{inputStream}->readByte())
{
die "Malformed AMF data, no object end byte" unless defined($type);
# grab the value
my $val = $self->readData($type);
# save the name/value pair in the array
$ret{$key} = $val;
# get the next name
$key = $self->{inputStream}->readUTF();
}
# return the array
return \%ret;
}
# reads and array object and converts the binary data into a Perl array
lib/AMF/Perl/IO/Deserializer.pm view on Meta::CPAN
{
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;
}
sub readCustomClass
{
my ($self)=@_;
# grab the explicit type -- I'm not really convinced on this one but it works,
# the only example i've seen is the NetDebugConfig object
my $typeIdentifier = $self->{inputStream}->readUTF();
# the rest of the bytes are an object without the 0x03 header
my $value = $self->readObject();
# save that type because we may need it if we can find a way to add debugging features
$value->{"_explicitType"} = $typeIdentifier;
# return the object
return $value;
}
sub readNumber
{
my ($self)=@_;
# grab the binary representation of the number
return $self->{inputStream}->readDouble();
}
lib/AMF/Perl/IO/Deserializer.pm view on Meta::CPAN
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
return $rawXML;
}
sub readFlushedSO
{
my ($self)=@_;
# receives [type(07) 00 00] if SO is flushed and contains 'public' properties
# see debugger readout ???
return $self->{inputStream}->readInt();
}
sub readASObject
{
my ($self)=@_;
#object Button, object Textformat, object Sound, object Number, object Boolean, object String,
#SharedObject unflushed, XMLNode, used XMLSocket??, NetConnection,
#SharedObject.data, SharedObject containing 'private' properties
#the final byte seems to be the dataType -> 0D
return undef;
}
# main switch function to process all of the data types
sub readData
{
my ($self, $type) = @_;
my $data;
#print STDERR "Reading data of type $type\n";
if ($type == 0) # number
{
$data = $self->readNumber();
}
elsif ($type == 1) # boolean
{
$data = $self->readBoolean();
}
elsif ($type == 2) # string
{
$data = $self->readString();
}
elsif ($type == 3) # object Object
{
$data = $self->readObject();
}
elsif ($type == 5) # null
{
$data = undef;
}
elsif ($type == 6) # undefined
{
$data = undef;
}
elsif ($type == 7) # flushed SharedObject containing 'public' properties
{
$data = $self->readFlushedSO();
}
elsif ($type == 8) # array
{
# shared object format only (*.sol)
# only time I saw it was the serverinfo value in a ColdFusion RecordSet
# It was just four zeroes - skip them.
for (my $i=0; $i<4; $i++)
{
$self->{inputStream}->readByte();
}
}
elsif ($type == 10) # array
{
$data = $self->readArray();
}
elsif ($type == 11) # date
{
$data = $self->readDate();
}
elsif ($type == 13) # mainly internal AS objects
{
$data = $self->readASObject();
}
elsif ($type == 15) # XML
{
$data = $self->readXML();
}
elsif ($type == 16) # Custom Class
{
$data = $self->readCustomClass();
}
else # unknown case
{
print STDERR "Unknown data type: $type\n";
}
return $data;
}
1;
lib/AMF/Perl/IO/Serializer.pm view on Meta::CPAN
=head1 CHANGES
=head2 Sun May 23 12:35:19 EDT 2004
=item Changed deduceType() to return the value too, as it may be changed inside, and to
handle empty string ('') as a string.
=head2 Wed Apr 14 11:06:28 EDT 2004
=item Made basic data type determination work for both scalars and scalarrefs.
=item Now we check if we are sending a recordset and setting column types accordingly.
=head2 Sat Mar 13 16:25:00 EST 2004
=item Patch from Tilghman Lesher that detects numbers and dates in strings
and sets return type accordingly.
=item Patch from Kostas Chatzikokolakis handling encoding and sending null value.
=head2 Sun May 11 16:43:05 EDT 2003
=item Changed writeData to set type to "NULL" when the incoming data is undef. Previously
it became a String, just like other scalars.
=item Changed PHP's writeRecordset to a generic writeAMFObject. Verified Recordset support.
=head2 Sun Mar 9 18:20:16 EST 2003
=item Function writeObject should return the same as writeHash. This assumes that all meaningful data
are stored as hash keys.
=cut
lib/AMF/Perl/IO/Serializer.pm view on Meta::CPAN
{
my ($self, $i)=@_;
my $body = $self->{amfout}->getBodyAt($i);
# write the responseURI header
$self->{out}->writeUTF($body->{"target"});
# write null, haven't found another use for this
$self->{out}->writeUTF($body->{"response"});
# always, always there is four bytes of FF, which is -1 of course
$self->{out}->writeLong(-1);
# write the data to the output stream
$self->writeData($body->{"value"}, $body->{"type"});
}
# writes a boolean
sub writeBoolean
{
my ($self, $d)=@_;
# write the boolean flag
$self->{out}->writeByte(1);
# write the boolean byte
$self->{out}->writeByte($d);
lib/AMF/Perl/IO/Serializer.pm view on Meta::CPAN
sub writeXML
{
my ($self, $d)=@_;
$self->{out}->writeByte(15);
#$self->{out}->writeLongUTF(utf8_encode($d));
from_to($d, $self->{encoding}, "utf8") if $self->{encoding};
$self->{out}->writeLongUTF($d);
}
# must be used PHPRemoting with the service to set the return type to date
# still needs a more in depth look at the timezone
sub writeDate
{
my ($self, $d)=@_;
# write date code
$self->{out}->writeByte(11);
# write date (milliseconds from 1970)
$self->{out}->writeDouble($d);
# write timezone
# ?? this is wierd -- put what you like and it pumps it back into flash at the current GMT ??
lib/AMF/Perl/IO/Serializer.pm view on Meta::CPAN
# grab the total number of elements
my $len = scalar(@$d);
# write the numeric array code
$self->{out}->writeByte(10);
# write the count of items in the array
$self->{out}->writeLong($len);
# write all of the array elements
for(my $i=0 ; $i < $len ; $i++)
{
#If this is a basic data type in a recordset, consider the column type.
if (!(ref $d->[$i]) && $self->{__writingRecordset__})
{
my $type = $self->{__columnTypes__}->[$i];
$self->dispatchBySqlType($d->[$i], $type);
}
else
{
$self->writeData($d->[$i]);
}
}
}
sub dispatchBySqlType
{
my ($self, $data, $type) = @_;
if ($type && ($type == DBI::SQL_NUMERIC) || ($type == DBI::SQL_DECIMAL) || ($type == DBI::SQL_INTEGER) || ($type == DBI::SQL_SMALLINT) || ($type == DBI::SQL_FLOAT) || ($type == DBI::SQL_DOUBLE) || ($type == DBI::SQL_REAL))
{
$self->writeNumber($data);
}
else
{
$self->writeString($data);
}
}
sub writeHash
lib/AMF/Perl/IO/Serializer.pm view on Meta::CPAN
$self->{out}->writeByte(16);
# write the package name
$self->{out}->writeUTF($object->{_explicitType});
$self->{__columnTypes__} = $object->{__columnTypes__} if $object->{__columnTypes__};
# write the package's data
$self->writeObject($object);
delete $self->{__columnTypes__};
}
# main switch for dynamically determining the data type
# this may prove to be inadequate because perl isn't a typed
# language and some confusion may be encountered as we discover more data types
# to be passed back to flash
#All scalars are assumed to be strings, not numbers.
#Regular arrays and hashes are prohibited, as they are indistinguishable outside of perl context
#Only arrayrefs and hashrefs will work
# were still lacking dates, xml, and strings longer than 65536 chars
sub writeData
{
my ($self, $d, $type)=@_;
$type = "unknown" unless $type;
# **************** TO DO **********************
# Since we are now allowing the user to determine
# the datatype we have to validate the user's suggestion
# vs. the actual data being passed and throw an error
# if things don't check out.!!!!
# **********************************************
# get the type of the data by checking its reference name
#if it was not explicitly passed
if ($type eq "unknown")
{
if (!defined $d) # convert undef to null, but not "" or 0
{
$type = "NULL";
}
else
{
my $myRef = ref $d;
if (!$myRef || $myRef =~ "SCALAR")
{
if ($myRef) {
study $$myRef;
($type, $d) = $self->deduceType($$myRef);
} else {
($type, $d) = $self->deduceType($d);
}
}
elsif ($myRef =~ "ARRAY")
{
$type = "array";
}
elsif ($myRef =~ "HASH")
{
$type = "hash";
}
else
{
$type = "object";
}
}
}
#BOOLEANS
if ($type eq "boolean")
{
$self->writeBoolean($d);
}
#STRINGS
elsif ($type eq "string")
{
$self->writeString($d);
}
# DOUBLES
elsif ($type eq "double")
{
$self->writeNumber($d);
}
# INTEGERS
elsif ($type eq "integer")
{
$self->writeNumber($d);
}
# OBJECTS
elsif ($type eq "object")
{
$self->writeHash($d);
}
# ARRAYS
elsif ($type eq "array")
{
$self->writeArray($d);
}
# HASHAS
elsif ($type eq "hash")
{
$self->writeHash($d);
}
# NULL
elsif ($type eq "NULL")
{
$self->writeNull();
}
# UDF's
elsif ($type eq "user function")
{
}
elsif ($type eq "resource")
{
my $resource = get_resource_type($d); # determine what the resource is
$self->writeData($d, $resource); # resend with $d's specific resource type
}
# XML
elsif (lc($type) eq "xml")
{
$self->writeXML($d);
}
# Dates
elsif (lc($type) eq "date")
{
$self->writeDate($d);
}
# mysql recordset resource
elsif (lc($type) eq "amfobject") # resource type
{
# write the record set to the output stream
$self->writeAMFObject($d); # writes recordset formatted for Flash
}
else
{
print STDERR "Unsupported Datatype $type in AMF::Perl::IO::Serializer";
die;
}
}
sub deduceType
{
my ($self, $scalar) = @_;
my $type = "string";
if ($scalar =~ m/^(\d{4})\-(\d{2})\-(\d{2})( (\d{2}):(\d{2}):(\d{2}))?$/)
{
# Handle "YYYY-MM-DD" and "YYYY-MM-DD HH:MM:SS"
require POSIX;
if ($4) {
$scalar = POSIX::mktime($7,$6,$5,$3,$2 - 1,$1 - 1900) * 1000;
} else {
$scalar = POSIX::mktime(0,0,0,$3,$2 - 1,$1 - 1900) * 1000;
}
$type = "date";
} elsif ($scalar =~ m/[^0-9\.\-]/) {
$type = "string";
} elsif ($scalar =~ m/\..*\./) {
# More than 1 period (e.g. IP address)
$type = "string";
} elsif (($scalar =~ m/.\-/) or ($scalar eq '-')) {
# negative anywhere but at the beginning
$type = "string";
} elsif ($scalar =~ m/\./) {
$type = "double";
} elsif ($scalar eq '') {
$type = "string";
} else {
$type = "integer";
}
return ($type, $scalar);
}
1;
lib/AMF/Perl/Sql/MysqlRecordSet.pm view on Meta::CPAN
Translated from PHP Remoting v. 0.5b from the -PHP project.
=head1 DESCRIPTION
Encode the information returned by a Mysql query into the AMF RecordSet format.
=head1 CHANGES
=head2 Wed Apr 14 11:06:28 EDT 2004
=item Started taking column types from statement handle.
=head2 Sun Jul 27 16:50:28 EDT 2003
=item Moved the formation of the query object into Util::Object->pseudo_query().
=head2 Sun May 11 18:22:33 EDT 2003
=item Since Serializer now supports generic AMFObjects, made sure we conform.
We need to have the _explicitType attribute...
lib/AMF/Perl/Util/Object.pm view on Meta::CPAN
Translated from PHP Remoting v. 0.5b from the -PHP project.
=head1 DESCRIPTION
Package used for building and retreiving header and body information
=head1 CHANGES
=head2 Wed Apr 14 11:06:28 EDT 2004
=item Saving column types in the __columnTypes__ field for the recordset object.
Sun Jul 27 16:52:12 EDT 2003
=item Added the pseudo_query() method to create a recordset object wanted by Flash.
=cut
use strict;
# constructor
lib/AMF/Perl/Util/Object.pm view on Meta::CPAN
# adds a body to our bodys object
# requires three arguments target, response, and value
sub addBody
{
my ($self, $t, $r, $v, $ty)=@_;
$ty="unknown" unless $ty;
my $body = {};
$body->{"target"} = $t;
$body->{"response"} = $r;
$body->{"value"} = $v;
$body->{"type"} = $ty;
push @{$self->{_bodies}}, $body;
}
# returns the number of body elements
sub numBody
{
my ($self)=@_;
return scalar(@{$self->{_bodies}});
}
# returns the body element at a specific index
sub getBodyAt
( run in 1.664 second using v1.01-cache-2.11-cpan-df04353d9ac )