2.7.3.1. Localized storage and retrieval

Self-containment can be beneficial, as it tends to concentrate the logic of a script internally, making things slightly more simple to understand. Unfortunately, this localization can also be a real pain. Take our megalithic database as a good example. In the previous section, we wrote four different Perl scripts to handle the four main data manipulation operations. With localized logic, you're essentially implementing the same storing and extraction code in four different places.

Furthermore, if you decide to change the format of the data, you need to keep four different scripts in sync. Given that it's also likely that you'll add more scripts to perform more specific functions (such as generating web pages) with the appropriate megalithic data from the database, that gives your database more points of potential failure and inevitable corruption.

### Insert some data rows
$database{'Callanish I'} =
    join( ':', 'Callanish I', 'Callanish, Western Isles', 'NB 213 330',
               'Stone Circle', 'Description of Callanish I' );
$database{'Avebury'} =
    join( ':', 'Avebury', 'Wiltshire', 'SU 103 700', 
               'Stone Circle and Henge',
               'Description of Avebury' );
$database{'Lundin Links'} =
    join( ':', 'Lundin Links', 'Fife', 'NO 404 027', 'Standing Stones',
               'Description of Lundin Links' );
### Dump the database
foreach my $key ( keys %database ) {
    my ( $name, $location, $mapref, $type, $description ) =
         split( /:/, $database{$key} );
    print "$name\n", ( "=" x length( $name ) ), "\n\n";
    print "Location:      $location\n";
    print "Map Reference: $mapref\n";
    print "Description:   $description\n\n";
}

The code to insert and dump megalithic data using fixed-length records is shown in the following code segment:

### The pack and unpack template.
$PACKFORMAT = 'A64 A64 A16 A32 A256';

### Insert some data rows
$database{'Callanish I'} =
    pack( $PACKFORMAT, 'Callanish I', 'Callanish, Western Isles', 
                     'NB 213 330', 'Stone Circle', 
                     'Description of Callanish I' );

$database{'Avebury'} =
    pack( $PACKFORMAT, 'Avebury', 'Wiltshire', 'SU 103 700', 
                     'Stone Circle and Henge', 'Description of Avebury' );

$database{'Lundin Links'} =
    pack( $PACKFORMAT, 'Lundin Links', 'Fife', 'NO 404 027', 
                     'Standing Stones', 
                     'Description of Lundin Links' );

### Dump the database
foreach my $key ( keys %database ) {
    my ( $name, $location, $mapref, $type, $description ) =
        unpack( $PACKFORMAT, $database{$key} );
    print "$name\n", ( "=" x length( $name ) ), "\n\n";
    print "Location:      $location\n";
    print "Map Reference: $mapref\n";
    print "Description:   $description\n\n";
}

The actual code to express the storage and retrieval mechanism isn't really much more horrible than the delimited record version, but it does introduce a lot of gibberish in the form of the pack( ) template, which could easily be miskeyed or forgotten about. This also doesn't really solve the problem of localized program logic, and turns maintenance into the aforementioned nightmare.

2.7.3.2. Packing in Perl objects

The following Perl code defines an object of class Megalith. We can then reuse this packaged object module in all of our programs without having to rewrite any of them, if we change the way the module works:

#!/usr/bin/perl -w
  #
  # ch02/DBM/Megalith.pm: A perl class encapsulating a megalith
  
  package Megalith;
  
  use strict;
  use Carp;
  
  ### Creates a new megalith object and initializes the member fields.
  sub new {
      my $class = shift;
      my ( $name, $location, $mapref, $type, $description ) = @_;
      my $self = {};
      bless $self => $class;
      
      ### If we only have one argument, assume we have a string
      ### containing all the field values in $name and unpack it
      if ( @_ == 1 ) {
          $self->unpack( $name );
      }
      else {
          $self->{name} = $name;
          $self->{location} = $location;
          $self->{mapref} = $mapref;
          $self->{type} = $type;
          $self->{description} = $description;
      }
      return $self;
  }
  
  ### Packs the current field values into a colon delimited record
  ### and returns it
  sub pack {
      my ( $self ) = @_;
      
      my $record = join( ':', $self->{name}, $self->{location},
                              $self->{mapref}, $self->{type},
                              $self->{description} );
      
      ### Simple check that fields don't contain any colons
      croak "Record field contains ':' delimiter character"
          if $record =~ tr/:/:/ != 4;
      
      return $record;
  }
  
  ### Unpacks the given string into the member fields
  sub unpack {
      my ( $self, $packedString ) = @_;
      
      ### Naive split...Assumes no inter-field delimiters
      my ( $name, $location, $mapref, $type, $description ) =
           split( ':', $packedString, 5 );
      
      $self->{name} = $name;
      $self->{location} = $location;
      $self->{mapref} = $mapref;
      $self->{type} = $type;
      $self->{description} = $description;
  }
  
  ### Displays the megalith data
  sub dump {
      my ( $self ) = @_;
      
      print "$self->{name} ( $self->{type} )\n", 
            "=" x ( length( $self->{name} ) + 
                    length( $self->{type} ) + 5 ), "\n";
      print "Location:      $self->{location}\n"; 
      print "Map Reference: $self->{mapref}\n";
      print "Description:   $self->{description}\n\n";
  }
  
  1;

