source: gs2-extensions/tdb/trunk/perllib/DBDrivers/GDBMTXTGZ.pm@ 30318

###############################################################################
#
# GDBMTXTGZ.pm -- utility functions for writing to gdbm-txtgz databases
#
# A component of the Greenstone digital library software from the New Zealand
# Digital Library Project at the University of Waikato, New Zealand.
#
# Copyright (C) 1999-2015 New Zealand Digital Library Project
#
# This program is free software; you can redistribute it and/or modify it under
# the terms of the GNU General Public License as published by the Free Software
# Foundation; either version 2 of the License, or (at your option) any later
# version.
#
# This program is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
# more details.
#
# You should have received a copy of the GNU General Public License along with
# this program; if not, write to the Free Software Foundation, Inc., 675 Mass
# Ave, Cambridge, MA 02139, USA.
#
###############################################################################

package DBDrivers::GDBMTXTGZ;

# Pragma
use strict;

# Libraries
use util;
use FileUtils;
use DBDrivers::GDBM;

sub BEGIN
{
    @DBDrivers::GDBMTXTGZ::ISA = ( 'DBDrivers::GDBM' );
}

sub new
{
    my $class = shift(@_);
    return bless ($self, $class);
}

# -----------------------------------------------------------------------------
#   GDBM TXT-GZ IMPLEMENTATION
# -----------------------------------------------------------------------------

# With infodb_handle already set up, these functions work the same as parent version
# sub close_infodb_write_handle {}
# sub delete_infodb_entry {}
# sub write_infodb_entry {}
# sub write_infodb_rawentry {}


## @function open_infodb_write_handle(string)
#
# Keep infodb in GDBM neutral form => save data as compressed text file, read
# for txt2db to be run on it later (i.e. by the runtime system, first time the
# collection is ever accessed).  This makes it easier distribute pre-built
# collections to various architectures.
#
# NB: even if two architectures are little endian (e.g. Intel and ARM procesors)
# GDBM does *not* guarantee that the database generated on one will work on the
# other
#
sub open_infodb_write_handle
{
    my $infodb_file_path = shift(@_);

    # Greenstone ships with gzip for windows, on $PATH
    my $infodb_file_handle = undef;
    if (!open($infodb_file_handle, "| gzip - > \"$infodb_file_path\"")) {
        print STDERR "Error: Failed to open pipe to gzip - > \"$infodb_file_path\"\n";
        print STDERR "       $!\n";
        return undef;
    }
    binmode($infodb_file_handle,":utf8");
    return $infodb_file_handle;
}
## open_infodb_write_handle(string) => filehandle ##


## @function get_infodb_file_path(string, string)
#
sub get_infodb_file_path
{
    my $collection_name = shift(@_);
    my $infodb_directory_path = shift(@_);

    my $infodb_file_name = &util::get_dirsep_tail($collection_name).".txt.gz";
    return &util::filename_cat($infodb_directory_path, $infodb_file_name);
}
## get_infodb_file_path(string, string) => string ##


## @function read_infodb_file(string, hashmap)
#
sub read_infodb_file
{
    my $infodb_file_path = shift(@_);
    my $infodb_map = shift(@_);

    my $cmd = "gzip --decompress --to-stdout \"$infodb_file_path\"";

    open (PIPEIN, "$cmd |") || die "Error: Couldn't open pipe from gzip: $!\n  $cmd\n";

    binmode(PIPEIN,":utf8");
    my $infodb_line = "";
    my $infodb_key = "";
    my $infodb_value = "";
    while (defined ($infodb_line = <PIPEIN>)) {
        $infodb_line =~ s/(\r\n)+$//; # more general than chomp

        if ($infodb_line =~ /^\[([^\]]+)\]$/) {
            $infodb_key = $1;
        }
        elsif ($infodb_line =~ /^-{70}$/) {
            $infodb_map->{$infodb_key} = $infodb_value;
            $infodb_key = "";
            $infodb_value = "";
        }
        else {
            $infodb_value .= $infodb_line;
        }
    }

    close (PIPEIN);
}
## read_infodb_file(string, hashmap) => void ##


## @function read_infodb_keys(string, hashmap)
#
sub read_infodb_keys
{
    my $infodb_file_path = shift(@_);
    my $infodb_map = shift(@_);

    my $cmd = "gzip --decompress --to-stdout \"$infodb_file_path\"";

    open (PIPEIN, "$cmd |") || die "Error: Couldn't open pipe from gzip: $!\n  $cmd\n";

    binmode(PIPEIN,":utf8");
    my $infodb_line = "";
    my $infodb_key = "";
    while (defined ($infodb_line = <PIPEIN>)) {
        $infodb_line =~ s/(\r\n)+$//; # more general than chomp

        if ($infodb_line =~ /^\[([^\]]+)\]$/) {
            $infodb_key = $1;
        }
        elsif ($infodb_line =~ /^-{70}$/) {
            $infodb_map->{$infodb_key} = 1;
            $infodb_key = "";
        }
    }

    close (PIPEIN);
}
## read_infodb_keys(string, hashmap) => void ##


## @function set_infodb_entry(string, string, hashmap)
#
sub set_infodb_entry
{
    my $infodb_file_path = shift(@_);
    my $infodb_key = shift(@_);
    my $infodb_map = shift(@_);

    print STDERR "***** gdbmtxtgz::set_infodb_entry() not implemented yet!\n";
}
## set_infodb_entry(string, string, hashmap) => void ##

1;