AMF-Perl
view release on metacpan or search on metacpan
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.
doc/examples/petmarket/README.txt view on Meta::CPAN
README for the server side of the Macromedia Petstore implementation
1. Sources.
The original Macromedia client can be downloaded from
http://www.macromedia.com/devnet/mx/blueprint/
There are a few steps to get it working - you need to compile each movie separately, for example.
To make thing easier, a fully precompiled client side is provided at the AMF::Perl web site:
http://www.simonf.com/amfperl/examples/petmarket/index.html
(Unlike other examples, the client is NOT included into the AMF::Perl distribution due to its size.)
2. Usage.
lib/AMF/Perl.pm view on Meta::CPAN
==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
=over 4
=item Made printing output a separate function, requested by Scott Penrose.
=item Wrote exportable amf_throw() for exception handling.
=back
=head2 Thu Apr 29 17:20:07 EDT 2004
=over 4
=item Changed "use Apache2" to "require Apache2" to avoid breaking on non-modperl systems.
lib/AMF/Perl.pm view on Meta::CPAN
=over 4
=item Added "binmode STDIN" before reading input to prevent treating 0x1a as EOF on Windows.
=back
=head2 Wed Apr 23 19:22:56 EDT 2003
=over 4
=item Added "binmode STDOUT" before printing headers to prevent conversion of 0a to 0d0a on Windows.
=item Added modperl 1 support and (so far commented out) hypothetical modperl 2 support.
=back
=head2 Sun Mar 23 13:27:00 EST 2003
=over 4
=item Synching with AMF-PHP:
lib/AMF/Perl.pm view on Meta::CPAN
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
$response
EOF
}
}
sub debugDir
{
lib/AMF/Perl.pm view on Meta::CPAN
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);
}
lib/AMF/Perl.pm view on Meta::CPAN
{
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
lib/AMF/Perl.pm view on Meta::CPAN
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)=@_;
lib/AMF/Perl/App/Executive.pm view on Meta::CPAN
# 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
}
else
{
# 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);
lib/AMF/Perl/App/Executive.pm view on Meta::CPAN
push @INC, $self->{_basecp};
# build the class object
$package =~ s#\.#::#g;
unless (eval ("require " . $package))
{
# report back to flash that the class wasn't properly formatted
print STDERR "Class $package does not exist or could not be loaded.\n";
print STDERR $@;
return;
}
# build the construct from the extended class
my $object = $package->new;
# Check to see if the DescribeService header has been turned on
if ($self->{_headerFilter} && $self->{_headerFilter} eq "DescribeService")
{
my $wrapper = new AMF::Perl::Util::RemotingService($package, $object);
lib/AMF/Perl/App/Executive.pm view on Meta::CPAN
{
# map the _methodname to the alias
$method = $methodrecord{'alias'};
}
if (exists($methodrecord{'instance'}))
{
# 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"
lib/AMF/Perl/App/Executive.pm view on Meta::CPAN
if ( (exists($methodrecord{'access'})) && (lc ($methodrecord{'access'}) eq "remote"))
{
# finally check to see if the method existed
if ($self->{_classConstruct}->can($method))
{
# execute the method and return it's results to the gateway
return $self->{_classConstruct}->$method(@$a);
}
else
{
# print STDERR with error
print STDERR "Method " . $calledMethod . " does not exist in class ".$self->{_classConstruct}.".\n";
}
}
else
{
# print STDERR with error
print STDERR "Access Denied to " . $calledMethod . "\n";
}
}
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;
}
elsif(!$serviceobject)
{
print STDERR "Package ".$package." not registerd on server\n";
return;
}
elsif(!$serviceobject->can($method))
{
print STDERR "Function ".$method." does not exist in package ".$package."\n";
return;
}
else
{
$self->{_returnType} = "unknown";
if ($serviceobject->can("methodTable") && exists ($serviceobject->methodTable->{$method}))
{
# create a shortcut to the methodTable
my %methodrecord = %{$serviceobject->methodTable->{$method}};
lib/AMF/Perl/IO/Deserializer.pm view on Meta::CPAN
#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
{
lib/AMF/Perl/IO/Deserializer.pm view on Meta::CPAN
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
$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";
lib/AMF/Perl/Util/RemotingService.pm view on Meta::CPAN
my $method = $path[-1];
return if $method eq "DESTROY";
if ($self->content->can($method))
{
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();
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl 1.t'
#########################
# change 'tests => 1' to 'tests => last_test_to_print';
use Test;
BEGIN { plan tests => 1 };
use AMF::Perl;
ok(1); # If we made it this far, we're ok.
#########################
# Insert your test code below, the Test::More module is use()ed here so read
# its man page ( perldoc Test::More ) for help writing this test script.
( run in 0.373 second using v1.01-cache-2.11-cpan-de7293f3b23 )