#!/usr/bin/perl

#  this softwary by Musicman 2003
#  is covered by the GPL
#  for the exact terms and conditions please see http://www.fsf.org/
#
								
package swfdata;

use constant PUSHDATA => "\x96";
use constant POP => "\x17";
use constant GETMEMBER => "\x4e";
use constant SETMEMBER => "\x4f";
use constant GETVAR => "\x1c";
use constant SETVAR => "\x1d";
use constant INITARRAY => "\x42";
use constant INITOBJECT => "\x43";
use constant CALLMETHOD => "\x52";
use constant CALLFUNCTION => "\x3d";
sub new
{	my $this = {};
	bless $this;
	$this->{hdr1} = "FWS\5";
	$this->{hdr2} = "\110\1\220\0\144\0\0\14\1\0";
	$this->{bgcol} = pack("v", (9 << 6) + 3) . "\377\377\377";	
	$this->{end} = pack("vv", 1 << 6, 0);	# showframe, end
	$this->{push_action} = '';
	return $this;
}
sub send
{	my $this = shift;
	$this->{actions} .= "\0";
	my $len = length ($this->{actions});
	if($len > 63)
	{	$this->{actions} = pack("vV", (12 << 6) + 63, $len) . $this->{actions};
	}
	else
	{	$this->{actions} = pack("v", (12 << 6) + $len) . $this->{actions};
	}
	my $sz = 8 + length($this->{hdr2}) + length($this->{bgcol}) + length($this->{actions}) + length($this->{end});
	print "Content-type: application/x-shockwave-flash\n\n";
	print $this->{hdr1} . pack("V", $sz) . $this->{hdr2} . $this->{bgcol} . $this->{actions} . $this->{end};
}
sub push
{	my $this = shift;
	my $val = shift;
	if($val =~ /^-?\d+$/)
	{	$this->{push_action} .= "\7" . pack("V", $val & 0xffff);
	}
	elsif($val =~ /^-?(\d+|\d*\.\d+|\d+\.\d*)$/)
	{	$this->{push_action} .= "\6" . pack("d", $val);
	}
	else
	{	$this->{push_action} .= "\0" . $val . "\0";
	}
}
sub addcode
{	my $this = shift;
	my $op = shift;
	my $l;
	if($l = length($this->{push_action}))
	{	$this->{actions} .= PUSHDATA . pack("v", $l) . $this->{push_action};
		$this->{push_action} = '';
	}
	$this->{actions} .= $op;
}
sub setvar
{	my $this = shift;
	my $name = shift;
	my $val = shift;
	my $member = $this->pushname($name);
	$this->pushdata($val);
	$this->addcode($member ? SETMEMBER : SETVAR);
}
sub call
{	my $this = shift;
	my $name = shift;
	my $nargs = $#_;
	my $n;
	for($n = $nargs ; $n >= 0 ; $n--)
	{	$this->pushdata($_[$n]);
	}
	$this->push($nargs+1);
	my $member = $this->pushname($name);
	$this->addcode($member ? CALLMETHOD : CALLFUNCTION);
	$this->addcode(POP);
}
sub pushname
{	my $this = shift;
	my $name = shift;
	my $member;
	my @nameparts = split /\./, $name;
	$member = $#nameparts > 0;
	$this->push($nameparts[0]);
	for($n = 1 ; $n <= $#nameparts ; $n++)
	{	$this->addcode(($n == 1) ? GETVAR : GETMEMBER);
		$this->push($nameparts[$n]);
	}
	return $member;
}
sub pushdata
{	my $this = shift;
	my $val = shift;
	my $n;
	if(ref $val eq 'ARRAY')
	{	for($n = $#$val ; $n >= 0 ; $n--)
		{	if(exists $$val[$n])
			{	$this->pushdata($$val[$n]);
			}
			else
			{	$this->push_action .= "\3";
			}
		}
		$this->push($#$val+1);
		$this->addcode(INITARRAY);
	}
	elsif(ref $val eq 'HASH')
	{	my @keys = keys %$val;
		foreach $key (@keys)
		{	$this->push($key);
			$this->pushdata($$val{$key});
		}
		$this->push($#keys + 1);
		$this->addcode(INITOBJECT);
	}
	else
	{	$this->push($val);
	}
}

package main;
$m = new swfdata();
$m->setvar('_root.data.counter', [23, 25]);
$m->call('_root.starter', 2.7, ['a', 'b', {'aa'=>11, 'bb'=>'unfug', 'cc'=>0}, 'd']);
$m->send();