/[wait]/trunk/lib/WAIT/Index.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /trunk/lib/WAIT/Index.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

branches/CPAN/lib/WAIT/Index.pm revision 11 by unknown, Fri Apr 28 15:41:10 2000 UTC trunk/lib/WAIT/Index.pm revision 88 by dpavlin, Mon May 24 13:44:01 2004 UTC
# Line 1  Line 1 
1  #                              -*- Mode: Perl -*-  #                              -*- Mode: Cperl -*-
2  # Index.pm --  # Index.pm --
3  # ITIID           : $ITI$ $Header $__Header$  # ITIID           : $ITI$ $Header $__Header$
4  # Author          : Ulrich Pfeifer  # Author          : Ulrich Pfeifer
5  # Created On      : Thu Aug  8 13:05:10 1996  # Created On      : Thu Aug  8 13:05:10 1996
6  # Last Modified By: Ulrich Pfeifer  # Last Modified By: Ulrich Pfeifer
7  # Last Modified On: Sun Nov 22 18:44:43 1998  # Last Modified On: Sat Apr 27 18:06:47 2002
8  # Language        : CPerl  # Language        : CPerl
9  # Update Count    : 107  # Update Count    : 128
10  # Status          : Unknown, Use with caution!  # Status          : Unknown, Use with caution!
11  #  #
12  # Copyright (c) 1996-1997, Ulrich Pfeifer  # Copyright (c) 1996-1997, Ulrich Pfeifer
# Line 15  Line 15 
15  package WAIT::Index;  package WAIT::Index;
16  use WAIT::IndexScan;  use WAIT::IndexScan;
17  use strict;  use strict;
18  use DB_File;  use BerkeleyDB;
19  use Fcntl;  use Fcntl;
20    use vars qw($VERSION);
21    
22  sub fail {  $VERSION = "1.801"; # Table.pm tests if we are loaded by checking $VERSION
   $@ .= join "\n", @_;  
   return undef;  
 }  
23    
24  sub new {  sub new {
25    my $type = shift;    my $type = shift;
26    my %parm = @_;    my %parm = @_;
27    my $self = {};    my $self = {};
28    
29    $self->{file}     = $parm{file}     or return fail("No file specified");    unless ($self->{file} = $parm{file}) {
30    $self->{attr}     = $parm{attr}     or return fail("No attributes specified");      require Carp;
31        Carp::croak("No file specified");
32      }
33      unless ($self->{name} = $parm{name}) {
34        require Carp;
35        Carp::croak("No name specified");
36      }
37      unless ($self->{attr} = $parm{attr}) {
38        require Carp;
39        Carp::croak("No attributes specified");
40      }
41    bless $self, ref($type) || $type;    bless $self, ref($type) || $type;
42  }  }
43    
# Line 37  sub drop { Line 45  sub drop {
45    my $self = shift;    my $self = shift;
46    if ((caller)[0] eq 'WAIT::Table') { # Table knows about this    if ((caller)[0] eq 'WAIT::Table') { # Table knows about this
47      my $file = $self->{file};      my $file = $self->{file};
   
48      ! (!-e $file or unlink $file);      ! (!-e $file or unlink $file);
49    } else {                              # notify our database    } else {                            # notify our database
50      fail ref($self)."::drop called directly";      require Carp;
51        Carp::croak(ref($self)."::drop called directly");
52    }    }
53  }  }
54    
# Line 48  sub open { Line 56  sub open {
56    my $self = shift;    my $self = shift;
57    my $file = $self->{file};    my $file = $self->{file};
58    
59    if (exists $self->{dbh}) {    if ($self->{dbh}) {
60      $self->{dbh};      $self->{dbh};
61    } else {    } else {
62      $self->{dbh} = tie(%{$self->{db}}, 'DB_File', $file,      my $dbmode = ($self->{mode} & O_CREAT) ? DB_CREATE : 0;
63                         $self->{mode}, 0664, $DB_BTREE);      $self->{dbh} = tie(%{$self->{db}}, 'BerkeleyDB::Btree',
64                           -Filename => $self->{file},
65                           -Subname  => 'records',
66                           -Flags    => $dbmode,
67                           -Mode     => 0664);
68    }    }
69  }  }
70    
# Line 69  sub insert { Line 81  sub insert {
81      # duplicate entry      # duplicate entry
82      return undef;      return undef;
83    }    }
84      print STDERR "$tuple => $key\n";
85    $self->{db}->{$tuple} = $key;    $self->{db}->{$tuple} = $key;
86  }  }
87    
# Line 80  sub have { Line 93  sub have {
93    
94    my $tuple = join($;, map($parm{$_}, @{$self->{attr}}));    my $tuple = join($;, map($parm{$_}, @{$self->{attr}}));
95    
96    exists $self->{db}->{$tuple} && $self->{db}->{$tuple};    print STDERR "$tuple <= ", $self->{db}->{$tuple}, "\n";
97      $self->{db}->{$tuple};
98  }  }
99    
100  sub fetch {  sub fetch {
101    my $self  = shift;    my $self  = shift;
102    my %parm  = @_;    my %parm  = @_;
103    my @keys  = @{$self->{attr}->[0]};    my @keys  = @{$self->{attr}->[0]};
104      
105    defined $self->{db} or $self->open;    defined $self->{db} or $self->open;
106    
107    my $key   = join($;, map($parm{$_}, @keys));    my $key   = join($;, map($parm{$_}, @keys));
# Line 101  sub delete { Line 115  sub delete {
115    
116    defined $self->{db} or $self->open;    defined $self->{db} or $self->open;
117    
118    my $tuple = join($;, map($parm{$_}, @{$self->{attr}}));    my $tuple = join($;, map($parm{$_}||"", @{$self->{attr}}));
119      
120    delete $self->{db}->{$tuple};    delete $self->{db}->{$tuple};
121  }  }
122    
123  sub sync {  sub sync {
124    my $self = shift;    my $self = shift;
125    $self->{dbh}->sync if $self->{dbh};    $self->{dbh}->db_sync if $self->{dbh};
126  }  }
127    
128  sub close {  sub close {
# Line 118  sub close { Line 132  sub close {
132    
133    if ($self->{dbh}) {    if ($self->{dbh}) {
134      delete $self->{dbh};      delete $self->{dbh};
     untie %{$self->{db}};  
135      delete $self->{db};      delete $self->{db};
136        #untie %{$self->{db}};
137    }    }
138  }  }
139    
# Line 128  sub close { Line 142  sub close {
142  sub open_scan {  sub open_scan {
143    my $self = shift;    my $self = shift;
144    my $code = shift;    my $code = shift;
145      
146    $self->{dbh} or $self->open;    $self->{dbh} or $self->open;
147    new WAIT::IndexScan $self, $code;    new WAIT::IndexScan $self, $code;
148  }  }
Legend:
Removed from v.11  
changed lines
  Added in v.88
  ViewVC Help
Powered by ViewVC 1.1.26