The record format defined by the module contains the items of data pertaining to each megalithic site that can be queried and manipulated by programs. A new Megalith object can be created from Perl via the new operator, for example:

### Create a new object encapsulating Stonehenge
$stonehenge = 
    new Megalith( 'Stonehenge', 'Description of Stonehenge',
                  'Wiltshire', 'SU 123 400' );

### Display the name of the site stored within the object ...
print "Name: $stonehenge->{name}\n";

It would be extremely nice if these Megalith objects could be stored directly into a DBM file. Let's try a simple piece of code that simply stuffs the object into the hash:

### Create a new object encapsulating Stonehenge
$stonehenge = 
    new Megalith( 'Stonehenge', 'Description of Stonehenge',
                  'Wiltshire', 'SU 123 400' );

### Store the object within the database hash
$database{'Stonehenge'} = $stonehenge;

### Have a look at the entry within the database
print "Key: $database{'Stonehenge'}\n";

This generates some slightly odd results, to say the least:

Key: Megalith=HASH(0x80e9aec)

What appears to have happened is that the string describing the reference to the Perl object has been inserted in the Berkeley DB instead of the object itself!

This result is perhaps not surprising, given that the DBM systems are really designed for storing single string values, and there is no innate understanding of how to compact complex objects into a single value. It simply converts all keys and values into strings.

By using our conveniently defined Megalith class, we can write the following code to do this (note the calling of the pack() method):

$database{'Callanish I'} =
    new Megalith( 'Callanish I', 
                  'Western Isles',
                  'NB 213 330',
                  'Stone Circle',
                  'Description of Callanish I' )->pack(  );

### Dump the database
foreach $key ( keys %database ) {

    ### Unpack the record into a new megalith object
    my $megalith = new Megalith( $database{$key} );

    ### And display the record
    $megalith->dump(  );
}

Similarly, the actual way in which the data is packed and unpacked is hidden from the module user. This means that if any database structural changes need to be made, they can be made internally without any maintenance on the database manipulation scripts themselves.

If you read the section on putting complex data into flat files earlier in the chapter, then you'll know that there's more than one way to do it.

2.7.3.3. Object accessor methods

print "Megalith Name: $megalith->{name}\n";

This may cause problems if the internal structure of the Megalith object alters in some way. Also, if you write $megalith->{nme} by mistake, no errors or warnings will be generated. Defining an accessor method called getName( ), such as:

### Returns the name of the megalith
sub getName {
    my ( $self ) = @_;
    return $self->{name};
}

makes the code arguably more readable:

print "Megalith Name: " . $megalith->getName(  ) . "\n";

and also ensures the correctness of the application code, since the actual logic is migrated, once again, into the object.

2.7.3.4. Querying limitations of DBM files and hashtables

This might be a pretty big problem, given that you might wish to issue a query such as, ``tell me about all the sites in Wiltshire,'' without specifying an exact name. In this case, every record would be tested to see if any fit the bill. This would use a sequential search instead of the indexed access you have when querying against the key.

### Build a referential hash based on the location of each monument
$locationDatabase{'Wiltshire'}     = \$database{'Avebury'};
$locationDatabase{'Western Isles'} = \$database{'Callanish I'};
$locationDatabase{'Fife'}          = \$database{'Lundin Links'};

### Dump the location database
foreach $key ( keys %locationDatabase ) {

    ### Unpack the record into a new megalith object
    my $megalith = new Megalith( ${ $locationDatabase{$key} } );

    ### And display the record
    $megalith->dump(  );
}

There are, of course, a few drawbacks to this particular solution. The most apparent is that any data deletion or insertion would require a mirror operation to be performed on each secondary reference hash.

The biggest problem with this approach is that your data might not have unique keys. If we wished to store records for Stonehenge and Avebury, both of those sites have a location of Wiltshire. In this case, the latest inserted record would always overwrite the earlier records inserted into the hash. To solve this general problem, we can use a feature of Berkeley DB files that allows value chaining.

2.7.3.5. Chaining multiple values into a hash

A Perl solution to this problem is to push the multiple values onto an array that is stored within the hash element. This technique works fine while the program is running, because the array references are still valid, but when the database is written out and reloaded, the data is invalid.

