File Coverage

blib/lib/Data/AMF/Parser/AMF3.pm

Criterion	Covered	Total	%
statement	145	216	67.1
branch	21	54	38.8
condition	5	13	38.4
subroutine	22	24	91.6
pod	1	18	5.5
total	194	325	59.6

package Data::AMF::Parser::AMF3;
use strict;
use warnings;

use Data::AMF::IO;
use UNIVERSAL::require;

# ----------------------------------------------------------------------
# Class Constants
# ----------------------------------------------------------------------

use constant AMF3_TYPES =>
[
	'undefined',
	'null',
	'false',
	'true',
	'integer',
	'number',
	'string',
	'xml_document',
	'date',
	'array',
	'object',
	'xml',
	'byte_array',
];

use constant AMF3_INTEGER_MAX => "268435455";

# ----------------------------------------------------------------------
# Class Methods
# ----------------------------------------------------------------------

sub parse
{
	my ($class, $data) = @_;

	my $self = $class->new;
	$self->{'io'} = Data::AMF::IO->new(data => $data);

	return $self->read;
}

# ----------------------------------------------------------------------
# Constructor
# ----------------------------------------------------------------------

sub new
{
	my $class = shift;
	my $self = bless {
		io => undef,
		class_member_defs => {},
		stored_strings => [],
		stored_objects => [],
		stored_defs => [],
		@_
	}, $class;
	return $self;
}

# ----------------------------------------------------------------------
# Properties
# ----------------------------------------------------------------------

sub io { return $_[0]->{'io'} }

# ----------------------------------------------------------------------
# Methods
# ----------------------------------------------------------------------

sub read
{
	my $self = shift;

	my @res;

	while (defined(my $marker = $self->io->read_u8))
	{
		my $method = 'read_' . AMF3_TYPES->[$marker] or die;
		push @res, $self->$method();
	}

	@res;
}

sub read_one
{
	my $self = shift;

	my $marker = $self->io->read_u8;
	return unless defined $marker;

	my $method = 'read_' . AMF3_TYPES->[$marker] or die;
	return $self->$method();
}

sub read_undefined
{
	return undef;
}

sub read_null
{
	Data::AMF::Type::Null->require;
	return Data::AMF::Type::Null->new;
}

sub read_false
{
	Data::AMF::Type::Boolean->require;
	return Data::AMF::Type::Boolean->new(0);
}

sub read_true
{
	Data::AMF::Type::Boolean->require;
	return Data::AMF::Type::Boolean->new(1);
}

sub read_integer
{
	my $self = shift;

	my $n = 0;
	my $b = $self->io->read_u8 || 0;
	my $result = 0;

	while (($b & 0x80) != 0 && $n < 3)
	{
		$result = $result << 7;
		$result = $result | ($b & 0x7f);
		$b = $self->io->read_u8 || 0;
		$n++;
	}

	if ($n < 3)
	{
		$result = $result << 7;
		$result = $result | $b;
	}
	else
	{
		# Use all 8 bits from the 4th byte
		$result = $result << 8;
		$result = $result | $b;

		# Check if the integer should be negative
		if ($result > AMF3_INTEGER_MAX)
		{
			# and extend the sign bit
			$result -= (1 << 29);
		}
	}

	return $result;
}

sub read_number
{
	my $self = shift;
	return $self->io->read_double;
}

sub read_string
{
	my $self = shift;

	my $type = $self->read_integer();
	my $isReference = ($type & 0x01) == 0;

	if ($isReference)
	{
		my $reference = $type >> 1;
		if ($reference < @{ $self->{'stored_strings'} })
		{
			if (not defined $self->{'stored_strings'}->[$reference])
			{
				die "Reference to non existant object at index #{$reference}.";
			}

			return $self->{'stored_strings'}->[$reference];
		}
		else
		{
			die "Reference to non existant object at index #{$reference}.";
		}
	}
	else
	{
		my $length = $type >> 1;
		my $str = '';

		if ($length > 0)
		{
			$str = $self->io->read($length);
			push @{ $self->{'stored_strings'} }, $str;
		}

		return $str;
	}
}

sub read_xml_document
{
	my $self = shift;
	my $type = $self->read_integer();
	my $length = $type >> 1;
	my $obj = $self->io->read($length);
	push @{ $self->{'stored_objects'} }, $obj;
	return $obj;
}

sub read_date
{
	my $self = shift;

	my $type = $self->read_integer();
	my $isReference = ($type & 0x01) == 0;

	if ($isReference)
	{
		my $reference = $type >> 1;
		if ($reference < @{ $self->{'stored_objects'} })
		{
			if (not defined $self->{'stored_objects'}->[$reference])
			{
				die "Reference to non existant object at index #{$reference}.";
			}

			return $self->{'stored_objects'}->[$reference];
		}
		else
		{
			die "Reference to non existant object at index #{$reference}.";
		}
	}
	else
	{
		my $epoch = $self->io->read_double / 1000;

		DateTime->require;
		my $datetime = DateTime->from_epoch( epoch => $epoch );

		push @{ $self->{'stored_objects'} }, $datetime;
		return $datetime;
	}
}

