home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
rtsi.com
/
2014.01.www.rtsi.com.tar
/
www.rtsi.com
/
OS9
/
FAQ
/
cgi-bin
/
discus4_00
/
source
/
storage.pl
< prev
next >
Wrap
Text File
|
2009-11-06
|
5KB
|
199 lines
# FILE: storage.pl
# DESCRIPTION: Storing and retrieving arrays and hashes in flat text files
#-------------------------------------------------------------------------------
# DISCUS COPYRIGHT NOTICE
#
# Discus is copyright (c) 2002 by DiscusWare, LLC, all rights reserved.
# The use of Discus is governed by the Discus License Agreement which is
# available from the Discus WWW site at:
# http://www.discusware.com/discus/license
#
# Pursuant to the Discus License Agreement, this copyright notice may not be
# removed or altered in any way.
#-------------------------------------------------------------------------------
use strict;
use vars qw($GLOBAL_OPTIONS $DCONF $PARAMS);
###
### storage_encode_arguments
###
### Encodes subroutine arguments
###
sub storage_encode_arguments {
my @args = ();
my $internal_counter = 0;
foreach my $k (@_) {
if (ref $k eq "HASH") {
my ($u, $l, $ic) = storage_encode_hash($k, ++$internal_counter);
push @args, join(":", "ARG", "HASH($internal_counter)");
unshift @args, $u;
unshift @args, @{ $l };
$internal_counter = $ic;
} elsif (ref $k eq "ARRAY") {
my ($u, $l, $ic) = storage_encode_array($k, ++$internal_counter);
push @args, join(":", "ARG", "ARRAY($internal_counter)");
unshift @args, $u;
unshift @args, @{ $l };
$internal_counter = $ic;
} else {
my $u = join(":", "ARG", escape($k));
push @args, $u;
}
}
return @args;
}
###
### storage_unencode_arguments
###
### Unencodes an argument list
###
sub storage_unencode_arguments {
my ($file) = @_;
my @args = ();
my @file = @{ $file };
my $hashes = {};
my $arrays = {};
foreach my $line (@file) {
chomp $line;
if ($line =~ /^ARRAY(\d+):/) {
$arrays->{$1} = $';
} elsif ($line =~ /^HASH(\d+):/) {
$hashes->{$1} = $';
} elsif ($line =~ /^ARG:/) {
my $aft = $';
if ($aft =~ /^HASH\((\d+)\)/) {
push @args, storage_unencode_hash($1, $hashes, $arrays)
} elsif ($aft =~ /^ARRAY\((\d+)\)/) {
push @args, storage_unencode_array($1, $hashes, $arrays);
} else {
if ($aft eq "") {
push @args, undef;
} else {
push @args, unescape($aft);
}
}
}
}
return @args;
}
###
### storage_unencode_hash
###
### Transforms an encoded hash into an unencoded hash
###
sub storage_unencode_hash {
my ($hashnum, $hashes, $arrays) = @_;
my @pairs = split(/&/, $hashes->{$hashnum});
my $hashout = {};
foreach my $pair (@pairs) {
my ($name, $value) = split(/=/, $pair);
$name = unescape($name);
if ($value =~ /^HASH\((\d+)\)/) {
$hashout->{$name} = storage_unencode_hash($1, $hashes, $arrays);
} elsif ($value =~ /^ARRAY\((\d+)\)/) {
$hashout->{$name} = storage_unencode_array($1, $hashes, $arrays);
} else {
$hashout->{$name} = unescape($value);
}
}
return $hashout;
}
###
### storage_unencode_array
###
### Transforms an encoded array into an unencoded array
###
sub storage_unencode_array {
my ($hashnum, $hashes, $arrays) = @_;
my @pairs = split(/&/, $arrays->{$hashnum});
my @aout = ();
foreach my $pair (@pairs) {
my ($name, $value) = split(/=/, $pair);
if ($value =~ /^HASH\((\d+)\)/) {
$aout[$name] = storage_unencode_hash($1, $hashes, $arrays);
} elsif ($value =~ /^ARRAY\((\d+)\)/) {
$aout[$name] = storage_unencode_array($1, $hashes, $arrays);
} else {
$aout[$name] = unescape($value);
}
}
return \@aout;
}
###
### storage_encode_hash
###
### Transforms an unencoded hash into an encoded hash
###
sub storage_encode_hash {
my ($hash, $ctr) = @_;
my @k = keys(%{ $hash });
my @r = ();
my @o = ();
my $r = "HASH$ctr";
foreach my $key (@k) {
if (ref $hash->{$key} eq "HASH") {
my ($thathash, $otherhashes, $counter) = storage_encode_hash($hash->{$key}, ++$ctr);
$ctr = $counter;
push @r, join("=", escape($key), "HASH($ctr)");
push @o, $thathash;
push @o, @{ $otherhashes } if defined $otherhashes;
} elsif (ref $hash->{$key} eq "ARRAY") {
my ($thathash, $otherhashes, $counter) = storage_encode_array($hash->{$key}, ++$ctr);
$ctr = $counter;
push @r, join("=", escape($key), "ARRAY($ctr)");
push @o, $thathash;
push @o, @{ $otherhashes } if defined $otherhashes;
} else {
push @r, join("=", escape($key), escape($hash->{$key}));
}
}
return (join(":", $r, join("&", @r)), \@o, $ctr);
}
###
### storage_encode_array
###
### Transforms an unencoded array into an encoded array
###
sub storage_encode_array {
my ($array, $ctr) = @_;
my @k = @{$array};
my @r = ();
my @o = ();
my $r = "ARRAY$ctr";
my $count = 0;
foreach my $key (@k) {
if (ref $key eq "HASH") {
my ($thathash, $otherhashes, $counter) = storage_encode_hash($key, ++$ctr);
$ctr = $counter;
push @r, join("=", $count, "HASH($ctr)");
push @o, $thathash;
push @o, @{ $otherhashes } if defined $otherhashes;
} elsif (ref $key eq "ARRAY") {
my ($thathash, $otherhashes, $counter) = storage_encode_array($key, ++$ctr);
$ctr = $counter;
push @r, join("=", $count, "ARRAY($ctr)");
push @o, $thathash;
push @o, @{ $otherhashes } if defined $otherhashes;
} else {
push @r, join("=", $count, escape($key));
}
$count++;
}
return (join(":", $r, join("&", @r)), \@o, $ctr);
}
1;