package WIDX;

use 5.006;
use strict;
use warnings;
no warnings qw(uninitialized redefine once);

$WIDX::VERSION = "0.0.1";

#---------------------------------------------------------------------
+---------

our %BITS_TO_PACK    = qw! 0 A0 8 C 16 S 32 L !;
our %BITS_TO_INT    = qw! 8 tinyint 16 smallint 24 mediumint 32 int 64
+ bigint !;
our %BITS_TO_PRECISION    = qw! 8 4 16 6 24 9 32 11 !;
our %PRECISION_TO_BITS    = map {($BITS_TO_PRECISION{$_} => $_)} keys(
+%BITS_TO_PRECISION);

#---------------------------------------------------------------------
+---------
# Create WIDX object

sub new {
    my $class = shift();
    
    # Create instance    
    my $m = { 
        dbh => undef,           # DBI handle
        dParams => {        # Default params
            numOfDocs    => 0,
            wLength        => 30,
            protocol    => 40,
            blobDFetch    => 20,
            dataTable    => undef,
            nameLength    => 255,
            wordIdBits    => 16,
            docIdBits    => 16,
            countBits    => 8,
            positionBits    => 32,
            backend        => 'column',
            frontend    => 'default',
            filter        => 'map { lc $_ }',
            splitter    => '$data =~ /(\w{2,$wLength})/og',
            initEnv        => 'use locale'
        },
        backendTypes => {
            blob        => 'WIDX::Blob',
            column        => 'WIDX::Column',
            phrase        => 'WIDX::Phrase'
        },
        frontendTypes => {
            none        => 'WIDX',
            default        => 'WIDX',
            file        => 'WIDX::File',
            string        => 'WIDX::String',
            url        => 'WIDX::URL',
            table        => 'WIDX::Table',
        },
        cfg => {
            dbName => "widx",
            dbDriver => "mysql",
            dbServer => "localhost",
            dbUser => "widx",
            dbPass => "12345",
        }
    };
    $class = ref($class) || $class;
    bless($m, $class);

    # Shortcuts
    my $cfg = $m->{cfg};
    
    my $dbName = $cfg->{dbName};
    
    # Connect
    require DBI;
    $m->{dbh} = DBI->connect(
        "dbi:$cfg->{dbDriver}:database=$dbName;host=$cfg->{dbServer};"
+, 
        $cfg->{dbUser}, $cfg->{dbPass}, 
        { PrintError => 0, RaiseError => 0, AutoCommit => 1 }) 
        or $m->printError("Database Connection Error", $DBI::errstr);
        
    # Disable warnings
    $m->{dbh}{Warn} = 0;

    return $m;
}

sub open {
    my $m = shift();
    my $table = shift();

    # Shortcuts
    my $cfg = $m->{cfg};
    my $dbh = $m->{dbh};

    my $sth = $dbh->prepare("SELECT * FROM $table");
    $sth->execute or do {
        if (not grep { $table eq $_ } $m->list_context_indexes) {
            $m->printError("ERROR", "WIDX index $table doesn't exist."
+);
        }
        else {
            $m->printError("ERROR", $sth->errstr);
        }
    };
    while (my ($param, $value) = $sth->fetchrow_array) {
        $m->{dParams}{$param} = $value;
    }
 
    $m->{_table} = $table;
  
    my $dataTable = $m->{dParams}{dataTable};
    
    defined($dbh->selectrow_array("SELECT COUNT(*) FROM $dataTable")) 
+or do {
        $m->printError("ERROR", "Table $dataTable not found in the dat
+abase");
    };

    my $frontModule = $m->{frontendTypes}{$m->{dParams}{frontend}};
    if (defined $frontModule) {
        if ($frontModule ne "WIDX") {
            eval "use $frontModule";
            die($@) if($@);
        }

        $m->{fMod} = new $frontModule;
        
        # Shortcut
        my $fMod = $m->{fMod};
        
        $fMod->set_o($m);        
        $fMod->_open_tables();
    }
    else {
        $m->printError("Specified frontend type '$m->{dParams}{fronten
+d}' is unknown");
    }

    my $backModule = $m->{backendTypes}{$m->{dParams}{backend}};
    if (defined $backModule) {
        eval "use $backModule";
        die($@) if($@);
        $m->{bMod} = new $backModule;
        
        # Shortcut
        my $bMod = $m->{bMod};
        $bMod->set_o($m);
    }
    else {
        $m->printError("Specified backend type '$m->{dParams}{backend}
+' is unknown");
    }
    return 1;
}

sub create {
    my $m = shift();
    my $table = shift();
    my $fM = shift();
    my $bM = shift();
    
    # Shortcuts
    my $dbh = $m->{dbh};
    
    my $hError;

    $m->{_table} = $table;
      $m->{dParams}{dataTable} = $table . "_data" unless(defined($m->{
+dParams}{dataTable}));

    $dbh->do("DROP TABLE IF EXISTS $table") or do {
        $m->printError("ERROR", $dbh->errstr);
    };
  
    $dbh->do("CREATE TABLE $table ( param VARCHAR(16) BINARY NOT NULL,
+ value VARCHAR(255), PRIMARY KEY (param) )") or do {
        $m->printError("ERROR", $dbh->errstr);
    };
  
    push(@{$m->{createdTables}}, $table);

    my $frontModule = $m->{frontendTypes}{$fM};
    if (defined $frontModule) {
        eval "use $frontModule";
        die($@) if($@);
        
        $m->{fMod} = new $frontModule;
        
        # Shortcut
        my $fMod = $m->{fMod};
        
        $fMod->set_o($m);
        $hError = $fMod->_create_tables();
        if (defined $hError) {
            $m->clean_failed_create();
            return;
        }
    }
    else {
        $m->clean_failed_create();
        $m->printError("ERROR", "Specified frontend type '$fM' is unkn
+own");
        return;
    }

    my $backModule = $m->{backendTypes}{$bM};
    if (defined($backModule)) {
        eval "use $backModule";
        die($@) if($@);
        
        $m->{bMod} = new $backModule;
        
        # Shortcut
        my $bMod = $m->{bMod};
        
        $bMod->set_o($m);
        $hError = $bMod->_create_tables();
        if (defined $hError) {
            $m->clean_failed_create();
            return;
        }
    }
    else {
        $m->clean_failed_create();
        $m->printError("ERROR", "Specified backend type '$bM' is unkno
+wn");
    }
    
    for (grep { not ref $m->{dParams}{$_} } keys(%{$m->{dParams}})) {
        $dbh->do("INSERT INTO $table VALUES (?, ?)", {}, $_, $m->{dPar
+ams}{$_});
    }
    return 1;
}
[download]

2004-12-24 Janitored by Arunbear - added readmore tags, as per Monastery guidelines