Other packages in the module: G::DB::BDB

Package variables

Included modules

Inherit

Exporter

Synopsis

No synopsis!

Description

No description!

Methods

Methods description

None available.

Methods code

sub _clone {

    my $table = shift;
    my $where = shift;
    my $limit = shift;
    my $primarykey = shift;

    my $result = {};
    $result = new G::IO("blessed") if($table =~ /^gb_/);

    if(length $primarykey < 1){
	my @primary_keys  = $dbh->primary_key(undef, undef, $table);
	$primarykey = shift @primary_keys;
    }

    my $sth = $dbh->prepare("SELECT * FROM $table $where $limit");
    $sth->execute || die $sth->errstr;
    
    while(my $ref = $sth->fetchrow_hashref()){
	my $id = $ref->{$primarykey};
	
	my $currenthandle = $result;
	while($id =~ s/^(.*?)::://){
	    $currenthandle->{$1} = {};
	    $currenthandle = $currenthandle->{$1};
	}
	
	if(length $ref->{BLUEBIRDLonelyContent}){
	    $currenthandle->{$id} = $ref->{BLUEBIRDLonelyContent};
	}else{
	    foreach my $key (keys %$ref){
		next if ($key =~ /^BLUEBIRD/);
		my $data = $ref->{$key};
		$currenthandle->{$id}->{$key} = $data if ($data);
	    }
	}
    }

    return $result;

}

sub _load {

    my $table = shift;
    my $where = shift;
    my $limit = shift;
    my $primarykey = shift;
    my $flag = shift;

    my $result = {};
    my %lonely;

    $result = new G::IO("blessed") if($table =~ /^gb_/);

    if(length $primarykey < 1){
	my @primary_keys  = $dbh->primary_key(undef, undef, $table);
	$primarykey = shift @primary_keys;
    }

    if($flag){
	my $where2 = $where;
	$where2  =~ s/WHERE/AND/;

	my $sth = $dbh->prepare("select $primarykey, BLUEBIRDLonelyContent from $table where BLUEBIRDLonelyContent != '' $where2 $limit");
	$sth->execute || die $sth->errstr;
	while(my $ref = $sth->fetchrow_hashref()){
	    my $id = $ref->{$primarykey};
	    $lonely{$id} ++;
	    
	    my $currenthandle = $result;
	    while($id =~ s/^(.*?)::://){
		$currenthandle->{$1} = {};
		$currenthandle = $currenthandle->{$1};
	    }
	    
	    $currenthandle->{$id} = $ref->{BLUEBIRDLonelyContent};
	}
    }

    my $ids = $dbh->selectcol_arrayref("select $primarykey from $table $where $limit");

    foreach my $id (@$ids){
	next if($lonely{$id});
	
	my $currenthandle = $result;
	while($id =~ s/^(.*?)::://){
	    $currenthandle->{$1} = {};
	    $currenthandle = $currenthandle->{$1};
	}
	
	tie %{$currenthandle->{$id}}, "BLUEBIRD", $dbh, $table, $id, $primarykey;
    }
    
    return $result;

}

sub db_dbi {

    my $path = db_path();

    return DBI->connect("dbi:SQLite:dbname=$path") || die($DBI::errstr);

}

sub db_exists {

    my $name = shift || "scratch";
    $dbh = db_dbi() unless($dbh);
    my %tables;

    foreach my $table ($dbh->tables(undef, 'public', undef, undef, {noprefix => 1})){
	$table =~ s/^\"(.*)\"$/$1/g;
	$tables{$table} ++;
    }

    if($tables{$name}){
	return $name;
    }elsif($tables{"gb_$name"}){
        return "gb_$name";
    }else{
        return 0;
    }

}