#!/usr/bin/perl -w
  #
  # ch02/DBM/dupkey1: Creates a Berkeley DB with the DB_BTREE mechanism and 
  #                   allows for duplicate keys. We then insert some test 
  #                   object data with duplicate keys and dump the final
  #                   database.
  
  use DB_File;
  use Fcntl ':flock';
  use Megalith;
  
  ### Set Berkeley DB BTree mode to handle duplicate keys
  $DB_BTREE->{'flags'} = R_DUP;
  
  ### Remove any existing database files
  unlink 'dupkey2.dat';
  
  ### Open the database up
  my %database;
  my $db = tie %database, 'DB_File', "dupkey2.dat", 
                 O_CREAT | O_RDWR, 0666, $DB_BTREE
      or die "Can't initialize database: $!\n";
  
  ### Exclusively lock the database to ensure no one accesses it
  my $fd = $db->fd(  );
  open DATAFILE, "+<&=$fd"
      or die "Can't safely open file: $!\n";
  print "Acquiring exclusive lock...";
  flock( DATAFILE, LOCK_EX )
      or die "Unable to acquire lock: $!. Aborting";
  print "Acquired lock. Ready to update database!\n\n";
  
  ### Create, pack and insert some rows with duplicate keys
  $database{'Wiltshire'} = 
    new Megalith( 'Avebury',
                  'Wiltshire',
                  'SU 103 700',
                  'Stone Circle and Henge',
                  'Largest stone circle in Britain' )->pack(  );
  
  $database{'Wiltshire'} =
    new Megalith( 'Stonehenge',
                  'Wiltshire',
                  'SU 123 400',
                  'Stone Circle and Henge',
                  'The most popularly known stone circle in the world' )->pack(  );
  
  $database{'Wiltshire'} =
    new Megalith( 'The Sanctuary',
                  'Wiltshire',
                  'SU 118 680',
                  'Stone Circle ( destroyed )',
                  'No description available' )->pack(  );
  
  ### Dump the database
  foreach my $key ( keys %database ) {
  
      ### Unpack the record into a new megalith object
      my $megalith = new Megalith( $database{$key} );
      
      ### And display the record
      $megalith->dump(  );
  }
  
  ### Close the database
  undef $db;
  untie %database;
  
  ### Close the filehandle to release the lock
  close DATAFILE;
  
  exit;

The output you get from running this program is not exactly what we'd hoped for:

Acquiring exclusive lock...Acquired lock. Ready to update database!
  
  The Sanctuary ( Stone Circle ( destroyed ) )
  ============================================
  Location:      Wiltshire
  Map Reference: SU 118 680
  Description:   No description available
  
  The Sanctuary ( Stone Circle ( destroyed ) )
  ============================================
  Location:      Wiltshire
  Map Reference: SU 118 680
  Description:   No description available
  
  The Sanctuary ( Stone Circle ( destroyed ) )
  ============================================
  Location:      Wiltshire
  Map Reference: SU 118 680
  Description:   No description available

It seems that we've managed to successfully store three copies of the same record instead of three different records!

Fortunately, this isn't actually the case. We have correctly stored the three different records with the same key in the DBM file. The problem lies in the way we've tried to read these records back out of the DBM file. A basic dereference using the hash key obviously doesn't work, since Perl stores only a single value for each key, as we already know.

Figure 2-1. Chained record traversal

The corrected record dumping chunk is rewritten to use seq() in this way:

### Dump the database
my ($key, $value, $status) = ('', '', 0);
for ( $status = $db->seq( $key, $value, R_FIRST ) ;
      $status == 0 ;
      $status = $db->seq( $key, $value, R_NEXT ) ) {

    ### Unpack the record into a new megalith object
    my $megalith = new Megalith( $value );

    ### And display the record
    $megalith->dump();
}

The seq() method is quite simple to use and understand, and it works well when used in conjunction with a for loop, as shown above. The method takes three arguments: the hash key, the hash value, and a flag signifying which element within the chain should be returned. The first two arguments are actually populated with the hash key and the correct hash value, respectively, when seq() is called. Exactly which hash value is returned depends on the value of the third argument:

• R_FIRST returns the first record within the chain of records.

• R_LAST returns the last record stored within the chain of records.

• R_NEXT returns the next record within the chain of records. This is used for forward sequential traversals of the chain.

• R_PREV returns the previous record within the chain of records. This is used for backward sequential traversals of the chain.

• R_CURSOR returns a record in which a partial match for the key has been located. This allows a certain element of "fuzzy matching" of keys. This feature is not necessarily accurate and may return the closest match to the desired key rather than an exact match. For example, if you searched for all sites within Wiltshire and asked for a partial match against ``wilt'', but no exact records matched, you may be returned the entries for the ``Western Isles,'' as these are the closest to the search term.

In the database dumping example shown above, we are simply starting at the beginning of the record chain and traversing through it in a forward direction. We could have performed a backward search by writing:

for ( $status = $db->seq( $key, $value, R_LAST ) ;
      $status == 0 ;
      $status = $db->seq( $key, $value, R_PREV ) ) {
    ...
}

### Displays the number of records inserted against 
### the "Wiltshire" key
my $numRecords = $db->get_dup( 'Wiltshire' );
print "Number of Wiltshire records: $numRecords\n";