AMF::Perl - Flash Remoting in Perl

        my $object = new MyClass();
        my $gateway = AMF::Perl->new;
        $gateway->registerService("Foo",$object);
        $gateway->service();

	my $gateway = AMF::Perl->new;
	$gateway->setBaseClassPath('./services');
	$gateway->service();

    Macromedia Flash Remoting server-side support.

	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.

package AMF::Perl;

use 5.00000;
use strict;

require Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
@ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use AMF::Perl ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
%EXPORT_TAGS = ( 'all' => [ qw(
	
) ] );

@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

@EXPORT = qw(amf_throw);

$VERSION = '0.15';

use Devel::StackTrace;
use Exception::Class ('AMFException');

# 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})
    {
        require mod_perl;
        my $MP2 = ($mod_perl::VERSION >= 1.99);
		if ($MP2)
		{
			require Apache2;
			require Apache::RequestUtil;  # needed for Apache->request
		}
        my $r = Apache->request();
        $r->read($content, $r->headers_in->{'Content-Length'});
    }
    else
    {
        #$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
        #$self->_saveRawDataToFile ($self->debugDir."/input.amf", $content);
    }
    
    # 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();
    
    # we can add much functionality with the headers here, like turn on server debugging, etc.
    my $headercount = $amfin->numHeader();
    
    for (my $i=0; $i<$headercount; $i++)
    {
        my $header = $amfin->getHeaderAt($i);
        if ($header->{'key'} eq "DescribeService")
        {
            $self->{exec}->setHeaderFilter("DescribeService");
        }
        # other headers like net debug config
        # and Credentials
    }

    
    # get the number of body elements
    my $bodycount = $amfin->numBody();
    
    # create Object for storing the output
    my $amfout = new AMF::Perl::Util::Object();
    
    # loop over all of the body elements
    for (my $i=0; $i<$bodycount; $i++)
    {
        my $body = $amfin->getBodyAt($i);
        # set the packagePath of the executive to be our method's uri
        #Simon - unused for now
        $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"; 
        } 

        # save the result in our amfout object
        $amfout->addBody($body->{"response"}.$self->{"response"}, "null", $results, $returnType);
    }
    
    # create a new output stream
    my $outstream = new AMF::Perl::IO::OutputStream ();

    # create a new serializer
    my $serializer = new AMF::Perl::IO::Serializer ($outstream, $self->{encoding});
    
    # serialize the data
    $serializer->serialize($amfout);

    if(0)
    {
        # save the raw data to a file for debugging
        $self->_saveRawDataToFile ($self->debugDir."/results.amf", $outstream->flush());
    }

    # send the correct header
    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);
        #$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
{
    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__