モジュール Unary.pm
package Unary;
use strict;
use warnings;
sub new {
my $class = shift;
my $self = {
HashTable => undef,
};
return bless($self, $class);
}
sub clear($){
my ($self) = @_;
undef($self->{HashTable});
}
sub encode($$){
my ($self,@arr) = @_;
my $ret = '';
my $idx = 0;
foreach my $val( @arr ){
my $cnt = $val;
while($cnt--){
vec($ret, $idx, 1) = 0;
$idx++;
}
vec($ret, $idx, 1) = 1;
$idx++;
}
return $ret;
}
sub decode($$){
my ($self,$bin) = @_;
my @ret;
my $tmp = 0;
my $idx = 0;
my $len = length($bin) * 8;
while($idx < $len){
if(vec($bin, $idx, 1)){
push(@ret, $tmp);
$tmp = 0;
}else{
$tmp++;
}
$idx++;
}
return @ret;
}
sub set($$$){
my ($self,$key,@value) = @_;
if( defined($self->{HashTable}->{$key}) ){
warn "error: Table already had key $key.";
return 0;
}
$self->{HashTable}->{$key} = $self->encode(@value);
return 1;
}
sub get($$){
my ($self,$key) = @_;
if( !defined($self->{HashTable}->{$key}) ){
warn "error: Table do not have key $key.";
return ();
}
return $self->decode($self->{HashTable}->{$key});
}
sub save($$){
my ($self,$filename) = @_;
open(OUT, "> $filename") or die "error:$!";
binmode(OUT);
foreach my $key ( keys %{$self->{HashTable}} ){
print OUT pack('i',length($key));
print OUT $key;
print OUT pack('i',length($self->{HashTable}->{$key}));
print OUT $self->{HashTable}->{$key};
}
close(OUT);
}
sub load($$){
my ($self, $filename) = @_;
open(IN, $filename);
binmode(IN);
my ($keylen, $key, $vallen, $value);
while(read(IN, $keylen, 4)){
$keylen = unpack('i',$keylen);
read(IN, $key, $keylen);
read(IN, $vallen, 4);
$vallen = unpack('i',$vallen);
read(IN, $value, $vallen);
$self->{HashTable}->{$key} = $value;
}
}
1;
テスト用コード Unary.pl
use lib qw(.);
use strict;
use warnings;
use Unary;
my $unary = new Unary();
$unary->set('ほげほげ', (1,2,3) );
$unary->set('ほげ', (1,3,5) );
$unary->set('ほげげ', (2,4,6) );
$unary->save('data.dat');
$unary->clear();
$unary->load('data.dat');
foreach my $v ($unary->get('ほげほげ')){
print $v," ";
}
print "\n";
foreach my $v ($unary->get('ほげ')){
print $v," ";
}
print "\n";
foreach my $v ($unary->get('ほげげ')){
print $v," ";
}
print "\n";