projects
/
onis.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
First runnable version. Still many bugs. To be continued..
[onis.git]
/
lib
/
Onis
/
Data
/
Persistent
/
None.pm
diff --git
a/lib/Onis/Data/Persistent/None.pm
b/lib/Onis/Data/Persistent/None.pm
index
35a0dec
..
1dccf93
100644
(file)
--- a/
lib/Onis/Data/Persistent/None.pm
+++ b/
lib/Onis/Data/Persistent/None.pm
@@
-3,9
+3,7
@@
package Onis::Data::Persistent::None;
use strict;
use warnings;
use strict;
use warnings;
-use vars (qw($TREE));
-
-use Carp qw(confess);
+use Carp qw(carp confess);
=head1 NAME
=head1 NAME
@@
-21,7
+19,12
@@
None.
=cut
=cut
-$TREE = {};
+our $Tree = {};
+
+if ($::DEBUG & 0x0200)
+{
+ require Data::Dumper;
+}
return (1);
return (1);
@@
-37,20
+40,28
@@
sub new
my $id = $caller . ':' . $name;
my $id = $caller . ':' . $name;
- if (exists ($T
REE
->{$id}))
+ if (exists ($T
ree
->{$id}))
{
print STDERR $/, __FILE__, ": Name $name has been used in context $caller before.";
return (undef);
}
{
print STDERR $/, __FILE__, ": Name $name has been used in context $caller before.";
return (undef);
}
- $T
REE
->{$id} = {};
- $obj->{'data'} = $T
REE
->{$id};
+ $T
ree
->{$id} = {};
+ $obj->{'data'} = $T
ree
->{$id};
$obj->{'key'} = $key;
$obj->{'fields'} = [@fields];
$obj->{'num_fields'} = scalar (@fields);
$obj->{'field_index'} = {map { $_ => $i++ } (@fields)};
$obj->{'id'} = $id;
$obj->{'key'} = $key;
$obj->{'fields'} = [@fields];
$obj->{'num_fields'} = scalar (@fields);
$obj->{'field_index'} = {map { $_ => $i++ } (@fields)};
$obj->{'id'} = $id;
+
+ if ($::DEBUG & 0x0200)
+ {
+ my $prefix = __FILE__ . ': ';
+ my $dbg = Data::Dumper->Dump ([$obj], ['obj']);
+ $dbg =~ s/^/$prefix/mg; chomp ($dbg);
+ print STDOUT $/, $dbg;
+ }
return (bless ($obj, $pkg));
}
return (bless ($obj, $pkg));
}
@@
-64,10
+75,15
@@
sub put
if ($obj->{'num_fields'} != scalar (@fields))
{
my $id = $obj->{'id'};
if ($obj->{'num_fields'} != scalar (@fields))
{
my $id = $obj->{'id'};
-
print STDERR $/, __FILE__, ": Number of fields do not match ($id)."
;
+
carp ("Number of fields do not match ($id).")
;
return;
}
return;
}
+ if ($::DEBUG & 0x0200)
+ {
+ print STDOUT $/, __FILE__, ': PUT(', $obj->{'id'}, ', ', $key, ') = (' . join (', ', @fields) . ')';
+ }
+
$obj->{'data'}{$key} = [@fields];
}
$obj->{'data'}{$key} = [@fields];
}
@@
-81,6
+97,11
@@
sub get
return (qw());
}
return (qw());
}
+ if ($::DEBUG & 0x0200)
+ {
+ print STDOUT $/, __FILE__, ': GET(', $obj->{'id'}, ', ', $key, ') = (' . join (', ', @{$obj->{'fields'}}) . ')';
+ }
+
return (@{$obj->{'data'}{$key}});
}
return (@{$obj->{'data'}{$key}});
}