#
# FreezeThawLight.pm -- wrapper to allow easy setting of the effective user/group ids
#
# created by David Harris <dharris@drh.net> on 990706
# Copyright (c) 1999 DRH Internet Services, All Rights Reserved.
#

package FreezeThawLight;

use strict;
use vars qw( @ISA @EXPORT $VERSION );
use Carp;

require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw( freeze thaw old_freeze old_thaw );

$VERSION = 1.00; # 990706

use vars qw( $data $i );

sub freeze
{
	my @stack = ( shift() );
	my $buffer = "";

	while ( @stack )
	{
		my $stuff = shift @stack;
		my $ref = ref $stuff;

		if (!$ref)
		{
			if ( defined $stuff ) {
				$buffer .= "s" . length($stuff) . ":${stuff}";
			} else {
				$buffer .= "u0:";
			}
		}
		elsif ($ref eq "ARRAY")
		{
			$buffer .= "a" . scalar(@$stuff) . ":";
			unshift @stack, @$stuff;
		}
		elsif ($ref eq "HASH")
		{
			my $num=0;
			foreach ( sort keys %$stuff ) {
				unshift @stack, $_, $stuff->{$_};
				$num += 2;
			}
			$buffer .= "h${num}:";
		}
		elsif ($ref eq "REF" or $ref eq "SCALAR")
		{
			$buffer .= "r1:";
			unshift @stack, $$stuff;
		}
		else {
			croak "can't deal with reference type ($ref)";
		}
	}

	return $buffer;
}


use vars qw( $data $i );

sub _thaw_backend
{
#print "i = $i\n";
	substr($data, $i, 10) =~ m|^([a-z])(\d+):| or croak "parse error, invalid format";
	my $flag = $1;
	my $length = $2;
	$i += length($2) + 2;

	if ( $flag eq "s" )
	{
		my $icopy = $i;
		$i += $length;
		return ( substr($data, $icopy, $length) );
	}
	elsif ( $flag eq "a" )
	{
		my @arry;
		my $c;
		for ($c=0 ; $c<$length ; $c++) {
			push @arry,
				( substr($data, $i, 10) =~ m|^s(\d+):| ? substr($data, ($i+=length($1)+2+$1)-$1, $1)
				: _thaw_backend() );
		}
		return \@arry;
	}
	elsif ( $flag eq "h" )
	{
		my %hash;
		my $c;
		for ($c=0 ; $c<$length ; $c+=2) {
			my $key =
				( substr($data, $i, 10) =~ m|^s(\d+):| ? substr($data, ($i+=length($1)+2+$1)-$1, $1)
				: croak("parse error, hash key (text=" . substr($data, $i, 10)) . ") not scalar" );
			$hash{$key} =
				( substr($data, $i, 10) =~ m|^s(\d+):| ? substr($data, ($i+=length($1)+2+$1)-$1, $1)
				: _thaw_backend() );
		}
		return \%hash;
	}
	elsif ( $flag eq "u" )
	{
		return undef;
	}
	elsif ( $flag eq "r" )
	{
		my $var = _thaw_backend();
		return \$var;
	}
	else { croak "parse error, invalid flag ($flag)"; }
}

sub thaw
{
	local $data = shift;
	local $i = 0;
	return _thaw_backend();
}

1;
__END__

#
# These functions are slower versions of the ones above.. i first wrote everything
# with recursion.. then i write them without. Well, the freeze was faster with recursion,
# but thaw was faster without. So, I simply used the fastest of each function. Below lay
# the slower versions.
#

sub thaw
{
	my $data = shift;
	my $i;

	my $result_list = [];
	my @stack = ( [ "a", -1, $result_list ] ) ;

	do
	{
		my $flag = substr($data, $i, 1);
		$i++;
		substr($data, $i, 10) =~ m|(\d+):| or die "ack";
		my $length = $1;
		$i += length($1) + 1;

		my $finished_product;
		my $finished_product_exists;

		if ( $flag eq "s" )
		{
			my $icopy = $i;
			$i += $length;
			$finished_product = substr($data, $icopy, $length);
			$finished_product_exists = 1;
		}
		elsif ( $flag eq "a" )
		{
			unshift @stack, ["a", $length, []];
		}
		elsif ( $flag eq "h" )
		{
			unshift @stack, ["h", $length, {}, undef];
		}
		elsif ( $flag eq "u" )
		{
			$finished_product = undef;
			$finished_product_exists = 1;
		}
		elsif ( $flag eq "r" )
		{
			unshift @stack, ["r", 1, undef];
		}
		else {
			die "can't deal with flag = $flag";
		}

		while ( $finished_product_exists or $stack[0][1] == 0 )
		{
			if ( not $finished_product_exists ) {
				$finished_product = $stack[0][2];
				shift @stack;
			}

			my $stack_top = $stack[0];

			if ( $stack_top->[0] eq "a" )
			{
				$stack_top->[1]--;
				push @{$stack_top->[2]}, $finished_product;
			}
			elsif ( $stack_top->[0] eq "h" )
			{
				if ( $stack_top->[1] % 2 == 0 ) {
					$stack_top->[3] = $finished_product;
				} else {
					$stack_top->[2]->{$stack_top->[3]} = $finished_product;
					undef $stack_top->[3];
				}
				$stack_top->[1]--;
			}
			elsif ( $stack_top->[0] eq "r" )
			{
				$stack_top->[2] = \$finished_product;
				$stack_top->[1] = 0;
			}
			else { die "internal error with stack" }

			$finished_product_exists = 0;
		}

	} while ( @stack > 1 );

	return $result_list->[0];
}


sub old_freeze
{
	my $stuff = shift;

	my $ref = ref $stuff;

	if (!$ref) {
		return ( "s" . length($stuff) . ":" . $stuff );
	} elsif ($ref eq "ARRAY") {
		return ( "a" . scalar(@$stuff) . ":" . join("", map {old_freeze($_)} @$stuff) );
	} elsif ($ref eq "HASH") {
		my $enchash; my $num=0;
		my ($key, $value);
		while ( ($key,$value) = each %$stuff ) {
			$enchash .= old_freeze($key) . old_freeze($value);
			$num += 2;
		}
		return ( "h${num}:${enchash}" );
	} else {
		die "can't deal with type = $ref";
	}
}

1;