sub read_array
{
	my $self = shift;

	my $type = $self->read_integer();
	my $isReference = ($type & 0x01) == 0;

	if ($isReference)
	{
		my $reference = $type >> 1;
		if ($reference < @{ $self->{'stored_objects'} })
		{
			if (not defined $self->{'stored_objects'}->[$reference])
			{
				die "Reference to non existant object at index #{$reference}.";
			}

			return $self->{'stored_objects'}->[$reference];
		}
		else
		{
			die "Reference to non existant object at index #{$reference}.";
		}
	}
	else
	{
		my $length = $type >> 1;
		my $key = $self->read_string();
		my $array;

		if ($key ne '')
		{
			$array = {};
			push @{ $self->{'stored_objects'} }, $array;

			while($key ne '')
			{
				my $value = $self->read_one();
				$array->{$key} = $value;
				$key = $self->read_string();
			}

			for (0 .. $length - 1)
			{
				$array->{$_} = $self->read_one();
			}
		}
		else
		{
			$array = [];
			push @{ $self->{'stored_objects'} }, $array;

			for (0 .. $length - 1)
			{
				push @{ $array }, $self->read_one();
			}
		}

		return $array;
	}
}

sub read_object
{
	my $self = shift;

	my $type = $self->read_integer();
	my $isReference = ($type & 0x01) == 0;

	if ($isReference)
	{
		my $reference = $type >> 1;

		if ($reference < @{ $self->{'stored_objects'} })
		{
			if (not defined $self->{'stored_objects'}->[$reference])
			{
				die "Reference to non existant object at index #{$reference}.";
			}

			return $self->{'stored_objects'}->[$reference];
		}
		else
		{
			warn "Reference to non existant object at index #{$reference}.";
		}
	}
	else
	{
		my $class_type = $type >> 1;
		my $class_is_reference = ($class_type & 0x01) == 0;
		my $class_definition;

		if ($class_is_reference)
		{
			my $class_reference = $class_type >> 1;

			if ($class_reference < @{ $self->{'stored_defs'} })
			{
				$class_definition = $self->{'stored_defs'}->[$class_reference];
			}
			else
			{
				die "Reference to non existant object at index #{$class_reference}.";
			}
		}
		else
		{
			my $as_class_name = $self->read_string();
			my $externalizable = ($class_type & 0x02) != 0;
			my $dynamic = ($class_type & 0x04) != 0;
			my $attr_count = $class_type >> 3;

			my $members = [];
			for (1 .. $attr_count)
			{
				push @{ $members }, $self->read_string();
			}

			$class_definition =
			{
				"as_class_name" => $as_class_name,
				"members" => $members,
				"externalizable" => $externalizable,
				"dynamic" => $dynamic
			};

			push @{ $self->{'stored_defs'} }, $class_definition;
		}

		my $action_class_name = $class_definition->{'as_class_name'};
		my ($skip_mapping, $obj);

		if ($action_class_name && $action_class_name =~ /flex\.messaging/)
		{
			$obj = {};
			$obj->{'_explicitType'} = $action_class_name;
			$skip_mapping = 1;
		}
		else
		{
			$obj = {};
			$skip_mapping = 0;
		}

		my $obj_position = @{ $self->{'stored_objects'} };
		push @{ $self->{'stored_objects'} }, $obj;

		if ($class_definition->{'externalizable'})
		{
			$obj = $self->read_one();
		}
		else
		{
			for my $key (@{ $class_definition->{'members'} })
			{
				$obj->{$key} = $self->read_one();
			}
		}

		if ($class_definition->{'dynamic'})
		{
			my $key;
			while (($key = $self->read_string()) && $key ne '') {
				$obj->{$key} = $self->read_one();
			}
		}

		return $obj;
	}
}

sub read_xml
{
	my $self = shift;
	my $type = $self->read_integer();
	my $length = $type >> 1;
	my $obj = $self->io->read($length);

	XML::LibXML->require;
	my $xml = XML::LibXML->new()->parse_string($obj);

	push @{ $self->{'stored_objects'} }, $xml;
	return $xml;
}

sub read_byte_array
{
	my $self = shift;

	my $type = $self->read_integer();
	my $isReference = ($type & 0x01) == 0;

	if ($isReference)
	{
		my $reference = $type >> 1;
		if ($reference < @{ $self->{'stored_objects'} })
		{
			if (not defined $self->{'stored_objects'}->[$reference])
			{
				die "Reference to non existant object at index #{$reference}.";
			}

			return $self->{'stored_objects'}->[$reference];
		}
		else
		{
			die "Reference to non existant object at index #{$reference}.";
		}
	}
	else
	{
		my $length = $type >> 1;
		my @obj = unpack('C' . $length, $self->io->read($length));

		Data::AMF::Type::ByteArray->require;
		my $obj = Data::AMF::Type::ByteArray->new(\@obj);

		push @{ $self->{'stored_objects'} }, $obj;
		return $obj;
	}
}

1;

__END__