view release on metacpan or  search on metacpan

lib/AMF/Perl.pm  view on Meta::CPAN

    	# 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)=@_;