Changeset 30338 for gs2-extensions

Show
Ignore:
Timestamp:
03.12.2015 15:44:18 (4 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 modified

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);