###################################### package AnyData::Storage::TiedHash; ###################################### use strict; sub FETCH { my($self,$key) = @_; my(@rows,$row,$found); return $self->{ad}->col_names if($key eq '__colnames'); return $self->{ad}->key_col if $key eq '__key'; my $ismultiple = ref $key; $self->{ad}->seek_first_record; while ($row = $self->{ad}->fetchrow_hashref) { if ( $self->{ad}->match($row,$key) ) { $found++; last unless $ismultiple; push @rows, $row; } } return \@rows if $ismultiple; return $found ? $row : undef; } sub TIEHASH { my $class = shift; my $ad = shift; my $perms = shift || 'r'; my $records = shift || {}; my $self = { INDEX => 0, RECORDS => $records, ad => $ad, del_marker => "\0", needs_packing => 0, PERMS => $perms, }; return bless $self, $class; } sub verify_columns { my $col_names = shift; my $val = shift; my %is_col = map {$_ => 1} @$col_names; my $errstr = "ERROR: XXX is not a column in the table!\n"; $errstr .= scalar @$col_names ? " columns are: " . join "~",@$col_names,"\n" : " couldn't find any column names\n"; if (ref $val eq 'HASH') { for (keys %$val) { $errstr =~ s/XXX/$_/; die $errstr if !$is_col{$_}; } } else { $errstr =~ s/XXX/$val/; $is_col{$val} ? return 1 : die $errstr; } } sub STORE { my($self,$key,$value) = @_; #my @c = caller 1; $self->{errstr} = "Can't store: file is opened in 'r' read-only mode!" if $self->{PERMS} eq 'r'; return undef if $self->{errstr}; my @colnames = @{ $self->{ad}->col_names }; verify_columns(\@colnames,$value); return $self->{ad}->update_multiple_rows($key,$value) if ref $key eq 'HASH'; $self->{ad}->seek(0,2); my @newrow; for my $i(0..$#colnames) { $newrow[$i] = $value->{$colnames[$i]}; next if defined $newrow[$i]; $newrow[$i] = $key if $colnames[$i] eq $self->{ad}->key_col; $newrow[$i] = undef unless $newrow[$i]; } return $self->{ad}->push_row(@newrow); } sub DELETE { my($self,$key)=@_; die "Can't delete: file is opened in 'r' read-only mode!" if $self->{PERMS} eq 'r'; my $row; my $count; return $self->{ad}->delete_multiple_rows($key) if ref $key; if ($row = $self->FETCH($key) ) { $self->{ad}->delete_single_row; $self->{needs_packing}++; $count++; } #return $row; return $count; } sub EXISTS { my($self,$key)=@_; return $self->FETCH($key); } sub FIRSTKEY { my $self = shift; $self->{ad}->seek_first_record(); my $found =0; my $row; while (!$found) { $row = $self->{ad}->fetchrow_hashref() or last; $found++; last; } return $found ? $row : undef; } sub NEXTKEY { my $self = shift; my $row; my $lastcol=0; my $found=0; while (!$found) { $row = $self->{ad}->fetchrow_hashref() or last; $found++; last; } return $found ? $row : undef; } sub adRows { my $self = shift; my $key = shift; my $count=0; $self->{ad}->seek_first_record; if (!$key) { while (my $row = $self->{ad}->fetchrow_hashref) { $count++; } } else { while (my $row = $self->{ad}->fetchrow_hashref) { $count++ if $self->{ad}->match($row,$key); } } return $count; } sub adColumn { my($self,$column,$flags)=@_; $flags ||= ''; my @results=(); $self->{ad}->seek_first_record; while (my $row = $self->{ad}->fetchrow_hashref) { push @results, $row->{$column} } my %is_member; @results = grep(!$is_member{$_}++, @results) if $flags; $flags =~ /u/i; # @results = sort @results if $flags =~ /a/i; # @results = reverse sort @results if $flags =~ /d/i; return @results; } sub DESTROY { #my $self=shift; #undef $self->{ad}; #print "HASH DESTROYED"; } ############################## # END OF AnyData::Tiedhash ############################## 1;