AMF-Perl
view release on metacpan or search on metacpan
doc/code.html view on Meta::CPAN
<table>
<tr><th>Perl</th><th>Python</th></tr>
<tr>
<td valign=top>
<textarea cols=50 rows=40>
use AMF::Perl;
package Foo;
sub new
{
my ($proto)=@_;
my $self={};
bless $self, $proto;
return $self;
}
sub bar
{
my ($self, $arg1, $arg2) = @_;
my $value;
#Compute a return value
#...
return $value;
}
doc/code.html view on Meta::CPAN
<br>
<h3>Part 2. Sample class in the registered directory.</h3>
<table>
<tr><th>Perl</th><th>Python</th></tr>
<tr>
<td valign=top>
<textarea cols=50 rows=40>
package DataEcho;
sub new
{
my ($proto)=@_;
my $self={};
bless $self, $proto;
return $self;
}
sub echoNormal
{
my ($self, $data) = @_;
return $data;
}
sub echoDate
{
my ($self, $data) = @_;
return $data;
}
sub echoXML
{
my ($self, $data) = @_;
return $data;
}
sub methodTable
{
return {
"echoNormal" => {
"description" => "Echoes the passed argument back to Flash (no need to set the return t
ype)",
"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
remoteService = connection.getService("CpuUsage", this);
remoteService.getCpuUsage();
=cut
use AMF::Perl;
package cpuUsage;
sub new
{
my ($proto)=@_;
my $self={};
bless $self, $proto;
return $self;
}
sub getCpuUsage
{
my $output = `uptime`;
my @tokens = split /\s+/, $output;
#Remove commas.
@tokens = map {s/,//g; $_} @tokens;
my @array;
my %hash = ("Name" => 'L 1', "Value" => $tokens[10]);
push @array, \%hash;
my %hash1 = ("Name" => 'L 5', "Value" => $tokens[11]);
doc/examples/basic/basicservices/DataEcho.pm view on Meta::CPAN
Sun Apr 6 14:24:00 EST 2003
Created after AMF-PHP.
=cut
use AMF::Perl qw/amf_throw/;
sub new
{
my ($proto)=@_;
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"
doc/examples/basic/basicservices/DataEcho.pm view on Meta::CPAN
"access" => "remote", # available values are private, public, remote
"returns" => "xml"
},
"generateError" => {
"description" => "Throw an error so that _status, not _result on the client side is called",
"access" => "remote", # available values are private, public, remote
},
};
}
sub echoNormal
{
my ($self, $data) = @_;
return $data;
}
sub echoDate
{
my ($self, $data) = @_;
return $data;
}
sub echoXML
{
my ($self, $data) = @_;
return $data;
}
#This function will NOT return the value, because the call to amf_throw() will interrupt
#the control flow and cause the _Status function on the client to be called.
sub generateError
{
my ($self, $data) = @_;
amf_throw("An error!!!");
return "No error";
}
1;
doc/examples/cpu/cpu.pl view on Meta::CPAN
remoteService = connection.getService("CpuUsage", this);
remoteService.getCpuUsage();
=cut
use AMF::Perl;
package cpuUsage;
sub new
{
my ($proto)=@_;
my $self={};
bless $self, $proto;
return $self;
}
sub getCpuUsage
{
my ($self, $arg1, $arg2) = @_;
my $output = `uptime`;
my @tokens = split /\s+/, $output;
#Remove commas.
@tokens = map {s/,//g; $_} @tokens;
my @array;
my %hash = ("Name" => 'L 1', "Value" => $tokens[10]);
push @array, \%hash;
doc/examples/dataGrid/dataGrid.pl view on Meta::CPAN
remoteService = connection.getService("CpuUsage", this);
remoteService.getCpuUsage();
=cut
use AMF::Perl;
package DataGridModel;
sub new
{
my ($proto)=@_;
my $self={};
bless $self, $proto;
return $self;
}
sub getData
{
my ($self, $arg1, $arg2) = @_;
my @array;
my %hash = ("From" => 'Simon', "Subject" =>'AMF::Perl presentation', "URL" => "http://www.simonf.com");
push @array, \%hash;
my %hash1 = ("From" => 'Adrian', "Subject" =>'GUI in Flash', "URL" => "http://www.dnalc.org");
push @array, \%hash1;
my %hash2 = ("From" => 'James', "Subject" =>'How to get here from Penn station', "URL" => "http://www.cpan.org");
push @array, \%hash2;
return \@array;
doc/examples/petmarket/petmarket/api/cartservice.pm view on Meta::CPAN
use warnings;
no warnings "uninitialized";
use strict;
use petmarket::api::dbConn;
use vars qw/@ISA/;
@ISA=("petmarket::api::dbConn");
use AMF::Perl::Util::Object;
sub methodTable
{
return {
"getStatesAndCountries" => {
"description" => "Returns list of states and countries.",
"access" => "remote",
},
"getCreditCards" => {
"description" => "Returns list of allowed credit cards.",
"access" => "remote",
},
doc/examples/petmarket/petmarket/api/cartservice.pm view on Meta::CPAN
"access" => "remote",
},
"deleteCartItem" => {
"description" => "Deletes the given item from the given cart and returns the new totals",
"access" => "remote",
},
};
}
sub getStatesAndCountries
{
my ($self) = @_;
my %locations;
my @states = (
"AL", "AK", "AR", "AZ", "CA", "CO", "CT", "DC", "DE", "FL", "GA", "GU", "HI", "IA",
"ID", "IL", "IN", "KS", "KY", "LA", "MA", "MD", "ME", "MI", "MN", "MO", "MS", "MT",
"NC", "ND", "NE", "NH", "NJ", "NM", "NV", "NY", "OH", "OK", "OR", "PA", "PR", "RI",
"SC", "SD", "TN", "TX", "UT", "VA", "VI", "VT", "WA", "WI", "WV", "WY"
);
my @countries = ("USA");
$locations{"STATES_array"} = \@states;
$locations{"COUNTRIES_array"} = \@countries;
return \%locations;
}
sub getCreditCards
{
my ($self) = @_;
my @cards = ("American Express", "Discover/Novus", "MasterCard", "Visa");
return \@cards;
}
sub getShippingMethods
{
my @columns = ("shippingoid", "shippingname", "shippingdescription", "shippingprice", "shippingdays");
my @names = ("Ground", "2nd Day Air", "Next Day Air", "3 Day Select");
my @descriptions = (
"Prompt, dependable, low-cost ground delivery makes Ground an excellent choice for all your routine shipments. Ground reaches every address throughout the 48 contiguous states.",
"2nd Day Air provides guaranteed on-time delivery to every address throughout the United States (excluding intra-Alaska shipments) and Puerto Rico by the end of the second business day. This service is an economical alternative for time-sensi...
"Next Day Air features fast, reliable delivery to every address in all 50 states and Puerto Rico. We guarantee delivery by 10:30 a.m., noon, or end of day the next business day depending on destination (noon or 1:30 p.m. on Saturdays).",
"The ideal mix of economy and guaranteed on-time delivery, 3 Day Select guarantees delivery within three business days to and from every address in the 48 contiguous states."
);
my @prices = (13.00, 26.00, 39.00, 18.00);
doc/examples/petmarket/petmarket/api/cartservice.pm view on Meta::CPAN
push @row, $descriptions[$i];
push @row, $prices[$i];
push @row, $days[$i];
push @methods, \@row;
}
return AMF::Perl::Util::Object->pseudo_query(\@columns, \@methods);
}
sub validateCartOID
{
my ($self, $id) = @_;
return $id;
}
sub newCart
{
my ($self) = @_;
my ($id, $count);
do
{
$id = "cart" . time() . "." . (int(rand 1000000) + 1);
my $ary_ref = $self->dbh->selectall_arrayref("SELECT count(*) FROM cart_details WHERE cartid = '$id'");
$count = $ary_ref->[0]->[0];
}
while ($count > 0);
$self->dbh->do("INSERT INTO cart_details SET cartid='$id'");
return $id;
}
#TODO - where does the item quantity come from?
sub getCartItems
{
my ($self, $cartid) = @_;
my @result;
my $ary_ref = $self->dbh->selectall_arrayref("SELECT d.quantity, a.productid, a.itemid, unitcost, b.descn, attr1, c.name,e.catid FROM item a, item_details b, product_details c, cart_details d, product e WHERE a.itemid=b.itemid AND a.productid= c....
foreach my $rowRef (@$ary_ref)
{
my ($cartQuantity, $productid, $itemid, $unitcost, $descn, $attr, $productname, $catid) = @$rowRef;
my @row;
push @row, $itemid;
push @row, 999;
doc/examples/petmarket/petmarket/api/cartservice.pm view on Meta::CPAN
push @row, $catid;
push @row, "888888";
push @result, \@row;
}
my @columnNames = ("ITEMOID", "ITEMQUANTITY", "ITEMID", "ITEMNAME", "QUANTITY", "PRODUCTOID", "LISTPRICE", "DESCRIPTION", "NAME", "CATEGORYOID", "COLOR");
return AMF::Perl::Util::Object->pseudo_query(\@columnNames, \@result);
}
sub getCartTotal
{
my ($self, $cartid) = @_;
my ($count, $total);
my $ary_ref = $self->dbh->selectall_arrayref("SELECT unitcost, quantity FROM cart_details a, item_details b WHERE a.itemid=b.itemid AND a.cartid='$cartid'");
foreach my $rowRef (@$ary_ref)
{
my ($unitcost, $quantity) = @$rowRef;
$total += $quantity * $unitcost;
$count += $quantity;
}
my $result = new AMF::Perl::Util::Object;
$result->{total} = $total;
$result->{count} = $count;
return $result;
}
sub addCartItem
{
my ($self, $cartid, $itemid, $quantity) = @_;
$self->dbh->do("INSERT INTO cart_details SET cartid='$cartid', itemid='$itemid', quantity=$quantity");
my $result = $self->getCartTotal($cartid);
$result->{"itemoid"} = $itemid;
return $result;
}
sub updateCartItem
{
my ($self, $cartid, $itemid, $quantity) = @_;
$self->deleteCartItem($cartid, $itemid);
return $self->addCartItem($cartid, $itemid, $quantity);
}
sub deleteCartItem
{
my ($self, $cartid, $itemid) = @_;
$self->dbh->do("DELETE FROM cart_details WHERE cartid='$cartid' AND itemid='$itemid'");
my $result = $self->getCartTotal($cartid);
$result->{"itemoid"} = $itemid;
return $result;
}
1;
doc/examples/petmarket/petmarket/api/catalogservice.pm view on Meta::CPAN
use warnings;
use strict;
use petmarket::api::dbConn;
use vars qw/@ISA/;
@ISA=("petmarket::api::dbConn");
use Flash::FLAP::Util::Object;
sub methodTable
{
return {
"getCategories" => {
"description" => "Returns list of categories",
"access" => "remote",
"returns" => "AMFObject"
},
"getProducts" => {
"description" => "Returns list of products",
"access" => "remote",
doc/examples/petmarket/petmarket/api/catalogservice.pm view on Meta::CPAN
},
"searchProducts" => {
"description" => "Returns products whose name (or whose category's name) matches a string",
"access" => "remote",
"returns" => "AMFObject"
},
};
}
sub getCategories
{
my ($self) = @_;
my @result;
my $ary_ref = $self->dbh->selectall_arrayref("SELECT catid, name FROM category_details");
foreach my $rowRef (@$ary_ref)
{
my ($catid, $name) = @$rowRef;
my @row;
push @row, $catid;
push @row, $name;
doc/examples/petmarket/petmarket/api/catalogservice.pm view on Meta::CPAN
push @row, "888888";
push @result, \@row;
}
my @columnNames = ("CATEGORYOID", "CATEGORYDISPLAYNAME", "CATEGORYNAME", "COLOR");
return Flash::FLAP::Util::Object->pseudo_query(\@columnNames, \@result);
}
sub getProducts
{
my ($self, $catid) = @_;
my @result;
my $ary_ref = $self->dbh->selectall_arrayref("SELECT catid, a.productid, name, image, descn FROM product a, product_details b WHERE a.productid=b.productid AND catid='$catid'");
foreach my $rowRef (@$ary_ref)
{
my ($catid, $productid, $name, $image, $descn) = @$rowRef;
my @row;
push @row, $catid;
push @row, $productid;
doc/examples/petmarket/petmarket/api/catalogservice.pm view on Meta::CPAN
push @row, $descn;
push @result, \@row;
}
my @columnNames = ("CATEGORYOID", "PRODUCTOID", "PRODUCTID", "NAME", "IMAGE", "DESCRIPTION");
return Flash::FLAP::Util::Object->pseudo_query(\@columnNames, \@result);
}
sub getItems
{
my ($self, $productid) = @_;
my @result;
my $ary_ref = $self->dbh->selectall_arrayref("SELECT a.productid, a.itemid, unitcost, b.descn, attr1, c.name FROM item a, item_details b, product_details c WHERE a.itemid=b.itemid AND a.productid=c.productid AND c.productid='$productid'");
foreach my $rowRef (@$ary_ref)
{
my ($productid, $itemid, $unitcost, $descn, $attr, $productname) = @$rowRef;
my @row;
push @row, $itemid;
push @row, $itemid;
doc/examples/petmarket/petmarket/api/catalogservice.pm view on Meta::CPAN
push @row, $productname;
push @row, $productid;
push @result, \@row;
}
my @columnNames = ("ITEMOID", "ITEMID", "ITEMNAME", "QUANTITY", "PRODUCTIOID", "LISTPRICE", "DESCRIPTION", "NAME", "CATEGORYOID");
return Flash::FLAP::Util::Object->pseudo_query(\@columnNames, \@result);
}
sub searchProducts
{
my ($self, $query) = @_;
my @result;
my @catids;
my $ary_ref = $self->dbh->selectall_arrayref("SELECT a.catid FROM category a, category_details b WHERE a.catid=b.catid AND b.name like '%$query%'");
foreach my $rowRef (@$ary_ref)
{
my ($catid) = @$rowRef;
push @catids, $catid;
doc/examples/petmarket/petmarket/api/dbConn.pm view on Meta::CPAN
use strict;
my $dbhost = "localhost";
my $dbname = "database";
my $dbuser = "user";
my $dbpass = "password";
use DBI;
use AMF::Perl::Sql::MysqlRecordSet;
sub new
{
my ($proto) = @_;
my $self = {};
bless $self, $proto;
my $dbh = DBI->connect("DBI:mysql:host=$dbhost:db=$dbname","$dbuser","$dbpass",{ PrintError=>1, RaiseError=>1 }) or die "Unable to connect: " . $DBI::errstr . "\n";
$self->dbh($dbh);
my $recordset = AMF::Perl::Sql::MysqlRecordSet->new($dbh);
$self->recordset($recordset);
return $self;
}
sub recordset
{
my ($self, $val) = @_;
$self->{recordset} = $val if $val;
return $self->{recordset};
}
sub dbh
{
my ($self, $val) = @_;
$self->{dbh} = $val if $val;
return $self->{dbh};
}
1;
doc/examples/petmarket/petmarket/api/orderservice.pm view on Meta::CPAN
#This is server side for the Macromedia's Petmarket example.
#See http://www.simonf.com/amfperl for more information.
use warnings;
use strict;
use petmarket::api::dbConn;
use vars qw/@ISA/;
@ISA=("petmarket::api::dbConn");
sub methodTable
{
return {
"placeOrder" => {
"description" => "Empties the cart",
"access" => "remote",
},
};
}
sub placeOrder
{
my ($self, $userid, $cartid) = @_;
$self->dbh->do("DELETE FROM cart_details WHERE cartid='$cartid'");
}
1;
doc/examples/petmarket/petmarket/api/stringresourcesservice.pm view on Meta::CPAN
# under the same terms as Perl itself.
#This is server side for the Macromedia's Petmarket example.
#See http://www.simonf.com/amfperl for more information.
use warnings;
use strict;
my %bundle;
sub new
{
my ($proto) = @_;
my $self = {};
bless $self, $proto;
return $self;
}
sub methodTable
{
return {
"getAppStrings" => {
"description" => "Returns app strings",
"access" => "remote",
},
"getAboutUsStrings" => {
"description" => "Returns 'about us' strings",
"access" => "remote",
},
doc/examples/petmarket/petmarket/api/stringresourcesservice.pm view on Meta::CPAN
"access" => "remote",
},
"getAffiliateStrings" => {
"description" => "Returns affiliate strings",
"access" => "remote",
},
};
}
sub getAppStrings
{
my ($self, $locale) = @_;
unless (%bundle)
{
my %strings;
$strings{"HOME_MODE_TITLE_str"}="Home";
$strings{"BROWSE_MODE_TITLE_str"}="Browse";
$strings{"CHECKOUT_MODE_TITLE_str"}="Checkout";
doc/examples/petmarket/petmarket/api/stringresourcesservice.pm view on Meta::CPAN
$strings{"MONTH_NAMES_array"}=\@months;
$strings{"WEEKDAY_NAMES_array"}=\@weekdays;
$strings{"EXP_YEARS_array"}=\@years;
%bundle = %strings;
}
return \%bundle;
}
sub getAboutUsStrings()
{
my ($self) = @_;
my %strings;
$strings{"HEAD_str"} = "ABOUT US";
$strings{"BODY_HTML_str"} = "The Pet Market application illustrates how Macromedia MX products work together, and integrate with standard server technologies, to deliver a rich, dynamic Internet application.\n\nWith a demo, code samples, developm...
$strings{"logoFrameLabel"} = "macr";
$strings{"url"} = "http://www.macromedia.com";
return \%strings;
}
sub getLegalStrings()
{
my ($self) = @_;
my %strings;
$strings{"HEAD_str"} = "LEGAL INFORMATION";
$strings{"BODY_HTML_str"} = "Copyright © 2001-2002 Macromedia, Inc. All rights reserved. Macromedia, the Macromedia logo, and Flash are trademarks or registered trademarks of Macromedia, Inc.\n \nMany of the images used in this experience were ...
$strings{"logoFrameLabel"} = "macr";
$strings{"url"} = "http://www.macromedia.com";
return \%strings;
}
sub getAffiliateStrings()
{
my ($self) = @_;
my %strings;
$strings{"HEAD_str"} = "SITE DESIGN";
$strings{"BODY_HTML_str"} = "We chose Popular Front to design the Pet Market shopping experience because of their demonstrated ability to enhance user experiences with our technologies. Popular Front has created numerous award-winning solutions t...
$strings{"logoFrameLabel"} = "PopularFront";
$strings{"url"} = "http://www.popularfront.com";
return \%strings;
}
doc/examples/petmarket/petmarket/api/userservice.pm view on Meta::CPAN
use warnings;
use strict;
use petmarket::api::dbConn;
use vars qw/@ISA/;
@ISA=("petmarket::api::dbConn");
use AMF::Perl::Util::Object;
sub methodTable
{
return {
"addUser" => {
"description" => "Add a user with the given credentials",
"access" => "remote",
},
"getUser" => {
"description" => "Add a user with the given credentials",
"access" => "remote",
},
doc/examples/petmarket/petmarket/api/userservice.pm view on Meta::CPAN
};
}
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'");
return $ary_ref->[0]->[0] > 0;
}
sub addUser
{
my ($self, $email, $password) = @_;
$self->dbh->do("INSERT INTO user_details set email='$email', password='$password'");
my $result = new AMF::Perl::Util::Object;
$result->{"useroid"} = $email;
$result->{"email"} = $email;
$result->{"password"} = $password;
return $result;
}
sub getUser
{
my ($self, $email, $password) = @_;
return 0 unless $self->authenticate($email, $password);
my $result = new AMF::Perl::Util::Object;
my $hash_ref = $self->dbh->selectall_hashref("SELECT * FROM user_details WHERE email='$email'", "email");
my $rowRef = $hash_ref->{$email};
foreach my $field (@fields)
{
$result->{$field} = $rowRef->{$field};
}
$result->{useroid} = $email;
return $result;
}
sub updateUser
{
my ($self, $userObject) = @_;
return 0 unless $self->authenticate($userObject->{"email"}, $userObject->{"password"});
my $setString = "";
my @setStringArray = map {"$_='".$userObject->{$_}."'"} @userFields;
$setString = join ",", @setStringArray;
doc/examples/sql/parkservices/ParkService.pm view on Meta::CPAN
use AMF::Perl::Sql::MysqlRecordSet;
my $dbhost = "localhost";
my $dbname = "database";
my $dbuser = "user";
my $dbpass = "password";
use DBI;
sub new
{
my ($proto) = @_;
my $self = {};
bless $self, $proto;
my $dbh = DBI->connect("DBI:mysql:host=$dbhost:db=$dbname","$dbuser","$dbpass",{ PrintError=>1, RaiseError=>1 })
or die "Unable to connect: " . $DBI::errstr . "\n";
my $recordset = AMF::Perl::Sql::MysqlRecordSet->new($dbh);
$self->recordset($recordset);
return $self;
}
sub recordset
{
my ($self, $val) = @_;
$self->{recordset} = $val if $val;
return $self->{recordset};
}
sub dbh
{
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",
doc/examples/sql/parkservices/ParkService.pm view on Meta::CPAN
},
"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."'");
}
1;
lib/AMF/Perl.pm view on Meta::CPAN
# load the required system packagees
use AMF::Perl::IO::InputStream;
use AMF::Perl::IO::Deserializer;
use AMF::Perl::App::Executive;
use AMF::Perl::IO::Serializer;
use AMF::Perl::IO::OutputStream;
use AMF::Perl::Util::Object;
# constructor
sub new
{
my ($proto) = @_;
my $class = ref($proto) || $proto;
my $self = {};
bless $self, $class;
$self->{exec} = new AMF::Perl::App::Executive();
$self->{"response"} = "/onResult";
$self->{debug}=0;
return $self;
}
sub debug
{
my $self = shift;
if (@_) {$self->{debug} = shift;}
return $self->{debug};
}
sub service
{
my ($self)=@_;
my $inputStream;
my $content = "";
#Otherwise Apache on Windows treats 0x1a as EOF.
binmode STDIN;
if($ENV{MOD_PERL})
lib/AMF/Perl.pm view on Meta::CPAN
{
#$content = do { local $/, <> }; #This does not work under IIS
read(STDIN, $content, $ENV{'CONTENT_LENGTH'});
#read the whole STDIN into one variable
}
$self->_service($content);
}
sub fromFile
{
my ($self, $file) = @_;
$file = $self->debugDir."input.amf" unless $file;
# temporary load the contents from a file
my $content = $self->_loadRawDataFromFile($file);
# build the input stream object from the file contents
my $inputStream = new AMF::Perl::IO::InputStream($content);
# build the deserializer and pass it a reference to the inputstream
my $deserializer = new AMF::Perl::IO::Deserializer($inputStream, $self->{encoding});
# get the returned Object
my $amfin = $deserializer->getObject();
return $amfin;
}
sub _service
{
my ($self, $content) = @_;
if($self->debug)
{
# WATCH OUT, THIS IS NOT THREAD SAFE, DON'T USE IN CONCURRENT ENVIRONMENT
# temporary load the contents from a file
$content = $self->_loadRawDataFromFile($self->debugDir."/input.amf");
# save the raw amf data to a file
lib/AMF/Perl.pm view on Meta::CPAN
my $response = $outstream->flush();
#Necessary on Windows to prevent conversion of 0a to 0d0a.
binmode STDOUT;
$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);
lib/AMF/Perl.pm view on Meta::CPAN
{
print <<EOF;
Content-Type: application/x-amf
Content-Length: $resLength
$response
EOF
}
}
sub debugDir
{
my ($self, $dir) = @_;
$self->{debugDir} = $dir if $dir;
return $self->{debugDir};
}
sub setBaseClassPath
{
my ($self, $path) = @_;
if (-d $path)
{
$self->{exec}->setBaseClassPath($path);
}
else
{
print STDERR "Directory $path does not exist and could not be registered.\n";
die;
}
}
sub registerService
{
my ($self, $package, $servicepackage) = @_;
$self->{exec}->registerService($package, $servicepackage);
}
sub constructException
{
my ($description) = @_;
my $stack = Devel::StackTrace->new();
my %result;
$description = "An error occurred" unless $description;
$result{"description"} = $description;
$result{"exceptionStack"} = $stack->as_string;
my @frames = $stack->frames;
$result{"details"} = $frames[1]->filename();
$result{"line"} = $frames[1]->line();
$result{"level"} = "Error";
$result{"code"} = "1";
return \%result;
}
sub amf_throw
{
my ($description) = @_;
AMFException->throw( error => constructException($description) );
}
sub setSafeExecution
{
my ($self, $safe) = @_;
print STDERR "There is no need to call setSafeExecution anymore!\n";
}
sub encoding
{
my $self = shift;
$self->{encoding} = shift if @_;
return $self->{encoding};
}
# usefulldebugging method
# You can save the raw data sent from the
# flash client by calling
# $self->_saveRawDataToFile("file.amf", $contents);
sub _saveRawDataToFile
{
my ($self, $filepath, $data)=@_;
# open the file for writing
if (!open(HANDLE, "> $filepath"))
{
die "Could not open file $filepath: $!\n";
}
# write to the file
if (!print HANDLE $data)
{
die "Could not print to file $filepath: $!\n";
}
# close the file resource
close HANDLE;
}
sub _appendRawDataToFile
{
my ($self, $filepath, $data) = @_;
# open the file for writing
if (!open (HANDLE, ">>$filepath"))
{
die "Could not open file $filepath: $!\n";
}
# write to the file
if (!print HANDLE $data)
{
die "Could not print to file $filepath: $!\n";
}
# close the file resource
close HANDLE;
}
# get contents of a file into a string
sub _loadRawDataFromFile
{
my ($self, $filepath)=@_;
# open a handle to the file
open (HANDLE, $filepath);
# read the entire file contents
my @contents = <HANDLE>;
# close the file handle
close HANDLE;
# return the contents
return join "", @contents;
}
sub log
{
my ($self, $content) = @_;
$self->_appendRawDataToFile ($self->debugDir."processing.txt",$content."\n");
}
1;
__END__
lib/AMF/Perl/App/Executive.pm view on Meta::CPAN
# 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
#my $_headerFilter;
# constructor
sub new
{
my ($proto)=@_;
my $self={};
bless $self, $proto;
return $self;
# nothing really to do here yet?
}
# setter for the _headerFilter
sub setHeaderFilter
{
my ($self, $header) = @_;
$self->{_headerFilter} = $header;
}
# Set the base classpath. This is the path from which will be search for the packagees and functions
# $basecp should end with a "/";
sub setBaseClassPath
{
my ($self, $basecp) = @_;
$self->{_basecp} = $basecp;
}
sub setInstanceName
{
my ($self, $name) = @_;
$self->{_instanceName} = $name;
}
# you pass directory.script.method to this and it will build
# the classpath, classname and methodname values
sub setTarget
{
my ($self, $target)=@_;
$self->{target} = $target;
# grab the position of the last . char
my $lpos = strrpos($target, ".");
# there were none
unless ($lpos)
{
print STDERR "Service name $target does not contain a dot.\n";
# throw an error because there has to be atleast 1
lib/AMF/Perl/App/Executive.pm view on Meta::CPAN
{
# the method name is the very last part
$self->{_methodname} = substr($target, $lpos+1);
}
# truncate the method name from the string
my $trunced = substr($target, 0, $lpos);
$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) = @_;
#First try to call a registered class...
my $package = $self->{_classname};
my $method = $self->{_methodname};
my $calledMethod = $method;
if(exists $self->{services}->{$package})
lib/AMF/Perl/App/Executive.pm view on Meta::CPAN
}
else
{
# print STDERR with error
print STDERR "Function " . $calledMethod . " does not exist in class ".$self->{_classConstruct}.".\n";
}
}
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;
lib/AMF/Perl/App/Executive.pm view on Meta::CPAN
# set the default return type of "unknown"
else
{
$self->{_returnType} = "unknown";
}
}
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
# the number of headers in the packet
my $header_count;
# the content of the headers
my $headers;
# the number of body elements
my $body_count;
# the content of the body
my $body;
sub floor
{
my $n = shift;
return int($n) - ($n < 0 ? 1: 0) * ($n != int($n) ? 1 : 0);
}
#******************** PUBLIC METHODS ****************************/
# constructor that also dserializes the raw data
sub new
{
my ($proto, $is, $encoding)=@_;
my $self = {};
bless $self, $proto;
# the object to store the deserialized data
$self->{amfdata} = new AMF::Perl::Util::Object();
# save the input stream in this object
$self->{inputStream} = $is;
# save the encoding in this object
$self->{encoding} = $encoding;
# read the binary header
$self->readHeader();
# read the binary body
$self->readBody();
return $self;
}
# returns the instance of the Object package
sub getObject
{
my ($self)=@_;
return $self->{amfdata};
}
#******************** PRIVATE METHODS ****************************/
sub readHeader
{
my ($self)=@_;
# 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();
lib/AMF/Perl/IO/Deserializer.pm view on Meta::CPAN
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();
lib/AMF/Perl/IO/Deserializer.pm view on Meta::CPAN
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())
{
lib/AMF/Perl/IO/Deserializer.pm view on Meta::CPAN
# 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
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;
}
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();
}
# read the next byte and return it's boolean value
sub readBoolean
{
my ($self)=@_;
# grab the int value of the next byte
my $int = $self->{inputStream}->readByte();
# if it's a 0x01 return true else return false
return ($int == 1);
}
sub readString
{
my ($self)=@_;
my $s = $self->{inputStream}->readUTF();
from_to($s, "utf8", $self->{encoding}) if $self->{encoding};
return $s;
}
sub readDate
{
my ($self)=@_;
my $ms = $self->{inputStream}->readDouble(); # date in milliseconds from 01/01/1970
# nasty way to get timezone
my $int = $self->{inputStream}->readInt();
if($int > 720)
{
$int = -(65536 - $int);
}
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
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
{
lib/AMF/Perl/IO/InputStream.pm view on Meta::CPAN
=head2 Sun Jul 11 18:45:40 EDT 2004
=item Added the check for endianness.
=cut
use strict;
#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}};
lib/AMF/Perl/IO/InputStream.pm view on Meta::CPAN
}
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];
lib/AMF/Perl/IO/InputStream.pm view on Meta::CPAN
my $thisNum = defined($thisByte) ? ord($thisByte) : 0;
my $nextNum = defined($nextByte) ? ord($nextByte) : 0;
my $result = (($thisNum) << 8) | $nextNum;
$self->{current_byte} += 2;
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
lib/AMF/Perl/IO/InputStream.pm view on Meta::CPAN
}
# move the seek head forward 8 bytes
$self->{current_byte} += 8;
# 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;
lib/AMF/Perl/IO/OutputStream.pm view on Meta::CPAN
=item Added the check for endianness.
=cut
use strict;
#OutputStream constructor
sub new
{
my ($proto)=@_;
# the buffer
my $self = {};
bless $self, $proto;
$self->{outBuffer} = "";
if (unpack("h*", pack("s", 1)) =~ /01/)
{
$self->{byteorder} = 'big-endian';
}
else
{
$self->{byteorder} = 'little-endian';
}
return $self;
}
# write a single byte
sub writeByte
{
my ($self, $b)=@_;
# use pack with the c flag
$self->{outBuffer} .= pack("c", $b);
}
# write 2 bytes
sub writeInt
{
my ($self, $n) = @_;
# use pack with the n flag
$self->{outBuffer} .= pack("n", $n);
}
# write 4 bytes
sub writeLong
{
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;
# atleast on *nix the bytes have to be reversed
# maybe not on windows, in php there in not flag to
# force whether the bytes are little or big endian
# for a double
my $r = "";
lib/AMF/Perl/IO/OutputStream.pm view on Meta::CPAN
}
else
{
$r = $b;
}
# add the bytes to the output
$self->{outBuffer} .= $r;
}
# send the output buffer
sub flush
{
my ($self) = @_;
# flush typically empties the buffer
# but this is not a persistent pipe so it's not needed really here
# plus it's useful to be able to flush to a file and to the client simultaneously
# with out have to create another method just to peek at the buffer contents.
return $self->{outBuffer};
}
1;
lib/AMF/Perl/IO/Serializer.pm view on Meta::CPAN
use strict;
use Encode qw/from_to/;
use DBI;
# holder for the data
my $data;
sub new
{
my ($proto, $stream, $encoding) = @_;
# save
my $self={};
bless $self, $proto;
$self->{out} = $stream;
$self->{encoding} = $encoding;
return $self;
}
sub serialize
{
my ($self, $d) = @_;
$self->{amfout} = $d;
# write the version ???
$self->{out}->writeInt(0);
# get the header count
my $count = $self->{amfout}->numHeader();
# write header count
$self->{out}->writeInt($count);
lib/AMF/Perl/IO/Serializer.pm view on Meta::CPAN
# write the body count
$self->{out}->writeInt($count);
for (my $i=0; $i<$count; $i++)
{
# start writing the body
$self->writeBody($i);
}
}
sub writeHeader
{
my ($self, $i)=@_;
# for all header values
# write the header to the output stream
# ignoring header for now
}
sub writeBody
{
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);
}
# writes a string under 65536 chars, a longUTF is used and isn't complete yet
sub writeString
{
my ($self, $d)=@_;
# write the string code
$self->{out}->writeByte(2);
# write the string value
#$self->{out}->writeUTF(utf8_encode($d));
from_to($d, $self->{encoding}, "utf8") if $self->{encoding};
$self->{out}->writeUTF($d);
}
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 ??
# have a look at the amf it creates...
$self->{out}->writeInt(0);
}
# write a number formatted as a double with the bytes reversed
# this may not work on a Win machine because i believe doubles are
# already reversed, to fix this comment out the reversing part
# of the writeDouble method
sub writeNumber
{
my ($self, $d)=@_;
# write the number code
$self->{out}->writeByte(0);
# write the number as a double
$self->{out}->writeDouble($d);
}
# write null
sub writeNull
{
my ($self)=@_;
# null is only a 0x05 flag
$self->{out}->writeByte(5);
}
# write array
# since everything in php is an array this includes arrays with numeric and string indexes
sub writeArray
{
my ($self, $d)=@_;
# 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);
lib/AMF/Perl/IO/Serializer.pm view on Meta::CPAN
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
{
my ($self, $d) = @_;
# this is an object so write the object code
$self->{out}->writeByte(3);
# write the object name/value pairs
$self->writeObject($d);
}
# writes an object to the stream
sub writeObject
{
my ($self, $d)=@_;
# loop over each element
while ( my ($key, $data) = each %$d)
{
# write the name of the object
$self->{out}->writeUTF($key);
if ($self->{__columnTypes__} && $key eq "initialData")
{
$self->{__writingRecordset__} = 1;
lib/AMF/Perl/IO/Serializer.pm view on Meta::CPAN
$self->{__writingRecordset__} = 0;
}
# write the end object flag 0x00, 0x00, 0x09
$self->{out}->writeInt(0);
$self->{out}->writeByte(9);
}
# write an AMF object
# The difference with regular object is that the code is different
# and the class name is explicitly sent. Good for RecordSets.
sub writeAMFObject
{
my ($self, $object)=@_;
# write the custom package code
$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__};
lib/AMF/Perl/IO/Serializer.pm view on Meta::CPAN
# 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.!!!!
# **********************************************
lib/AMF/Perl/IO/Serializer.pm view on Meta::CPAN
$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) {
lib/AMF/Perl/Sql/MysqlRecordSet.pm view on Meta::CPAN
=head2 Sun Apr 6 14:24:00 2003
=item Created after AMF-PHP, but something is not working yet...
=cut
use strict;
use AMF::Perl::Util::Object;
sub new
{
my ($proto, $dbh) = @_;
my $self = {};
bless $self, $proto;
$self->dbh($dbh);
return $self;
}
sub dbh
{
my ($self, $val) = @_;
$self->{dbh} = $val if $val;
return $self->{dbh};
}
sub query
{
my ($self, $queryText) = @_;
my $sth = $self->dbh->prepare($queryText);
$sth->execute();
my @initialData;
my $columnNames = $sth->{NAME};
lib/AMF/Perl/Util/Object.pm view on Meta::CPAN
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
sub new
{
my ($proto)=@_;
my $self = {};
bless $self, $proto;
# init the headers and bodys arrays
$self->{_headers} = [];
$self->{_bodies} = [];
return $self;
}
# adds a header to our object
# requires three arguments key, required, and value
sub addHeader
{
my ($self, $k, $r, $v)=@_;
my $header = {};
$header->{"key"} = $k;
$header->{"required"} = $r;
$header->{"value"} = $v;
push @{$self->{_headers}}, $header;
}
# returns the number of headers
sub numHeader
{
my ($self)=@_;
return scalar(@{$self->{_headers}});
}
sub getHeaderAt
{
my ($self, $id)=@_;
$id=0 unless $id;
return $self->{_headers}->[$id];
}
# 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
{
my ($self, $id)=@_;
$id=0 unless $id;
return $self->{_bodies}->[$id];
}
sub pseudo_query
{
my ($self, $columnNames, $data, $columnTypes) = @_;
my $result = new AMF::Perl::Util::Object;
# create the serverInfo array
$result->{"serverInfo"} = {};
# create an initialData array
my (@initialData, @columnNames);
$result->{serverInfo}->{initialData} = $data;
lib/AMF/Perl/Util/RemotingService.pm view on Meta::CPAN
=item Substituted "use vars qw($AUTOLOAD)" for "our $AUTOLOAD" to be backwards-compatible to Perl < 5.6
=head2 Sun Apr 6 14:24:00 2003
=item Created after AMF-PHP, though their dynamic inheritance is changed to wrapping.
=cut
use strict;
sub new
{
my ($proto, $name, $object) = @_;
my $self = {};
bless $self, $proto;
$self->serviceName($name);
$self->content($object);
return $self;
}
sub content
{
my $self = shift;
if (@_) {$self->{content} = shift;}
return $self->{content};
}
sub serviceName
{
my $self = shift;
if (@_) {$self->{serviceName} = shift;}
return $self->{serviceName};
}
sub methodTable
{
my ($self) = @_;
my $methodTable = $self->content->methodTable();
my $newEntry = {
"access" => "remote",
"description" => "This is the main method that returns the descriptors for the service class."
};
$methodTable->{"__describeService"} = $newEntry;
return $methodTable;
}
use vars qw($AUTOLOAD);
sub AUTOLOAD
{
my ($self, @args) = @_;
#our $AUTOLOAD;
#Strip the class path and only leave the method name;
my @path = split /:/, $AUTOLOAD;
my $method = $path[-1];
return if $method eq "DESTROY";
lib/AMF/Perl/Util/RemotingService.pm view on Meta::CPAN
{
return $self->content->$method(@args);
}
else
{
print STDERR "\nUnknown method $method called:\n";
die;
}
}
sub __describeService
{
my ($self) = @_;
my $description = {};
$description->{"version"} = "1.0";
$description->{"address"} = $self->serviceName();
my @functions;
foreach my $key (keys %{$self->methodTable})
{
( run in 0.757 second using v1.01-cache-2.11-cpan-a5abf4f5562 )