view release on metacpan or  search on metacpan

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

package AMF::Perl::IO::OutputStream;
# Copyright (c) 2003 by Vsevolod (Simon) Ilyushchenko. All rights reserved.
# This program 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/)

=head1 NAME

    AMF::Perl::IO::OutputStream

=head1 DESCRIPTION    

    Class used to convert the perl stuff into binary    

==head1 CHANGES

=head2 Sun Sep 19 12:59:11 EDT 2004
=item Check for (defined $s) and not just ($s) in writeUTF.
=item Write string length as long if it is over 65535.

=head2 Sun Jun 20 13:32:31 EDT 2004
=item Added $s="" unless $s in writeUTF to avoid warnings.

=head2 Sun Jul 11 18:45:40 EDT 2004

=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 = "";
    # reverse the bytes
    if ($self->{byteorder} eq 'little-endian')
    {
        for(my $byte = 7 ; $byte >= 0 ; $byte--)
        {
            $r .= $b[$byte];
        }
    }
    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;