# Copyright © 2007 Rob Vossen http://puff.uvt.nl/
#
# Tremble is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License, as published by the Free Software
# Foundation, either version 3 of the License, or (at your option) any later
# version. This program is distributed WITHOUT ANY WARRANTY.. You should have
# received a copy of the GNU General Public License along with draai. If not,
# see .
package Trailer; #transparent
my $version ='$Id: Trailer.pm,v 1.1.1.1 2002/09/04 14:02:16 anton Exp $ ';
($version) = $version =~ /,v\s+([\S]+\s\d\d\d\d\/\d\d\/\d\d\s\d\d:\d\d):\d\d /;
$version =~ s/\s/\ - date- /;
use strict;
my $undef='* undef *';
sub populate
{
my($self)=shift;
my($data)=shift;
foreach my $key (keys %$data)
{
$self->{$key}=$data->{$key};
}
}
sub ascarray
{
my ($self)=shift;
my (@vals)=@_;
my (@types)=();
my ($type)='';
my ($analysis)='';
my ($versie)='';
my ($i)=0;
my ($level)=$self->{'showlevel'};
foreach my $elt (@vals)
{
push(@types,$self->adjust($elt));
}
for (my $i=0;$i<@types;$i++)
{
$self->{'showlevel'}++ if ($types[$i]=~/(HASH|ARRAY)\(/);
if (($types[$i]=~/ARRAY\(/) && ref($types[$i]))
{
$type=$types[$i];
if (exists $self->{'recurrent'}->{$type})
{
$types[$i]=~s/\(.+//;
$analysis.=(' ' x (3*$level))."[$i] ".$types[$i].'(#'.$self->{'recurrent'}->{$type}.")\n";
}
else
{
$types[$i]=~s/\(.+//;
$self->{'recurrent'}->{$type}=$self->{'count'}++;
$analysis.=(' ' x (3*$level))."[$i] ".'('.$self->{'recurrent'}->{$type}.')'.$types[$i]."\n";
$analysis.=$self->ascarray(@{$vals[$i]}) unless ($self->{'showlevel'}>$self->{'showlimit'});
}
}
elsif (($types[$i]=~/HASH\(/) && ref($types[$i]))
{
$type=$types[$i];
if (exists $self->{'recurrent'}->{$type})
{
$types[$i]=~s/\(.+//;
$analysis.=(' ' x (3*$level))."[$i] ".$types[$i].'(#'.$self->{'recurrent'}->{$type}.")\n";
}
else
{
$types[$i]=~s/\(.+//;
$self->{'recurrent'}->{$type}=$self->{'count'}++;
$analysis.=(' ' x (3*$level))."[$i] ".'('.$self->{'recurrent'}->{$type}.')'.$types[$i]."\n";
$analysis.=$self->aschash(%{$vals[$i]}) unless ($self->{'showlevel'}>$self->{'showlimit'});
}
}
else
{
$analysis.=(' ' x (3*$level))."[$i]".$types[$i]."\n";
}
$self->{'showlevel'}=$level;
}
return($analysis);
}
sub asciify
{
my $self=shift;
if ($self->{'awake'})
{
print $self->{'leader'},'['.localtime()."]\n";
print $self->ascarray(@_);
$self->{'recurrent'}={};
}
}
sub showhash
{
my ($self)=shift;
my (%vals)=@_;
my (@types)=();
my ($type)='';
my ($analysis)='';
my ($versie)='';
my ($i)=0;
my ($level)=$self->{'showlevel'};
my (@vals);
foreach my $key (sort keys %vals)
{
push(@vals,$key,$vals{$key});
}
foreach my $elt (@vals)
{
push(@types, defined ($elt)?$elt:$undef);
}
$analysis.="
";
for ($i=1;$i<@types;$i+=2)
{
$self->{'showlevel'}++ if ($types[$i]=~/(HASH|ARRAY)\(/);
if (($types[$i]=~/ARRAY\(/) && ref($types[$i]))
{
$type=$types[$i];
if (exists $self->{'recurrent'}->{$type})
{
$types[$i]=~s/\(.+//;
$analysis.="- {'".$vals[$i-1]."'}->".$types[$i].'(#'.$self->{'recurrent'}->{$type}.')';
}
else
{
$types[$i]=~s/\(.+//;
$self->{'recurrent'}->{$type}=$self->{'count'}++;
$analysis.="
- {'".$vals[$i-1]."'}->".'('.$self->{'recurrent'}->{$type}.')'.$types[$i];
$analysis.=$self->showarray(@{$vals[$i]}) unless ($self->{'showlevel'}>$self->{'showlimit'});
}
}
elsif (($types[$i]=~/HASH\(/) && ref($types[$i]))
{
$type=$types[$i];
if (exists $self->{'recurrent'}->{$type})
{
$types[$i]=~s/\(.+//;
$analysis.="
- {'".$vals[$i-1]."'}->".$types[$i].'(#'.$self->{'recurrent'}->{$type}.')';
}
else
{
$types[$i]=~s/\(.+//;
$self->{'recurrent'}->{$type}=$self->{'count'}++;
$analysis.="
- {'".$vals[$i-1]."'}->".'('.$self->{'recurrent'}->{$type}.')'.$types[$i];
$analysis.=$self->showhash(%{$vals[$i]}) unless ($self->{'showlevel'}>$self->{'showlimit'});
}
}
elsif (ref($types[$i]) eq 'REF')
{
$type=$types[$i];
if (exists $self->{'recurrent'}->{$type})
{
$types[$i]=~s/\(.+//;
$analysis.="
- {'".$vals[$i-1]."'}->".'REF(#'.$self->{'recurrent'}->{$type}.')';
}
else
{
$types[$i]=~s/\(.+//;
$self->{'recurrent'}->{$type}=$self->{'count'}++;
$analysis.="
- {'".$vals[$i-1]."'}->".'('.$self->{'recurrent'}->{$type}.')REF';
$analysis.=$self->showarray(${$vals[$i]}) unless ($self->{'showlevel'}>$self->{'showlimit'});
}
}
elsif (ref($types[$i]) eq 'SCALAR')
{
$type=$types[$i];
if (exists $self->{'recurrent'}->{$type})
{
$types[$i]=~s/\(.+//;
$analysis.="
- {'".$vals[$i-1]."'}->".'SCALAR(#'.$self->{'recurrent'}->{$type}.')';
}
else
{
$types[$i]=~s/\(.+//;
$self->{'recurrent'}->{$type}=$self->{'count'}++;
$analysis.="
- {'".$vals[$i-1]."'}->".'('.$self->{'recurrent'}->{$type}.')SCALAR';
$analysis.=$self->showarray(${$vals[$i]}) unless ($self->{'showlevel'}>$self->{'showlimit'});
}
}
else
{
$types[$i]=~s/</g;
$types[$i]=~s/\n/
/gs;
$analysis.=" - {'".$vals[$i-1]."'}->".$types[$i];
}
$self->{'showlevel'}=$level;
}
$analysis.="
";
return($analysis);
}
sub aschash
{
my ($self)=shift;
my (%vals)=@_;
my (@types)=();
my ($type)='';
my ($analysis)='';
my ($versie)='';
my ($i)=0;
my ($level)=$self->{'showlevel'};
my (@vals);
foreach my $key (sort keys %vals)
{
push(@vals,$key,$vals{$key});
}
foreach my $elt (@vals)
{
push(@types,$self->adjust($elt));
}
for ($i=1;$i<@types;$i+=2)
{
$self->{'showlevel'}++ if ($types[$i]=~/(HASH|ARRAY)\(/);
if (($types[$i]=~/ARRAY\(/) && ref($types[$i]))
{
$type=$types[$i];
if (exists $self->{'recurrent'}->{$type})
{
$types[$i]=~s/\(.+//;
$analysis.=(' ' x (3*$level))."{'".$vals[$i-1]."'}->".$types[$i].'(#'.$self->{'recurrent'}->{$type}.")\n";
}
else
{
$types[$i]=~s/\(.+//;
$self->{'recurrent'}->{$type}=$self->{'count'}++;
$analysis.=(' ' x (3*$level))."{'".$vals[$i-1]."'}->".'('.$self->{'recurrent'}->{$type}.')'.$types[$i]."\n";
$analysis.=$self->ascarray(@{$vals[$i]}) unless ($self->{'showlevel'}>$self->{'showlimit'});
}
}
elsif (($types[$i]=~/HASH\(/) && ref($types[$i]))
{
$type=$types[$i];
if (exists $self->{'recurrent'}->{$type})
{
$types[$i]=~s/\(.+//;
$analysis.=(' ' x (3*$level))."{'".$vals[$i-1]."'}->".$types[$i].'(#'.$self->{'recurrent'}->{$type}."\n";
}
else
{
$types[$i]=~s/\(.+//;
$self->{'recurrent'}->{$type}=$self->{'count'}++;
$analysis.=(' ' x (3*$level))."{'".$vals[$i-1]."'}->".'('.$self->{'recurrent'}->{$type}.')'.$types[$i]."\n";
$analysis.=$self->aschash(%{$vals[$i]})."\n" unless ($self->{'showlevel'}>$self->{'showlimit'});
}
}
else
{
$analysis.=(' ' x (3*$level))."{'".$vals[$i-1]."'}->".$types[$i]."\n";
}
$self->{'showlevel'}=$level;
}
return($analysis);
}
sub showarray
{
my ($self)=shift;
my (@vals)=@_;
my (@types)=();
my ($type)='';
my ($analysis)='';
my ($versie)='';
my ($i)=0;
my ($level)=$self->{'showlevel'};
foreach my $elt (@vals)
{
push(@types, defined ($elt)?$elt:$undef);
}
$analysis.="";
for ($i=0;$i<@types;$i++)
{
$self->{'showlevel'}++ if ($types[$i]=~/(HASH|ARRAY)\(/);
if (($types[$i]=~/ARRAY\(/) && ref($types[$i]))
{
$type=$types[$i];
if (exists $self->{'recurrent'}->{$type})
{
$types[$i]=~s/\(.+//;
$analysis.="- [$i] ".$types[$i].'(#'.$self->{'recurrent'}->{$type}.')';
}
else
{
$types[$i]=~s/\(.+//;
$self->{'recurrent'}->{$type}=$self->{'count'}++;
$analysis.="
- [$i] ".'('.$self->{'recurrent'}->{$type}.')'.$types[$i];
$analysis.=$self->showarray(@{$vals[$i]}) unless ($self->{'showlevel'}>$self->{'showlimit'});
}
}
elsif (($types[$i]=~/HASH\(/) && ref($types[$i]))
{
$type=$types[$i];
if (exists $self->{'recurrent'}->{$type})
{
$types[$i]=~s/\(.+//;
$analysis.="
- [$i] ".$types[$i].'(#'.$self->{'recurrent'}->{$type}.')';
}
else
{
$types[$i]=~s/\(.+//;
$self->{'recurrent'}->{$type}=$self->{'count'}++;
$analysis.="
- [$i] ".'('.$self->{'recurrent'}->{$type}.')'.$types[$i];
$analysis.=$self->showhash(%{$vals[$i]}) unless ($self->{'showlevel'}>$self->{'showlimit'});
}
}
elsif (ref($types[$i]) eq 'REF')
{
$type=$types[$i];
if (exists $self->{'recurrent'}->{$type})
{
$types[$i]=~s/\(.+//;
$analysis.="
- [$i] ".'REF(#'.$self->{'recurrent'}->{$type}.')';
}
else
{
$types[$i]=~s/\(.+//;
$self->{'recurrent'}->{$type}=$self->{'count'}++;
$analysis.="
- [$i] ".'('.$self->{'recurrent'}->{$type}.')REF';
$analysis.=$self->showarray(${$vals[$i]}) unless ($self->{'showlevel'}>$self->{'showlimit'});
}
}
elsif (ref($types[$i]) eq 'SCALAR')
{
$type=$types[$i];
if (exists $self->{'recurrent'}->{$type})
{
$types[$i]=~s/\(.+//;
$analysis.="
- [$i] ".'SCALAR(#'.$self->{'recurrent'}->{$type}.')';
}
else
{
$types[$i]=~s/\(.+//;
$self->{'recurrent'}->{$type}=$self->{'count'}++;
$analysis.="
- [$i] ".'('.$self->{'recurrent'}->{$type}.')SCALAR';
$analysis.=$self->showarray(${$vals[$i]}) unless ($self->{'showlevel'}>$self->{'showlimit'});
}
}
else
{
$types[$i]=~s/</g;
$types[$i]=~s/\n/
/gs;
$analysis.=" - [$i]".$types[$i];
}
$self->{'showlevel'}=$level;
}
$analysis.="
";
return($analysis);
}
sub adjust
{
my $self=shift;
my $elt=shift;
return $undef if (!defined($elt));
return 'SELF' if ($self eq $elt);
return $elt;
}
sub new
{
my $package=shift;
my($data)=shift;
my($self)={};
$self->{'count'}=1;
$self->{'showlimit'}=100;
$self->{'showlevel'}=0;
$self->{'leader'}="\n";
bless $self,$package;
$self->populate($data);
return($self);
}
'end Trailer'; #transparent