sub db_load {

    opt_default("driver"=>"mysql", "port"=>42, "user"=>"anonymous");
    my @args = opt_get(@_);
    my $name = shift @args || "scratch";
    my $opt = shift @args;

    my $driver     = opt_val("driver");
    my $database   = opt_val("database");
    my $host       = opt_val("host");
    my $port       = opt_val("port");
    my $user       = opt_val("user");
    my $password   = opt_val("password");
    my $limit      = opt_val("limit");
    my $where      = opt_val("where");
    my $primarykey = opt_val("primarykey");

    $limit = " LIMIT $limit" if (length $limit);
    $where = " WHERE $where" if (length $where);

    my $ref = {};

    if($database){
	my $dbs = "dbi:$driver:database=$database;host=$host;port=$port";
	$dbh = DBI->connect($dbs, $user, $password) or die $DBI::errstr;
    }else{
	$dbh = db_dbi();
    }

    if($opt eq 'dbi'){
	bless $ref, 'G::DB::Handler';
    }elsif($opt eq 'vm'){
	if(sdb_exists("sdb_$name")){
	    return sdb_load("sdb_$name");
	}else{
	    die("SDB: Data\" $name\" not found. Aborting.");
	}
    }else{
	my $table = $name;
	my $flag = 0;

	unless($database){
	    $table = db_exists($name);
	    $flag = 1;

	    unless($table){
		if(sdb_exists("sdb_$name")){
		    return sdb_load("sdb_$name");
		}elsif(sdb_exists($name)){
		    return sdb_load($name);
		}else{
		    die("BDB: Table\" $name\" not found. Aborting.");
		}
	    }
	}

	if($opt eq 'clone'){
	    $ref = _clone($table, $where, $limit, $primarykey);
	}else{
	    $ref = _load($table, $where, $limit, $primarykey, $flag);
	}
	
	unless($ref =~ /G::/){
	    bless $ref, 'G::DB::Handler';
	}
	
	if(length $primarykey < 1){
	    my @primary_keys  = $dbh->primary_key(undef, undef, $table);
	    $primarykey = shift @primary_keys;
	}

	$ref->set_primarykey($primarykey);
	$ref->set_table($table);
    }

    $ref->set_dbi($dbh);


    return $ref;

}

sub db_overwrite {

    $overwrite = shift;

}

sub db_path {

    _sdb_path();

    return $path;

}

sub db_save {

    my $ref = shift;
    my $tablename = shift || "scratch";
    my $vm = shift;
    my $dbh = db_dbi();

    my $name = $tablename;
    $tablename = 'gb_' . $tablename if (ref($ref) =~ /^G::/);
    my $depth = nested_hash_depth($ref);

    if($depth < 2 || $vm eq 'vm'){
	sdb_save($ref, "sdb_$name");
	return;
    }

    my @keys = nested_hash_keys($ref, $depth);

    my $createtableline = '';
    foreach my $key (sort @keys){
	$createtableline .= "'$key' text, ";
    }

    if($name eq 'scratch' || db_overwrite()){
	$dbh->do("drop table $tablename") if (db_exists($tablename));
    }else{
	die("BDB: Database\" $name\" already exists. Aborting.") if (db_exists($tablename));
    }

    $dbh->do("create table $tablename (BLUEBIRDid text primary key, $createtableline BLUEBIRDLonelyContent text)") || die $dbh->errstr;
    
    $dbh->begin_work;
    my $insertLonely = $dbh->prepare("INSERT INTO $tablename (BLUEBIRDid, BLUEBIRDLonelyContent) VALUES(?, ?)");

    local *recursive_search = sub {
	my $hash = shift;
	my $level = shift || 0;
	my $id = shift || '';

	if(defined %$hash){
	    foreach my $key (keys %$hash) {
		if($level == $depth - 1){
		    my $sqlline = '';
		    foreach my $key (sort @keys){
			$sqlline .= $dbh->quote($hash->{$key}) . ', ';
		    }
		    $dbh->do("INSERT INTO $tablename VALUES(" . $dbh->quote($id) . ", $sqlline '')") || die $dbh->errstr;
		    return;
		}else{
		    my $idkey;
		    if(length $id){
			$idkey .= $id . ':::' . $key;
		    }else{
			$idkey = $key;
		    }
		    recursive_search($hash->{$key}, $level + 1, $idkey);
		}
	    }
	}else{
	    $insertLonely->execute($id, $hash) || die $dbh->errstr;
	}
    };

    recursive_search($ref);

    $dbh->commit;

}

sub db_set_path {

    $path = shift;

}

sub nested_hash_depth {

    my $ref = shift;
    my $max = 0;

    local *recursive_search = sub {
	my $hash = shift;
	my $level = shift || 0;
	
	if(defined %$hash){
	    foreach my $key (keys %$hash) {
		recursive_search($hash->{$key}, $level + 1);
	    }
	}else{
	    $max = $level if($level > $max);
	}
    };

    recursive_search($ref);

    return $max;

}

sub nested_hash_keys {

    my $ref = shift;
    my $level = shift || nested_hash_depth($ref);

    my %keys;

    local *recursive_search = sub {
	my $hash = shift;
	my $depth = shift || 0;
	
	if(defined %$hash){
	    foreach my $key (keys %$hash) {
		if($depth == $level - 1){
		    $keys{$key} ++;
		}else{
		    recursive_search($hash->{$key}, $depth + 1);
		}
	    }
	}
    };

    recursive_search($ref);

    return keys %keys;

}

General documentation