Changeset 30338 for gs2-extensions


Ignore:
Timestamp:
2015-12-03T15:44:18+13:00 (8 years ago)
Author:
jmt12
Message:

First versions of these drivers, that should be further refined to move repeated code to a parent class

Location:
gs2-extensions/tdb/trunk/perllib/DBDrivers
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • gs2-extensions/tdb/trunk/perllib/DBDrivers/JDBM.pm

    r30318 r30338  
    3232use util;
    3333use FileUtils;
    34 use DBDrivers::BaseDBDriver;
     34# - OO inheritence
     35use parent 'DBDrivers::BaseDBDriver';
    3536
    3637sub BEGIN
    3738{
    38     @DBDrivers::JDBM::ISA = ( 'DBDrivers::BaseDBDriver' );
    39 }
    40 
     39    if (!defined $ENV{'GSDLHOME'} || !defined $ENV{'GSDLOS'}) {
     40        die("Error! Environment must be prepared by sourcing setup.bash\n");
     41    }
     42}
     43
     44
     45## @function constructor
     46#
    4147sub new
    4248{
    4349    my $class = shift(@_);
    44     return bless ($self, $class);
    45 }
     50    my $self = DBDrivers::BaseDBDriver->new();
     51    $self->{'default_file_extension'} = 'jdb';
     52    bless($self, $class);
     53    return $self;
     54}
     55## constructor() ##
     56
    4657
    4758# -----------------------------------------------------------------------------
    … …  
    5465# be constructed that changes between much of the code that is used
    5566
     67# Handled by BaseDBDriver
     68# sub get_infodb_file_path {}
     69
     70
     71
    5672sub open_infodb_write_handle
    5773{
    58   my $infodb_file_path = shift(@_);
    59   my $opt_append = shift(@_);
    60 
    61   my $jdbmwrap_jar = &util::filename_cat($ENV{'GSDLHOME'},"bin","java", "JDBMWrapper.jar");
    62   my $jdbm_jar = &util::filename_cat($ENV{'GSDLHOME'},"lib","java", "jdbm.jar");
     74    my $self = shift(@_);
     75    my $infodb_file_path = shift(@_);
     76    my $opt_append = shift(@_);
     77    if (!defined $opt_append) {
     78    $opt_append = '';
     79    }
     80    $self->_debugPrint('("' . $infodb_file_path . '","' . $opt_append . '")');
     81
     82    my $jdbmwrap_jar = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'},"bin","java", "JDBMWrapper.jar");
     83    my $jdbm_jar = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'},"lib","java", "jdbm.jar");
    6384
    6485  my $classpath = &util::pathname_cat($jdbmwrap_jar,$jdbm_jar);
    … …  
    7697  my $txt2jdb_cmd = "java -cp \"$classpath\" Txt2Jdb";
    7798
    78   if ((defined $opt_append) && ($opt_append eq "append")) {
     99  if ($opt_append eq "append") {
    79100      $txt2jdb_cmd .= " -append";
    80101      print STDERR "Append operation to $infodb_file_path\n";
    … …  
    113134
    114135  close($infodb_handle);
    115 }
    116 
    117 
    118 sub get_infodb_file_path
    119 {
    120   my $collection_name = shift(@_);
    121   my $infodb_directory_path = shift(@_);
    122 
    123   my $infodb_file_extension = ".jdb";
    124   my $infodb_file_name = &util::get_dirsep_tail($collection_name) . $infodb_file_extension;
    125   return &util::filename_cat($infodb_directory_path, $infodb_file_name);
    126136}
    127137

  • gs2-extensions/tdb/trunk/perllib/DBDrivers/TDB.pm

    r30318 r30338  
    3232# Libraries
    3333use Cwd;
     34use Devel::Peek;
    3435use ghtml;
     36use Scalar::Util 'refaddr';
    3537use util;
    36 use DBDrivers::GDBM;
     38# - OO inheritence
     39use parent 'DBDrivers::GDBM';
    3740
    3841sub BEGIN
    … …  
    4447        die("Error! Path to TDB binaries not found. Have you sourced setup.bash?\n");
    4548    }
    46     @DBDrivers::TDB::ISA = ( 'DBDrivers::GDBM' );
    4749}
    4850
    … …  
    5052{
    5153    my $class = shift(@_);
    52     return bless ($self, $class);
    53 }
     54
     55    my $self = DBDrivers::GDBM->new();
     56
     57    # Default TDB file extension
     58    $self->{'default_file_extension'} = 'tdb';
     59    # Should the TDB used a specific affinity?
     60    $self->{'forced_affinity'} = -1; # zero upwards indicates the affinity
     61    # Keep track of all opened file handles
     62    $self->{'handle_pool'} = {};
     63    # Ask TDB executables to display debugging information?
     64    $self->{'tdb_debug'} = 0; # 1 to enable
     65
     66    bless($self, $class);
     67    return $self;
     68}
     69
     70
     71## @function DESTROY
     72#
     73# Built-in destructor block that, unlike END, gets passed a reference to self.
     74# Responsible for properly closing any open database handles.
     75#
     76sub DESTROY
     77{
     78    my $self = shift(@_);
     79    # Close all remaining filehandles
     80    foreach my $infodb_file_path (keys(%{$self->{'handle_pool'}})) {
     81    my $infodb_handle = $self->{'handle_pool'}->{$infodb_file_path};
     82    # By passing the filepath as the second argument we instruct the driver
     83    # that we actually want to close the connection by passing a non-zero
     84    # value, but we sneakily optimize things a little as the close method
     85    # can now check to see if it's been provided a file_path rather than
     86    # having to search the handle pool for it. The file_path is needed to
     87    # remove the closed handle from the pool anyway.
     88    $self->close_infodb_write_handle($infodb_handle, $infodb_file_path);
     89    }
     90}
     91## DESTROY(void) => void ##
     92
    5493
    5594# -----------------------------------------------------------------------------
    … …  
    5796# -----------------------------------------------------------------------------
    5897
    59 ## Ask TDB executables to display debugging information?
    60 my $debug = 0; # 1 to enable
    61 
    62 ## Should the TDB used a specific affinity?
    63 my $forced_affinity = -1; # zero upwards indicates the affinity
    64 
    65 ## Default TDB file extension
    66 my $infodb_file_extension = '.tdb';
    6798
    6899## @function _get_tdb_executable(string)
    … …  
    70101sub _get_tdb_executable
    71102{
     103    my $self = shift(@_);
    72104    my $program = shift(@_);
    73105    if (!defined $ENV{GEXTTDBEDIT_INSTALLED} || !-d $ENV{GEXTTDBEDIT_INSTALLED})
    … …  
    82114    return $program_exe;
    83115}
    84 ## get_tdb_executable(string) => string ##
    85 
     116## _get_tdb_executable(string) => string ##
     117
     118
     119# Handled by BaseDBDriver
     120# sub get_infodb_file_path(string, string)
    86121
    87122# With infodb_handle already set up, these functions work the same as parent version
    88 # sub close_infodb_write_handle {}
    89123# sub delete_infodb_entry {}
    90124# sub write_infodb_entry {}
    … …  
    92126
    93127
     128## @function close_infodb_write_handle(filehandle)
     129#
     130#  Some slight-of-hand here due to the way Perl passes variables to methods.
     131#  Most of the time (i.e. under all the existing calls in the Greenstone code)
     132#  this does nothing, as TDB handles can be left open and reused by multiple
     133#  writers/readers (the exception being complete file reads, but they are
     134#  handled in their own function anyway).
     135#
     136#  However TDB's version of this function will look for an extra variable and,
     137#  if true (non-zero), will actually close the handle. Several methods below
     138#  call close but also pass the infodb_file_path as the second argument, which
     139#  is enough to have the connections properly closed.
     140#
     141#  Note that when this class passes from scope all open handles will be
     142#  properly closed by the DESTROY block.
     143#
     144sub close_infodb_write_handle {
     145    my $self = shift(@_);
     146    my $infodb_handle = shift(@_);
     147    my $actually_close = shift(@_); # Undefined most of the time
     148    if (defined($actually_close)) {
     149    $self->_debugPrint('(<infodb_handle>,"' . $actually_close . '")');
     150    # We'll need the file path so we can locate and remove the entry in the
     151    # handle pool
     152    my $infodb_file_path = undef;
     153    # Sometimes we can cheat, as the actually_close variable will have the
     154    # file_path in it thanks to the DESTROY block above. Doing a regex on
     155    # actually_close will treat it like a string no matter what it was, and
     156    # we can search for the appropriate file extension that should be there
     157    # for valid paths.
     158    my $pattern = '\.' . $self->{'default_file_extension'} . '$';
     159    if ($actually_close =~ /$pattern/) {
     160        $infodb_file_path = $actually_close;
     161    }
     162    # If we can't cheat then we are stuck finding which connection in the
     163    # handle_pool we are about to close. Need to compare objects using
     164    # refaddr()
     165    else {
     166        foreach my $possible_file_path (values(%{$self->{'handle_pool'}})) {
     167        my $possible_handle = $self->{'handle_pool'}->{$possible_file_path};
     168        if (ref($infodb_handle) && ref($possible_handle) && refaddr($infodb_handle) == refaddr($possible_handle)) {
     169            $infodb_file_path = $possible_file_path;
     170            last;
     171        }
     172        }
     173    }
     174    if (defined($infodb_file_path)) {
     175        delete($self->{'handle_pool'}->{$infodb_file_path});
     176    }
     177    else {
     178        print STDERR "Warning! About to close TDB database handle, but couldn't locate in open handle pool.\n";
     179    }
     180    # Call GDBM's close to do the heavy-lifting
     181    $self->SUPER::close_infodb_write_handle($infodb_handle);
     182    }
     183}
     184## close_infodb_write_handle(filehandle) => void ##
     185
     186
    94187## @function open_infodb_write_handle(string, string)
    95188#
    96189sub open_infodb_write_handle
    97190{
     191    my $self = shift(@_);
    98192    my $infodb_file_path = shift(@_);
    99193    my $opt_append = shift(@_);
    100194
    101     my $txt2tdb_exe = &_get_tdb_executable('txt2tdb');
    102 
    103     my $pool_key = $infodb_file_path;
     195    my $txt2tdb_exe = $self->_get_tdb_executable('txt2tdb');
     196
    104197    my $cmd = '"' . $txt2tdb_exe . '"';
    105198    if ((defined $opt_append) && ($opt_append eq "append")) {
    … …  
    108201    $cmd .= ' "' . $infodb_file_path . '"';
    109202    # Optional flags
    110     if ($forced_affinity >= 0) {
     203    if ($self->{'forced_affinity'} >= 0) {
    111204        $cmd = 'taskset -c 5 ' . $cmd;
    112205    }
    113     if ($debug) {
     206    if ($self->{'debug'}) {
    114207        $cmd .= ' -debug';
    115208    }
    … …  
    118211    # within the buildproc, so we create a piped handle here
    119212    my $infodb_file_handle = undef;
    120     print STDERR "tdb::open_infodb_write_handle(" . $infodb_file_path . ")\n";
    121     if(!open($infodb_file_handle, "| $cmd")) {
    122         print STDERR "Error: Failed to open pipe to $cmd\n";
    123         print STDERR "       $!\n";
    124         return undef;
    125     }
    126     binmode($infodb_file_handle,":utf8");
     213    # if the connection is already open, simply return it.
     214    if (defined $self->{'handle_pool'}->{$infodb_file_path}) {
     215    $infodb_file_handle = $self->{'handle_pool'}->{$infodb_file_path};
     216    }
     217    else {
     218    $self->_debugPrint('(' . $infodb_file_path . ')');
     219    if(!open($infodb_file_handle, "| $cmd")) {
     220        print STDERR "Error: Failed to open pipe to $cmd\n";
     221        print STDERR "       $!\n";
     222        return undef;
     223    }
     224    binmode($infodb_file_handle,":utf8");
     225    # Remember to store the newly created connection in the pool so we can
     226    # re-use for subsequent calls.
     227    $self->{'handle_pool'}->{$infodb_file_path} = $infodb_file_handle;
     228    }
    127229    return $infodb_file_handle;
    128230}
    … …  
    130232
    131233
    132 ## @function get_infodb_file_path(string, string)
    133 #
    134 sub get_infodb_file_path
    135 {
    136     my $collection_name = shift(@_);
    137     my $infodb_directory_path = shift(@_);
    138     my $infodb_file_name = &util::get_dirsep_tail($collection_name) . $infodb_file_extension;
    139     return &util::filename_cat($infodb_directory_path, $infodb_file_name);
    140 }
    141 ## get_infodb_file_path(string, string) => string ##
    142 
    143 
    144234## @function read_infodb_file
    145235#
    146236sub read_infodb_file
    147237{
     238    my $self = shift(@_);
    148239    my $infodb_file_path = shift(@_);
    149240    my $infodb_map = shift(@_);
    150241
    151     my $tdb2txt_exe = &_get_tdb_executable('tdb2txt');
     242    $self->_debugPrint('(' . $infodb_file_path . ', <hashmap>)');
     243
     244    my $tdb2txt_exe = $self->_get_tdb_executable('tdb2txt');
    152245
    153246    if (!open (PIPEIN, '"' . $tdb2txt_exe . '" "' . $infodb_file_path . '" |')) {
    … …  
    184277sub read_infodb_keys
    185278{
     279    my $self = shift(@_);
    186280    my $infodb_file_path = shift(@_);
    187281    my $infodb_map = shift(@_);
    188282
    189     my $tdbkeys_exe = &_get_tdb_executable('tdbkeys');
    190 
    191     if (!open (PIPEIN, '"' . tdbkeys_exe . '" "' . $infodb_file_path . '" |')) {
     283    $self->_debugPrint('(' . $infodb_file_path . ', <hashmap>)');
     284
     285    my $tdbkeys_exe = $self->_get_tdb_executable('tdbkeys');
     286
     287    if (!open (PIPEIN, '"' . $tdbkeys_exe . '" "' . $infodb_file_path . '" |')) {
    192288        die("Error! Couldn't open pipe from read_infodb_keys: $infodb_file_path\n$!\n");
    193289    }
    … …  
    213309sub set_infodb_entry
    214310{
     311    my $self = shift(@_);
    215312    my $infodb_file_path = shift(@_);
    216313    my $infodb_key = shift(@_);
    217314    my $infodb_map = shift(@_);
     315
     316    $self->_debugPrint('(' . $infodb_file_path . ', ' . $infodb_key . ', <hashmap>)');
    218317
    219318    # Protect metadata values that go inside quotes for tdbset
    … …  
    236335
    237336    # Generate the record string
    238     my $serialized_infodb_map = &_convert_infodb_hash_to_string($infodb_map);
     337    my $serialized_infodb_map = $self->_convert_infodb_hash_to_string($infodb_map);
    239338
    240339    # Store it into GDBM
    241     my $tdbset_exe = &_get_tdb_executable('tdbset');
     340    my $tdbset_exe = $self->_get_tdb_executable('tdbset');
    242341    my $cmd = '"' . $tdbset_exe . '" "' . $infodb_file_path . '" "' . $infodb_key . '" "' . $serialized_infodb_map . '"';
    243342    my $status = system($cmd);
Note: See TracChangeset for help on using the changeset viewer.