ACME-QuoteDB
view release on metacpan or search on metacpan
lib/ACME/QuoteDB/LoadDB.pm view on Meta::CPAN
package ACME::QuoteDB::LoadDB;
use 5.008005; # require perl 5.8.5, re: DBD::SQLite Unicode
use warnings;
use strict;
#use criticism 'brutal'; # use critic with a ~/.perlcriticrc
use version; our $VERSION = qv('0.1.1');
# with Text::CSV only use 'perl csv loader'
# 'one time' db load performance not a concern
BEGIN {local $ENV{PERL_TEXT_CSV} = 0}
use aliased 'ACME::QuoteDB::DB::Attribution' => 'Attr';
use aliased 'ACME::QuoteDB::DB::QuoteCatg' => 'QuoteCatg';
use aliased 'ACME::QuoteDB::DB::Category' => 'Catg';
use aliased 'ACME::QuoteDB::DB::Quote' => 'Quote';
use aliased 'ACME::QuoteDB::DB::DBI' => 'QDBI';
use File::Basename qw/dirname basename/;
use File::Glob qw(:globally :nocase);
use Encode qw/is_utf8 decode/;
use Data::Dumper qw/Dumper/;
use Carp qw/carp croak/;
use Text::CSV;
use Readonly;
use DBI;
# if not in utf8 latin1 is assumed
my $FILE_ENCODING = 'iso-8859-1';
Readonly my @QUOTE_FIELDS => qw/quote name source catg rating/;
# XXX refactor
sub new {
my ($class, $args) = @_;
# TODO encapsulation
my $self = bless {}, $class;
# store each record we extract - keys map to database fields
# TODO proper encapsulation
$self->{record} = {};
$self->{record}->{quote} = q{};
$self->{record}->{rating} = q{};
$self->{record}->{name} = q{};
$self->{record}->{source} = q{};
$self->{record}->{catg} = q{};
$self->{file} = $args->{file};
$self->{dir} = $args->{dir};
$self->{data} = $args->{data};
$self->{file_format} = $args->{file_format};
$FILE_ENCODING = $args->{file_encoding} || $FILE_ENCODING;
$self->{delim} = $args->{delimiter};
$self->{verbose} = $args->{verbose};
$self->{category} = $args->{category};
$self->{rating} = $args->{rating};
$self->{attr_source} = $args->{attr_source};
$self->{orig_args} = $args;
$self->{success} = undef;
# start with if set
$self->{record}->{rating} = $self->{rating};
$self->{record}->{name} = $self->{attr_source};
$self->{record}->{source} = $self->{attr_source};
if (ref $self->{category} eq 'ARRAY') {
$self->{record}->{catg} = ();
foreach my $c (@{$self->{category}}){
push @{$self->{record}->{catg}}, $c;
}
}
else {
$self->{record}->{catg} = $self->{category};
}
# db connection info
if ($ENV{ACME_QUOTEDB_DB}) {
$self->{db} = $ENV{ACME_QUOTEDB_DB};
$self->{host} = $ENV{ACME_QUOTEDB_HOST};
$self->{user} = $ENV{ACME_QUOTEDB_USER};
$self->{pass} = $ENV{ACME_QUOTEDB_PASS};
}
if (!$args->{dry_run}){$self->{write_db} = 1};
#if ($args->{create_db}) {$self->create_db};
if ($args->{create_db}) {$self->create_db_tables};
return $self;
}
sub set_record {
my ($self, $field, $value) = @_;
# TODO support mult-field simultanous loading
if ($value) {
$self->{record}->{$field} = $value;
}
return $self;
}
sub debug_record {
my ($self) = @_;
print Dumper $self->{record};
return;
}
sub get_record {
my ($self, $field) = @_;
if (not $field){return $self}
return $self->{record}->{$field};
}
sub data_to_db {
my ($self) = @_;
lib/ACME/QuoteDB/LoadDB.pm view on Meta::CPAN
my $attr_id = $self->_get_id_if_attr_name_exist;
# nope, ok, add them
if (not $attr_id) { # attribution record does not already exist,
# create new entry
if ($self->{write_db}) {
$attr_id = Attr->insert({
name => $self->get_record('name'),
});
}
}
my $catg_ids = ();
if ($self->{write_db}) {
my ($catg) = $self->get_record('catg');
if (! ref $catg){ # 'single' value
my $catg_id = $self->_get_id_if_catg_exist($catg);
if (!$catg_id) {
# category does not already exist,
# create new entry
$catg_id = Catg->insert({catg => $catg});
}
push @{$catg_ids}, $catg_id;
} # support multi catg
elsif (ref $catg eq 'ARRAY'){
foreach my $c (@{$catg}){
my $catg_id = $self->_get_id_if_catg_exist($c);
if (!$catg_id) { # category does not already exist,
# create new entry
$catg_id = Catg->insert({catg => $c});
}
push @{$catg_ids}, $catg_id;
}
}
}
$self->_display_vals_if_verbose;
if ($self->{write_db}) {
my $qid = Quote->insert({
attr_id => $attr_id,
quote => $self->get_record('quote'),
source => $self->get_record('source'),
rating => $self->get_record('rating')
}) or croak $!;
if ($qid) {
my $id;
foreach my $cid (@{$catg_ids}){
$id = QuoteCatg->insert({
quot_id => $qid,
catg_id => $cid,
}) or croak $!;
}
}
}
# confirmation?
# TODO add a test for failure
if ($self->{write_db} and not $attr_id) {croak 'db write not successful'}
#$self->set_record(undef);
$self->{record} = {};
$self->_reset_orig_args;
if ($self->{write_db}) {
$self->success(1);
}
return $self->success;
}
sub _reset_orig_args {
my ($self) = @_;
$self->{record}->{rating} = $self->{orig_args}->{rating};
$self->{record}->{name} = $self->{orig_args}->{attr_source};
$self->{record}->{source} = $self->{orig_args}->{attr_source};
if (ref $self->{orig_args}->{category} eq 'ARRAY') {
foreach my $c (@{$self->{orig_args}->{category}}){
push @{$self->{record}->{catg}}, $c;
}
}
else {
$self->{record}->{catg} = $self->{orig_args}->{category};
}
}
sub success {
my ($self, $flag) = @_;
$self->{success} ||= $flag;
return $self->{success};
};
sub _display_vals_if_verbose {
my ($self) = @_;
if ($self->{verbose}){
#print 'Quote: ', $self->get_record('quote'),"\n";
#print 'Source: ', $self->get_record('source'),"\n";
#print 'Category: ',$self->get_record('catg'),"\n";
#print 'Rating: ', $self->get_record('rating'),"\n";
print Dumper $self->{record};
}
return $self;
}
#sub create_db {
# my ($self) = @_;
#
# if ($self->{db} and $self->{host}) {
# $self->create_db_mysql();
# }
#}
sub create_db_tables {
my ($self) = @_;
if ($self->{db} and $self->{host}) {
#$self->create_db_mysql();
$self->create_db_tables_mysql();
}
else {
create_db_tables_sqlite();
}
return $self;
}
# XXX we want the user to supply a pre created database.
# created as such 'CREATE DATABASE $dbn CHARACTER SET utf8 COLLATE utf8_general_ci'
# this get's into too many isseuwith privs and database creation
#Sat Aug 22 13:42:37 PDT 2009
# did this:
#mysql> CREATE DATABASE acme_quotedb CHARACTER SET utf8 COLLATE utf8_general_ci;
#mysql> grant usage on *.* to acme_user@localhost identified by 'acme';
#mysql> grant all privileges on acme_quotedb.* to acme_user@localhost ;
#sub create_db_mysql {
# my ($self) = @_;
#
# # hmmmm, what about priv's access, etc
# # maybe user need to supply a db, they have
# # access to, already created (just the db though)
# ## create our db
# #my $dbhc = DBI->connect('DBI:mysql:database=mysql;host='
# # .$self->{host}, $self->{user}, $self->{pass})
# # || croak "db cannot be accessed $! $DBI::errstr";
#
# #my $dbn = $self->{db};
# #my $db = qq(CREATE DATABASE $dbn CHARACTER SET utf8 COLLATE utf8_general_ci);
# # eval {
# # $dbhc->do($db) or croak $dbhc->errstr;
# # };
# # $@ and croak 'Cannot create database!';
# # $dbhc->disconnect; $dbhc = undef;
#
# my $drh = DBI->install_driver('mysql');
# my $rc = $drh->func("dropdb", $self->{db},
# [$self->{host}, $self->{user}, $self->{password}],
# 'admin'
# );
#
# $rc = $drh->func("createdb", $self->{db},
# [$self->{host}, $self->{user}, $self->{password}],
# 'admin'
# );
#}
# XXX refactor with sqlite
sub create_db_tables_mysql {
my ($self) = @_;
# connect to our db
my $c = $self->{db}.';host='.$self->{host};
my $dbh = DBI->connect(
"DBI:mysql:database=$c", $self->{user}, $self->{pass})
|| croak "db cannot be accessed $! $DBI::errstr";
eval {
$dbh->do('DROP TABLE IF EXISTS quote;') or croak $dbh->errstr;
$dbh->do('CREATE TABLE IF NOT EXISTS quote (
quot_id INTEGER NOT NULL AUTO_INCREMENT,
attr_id INTEGER,
quote TEXT,
source TEXT,
rating REAL,
PRIMARY KEY(quot_id)
);')
#)CHARACTER SET utf8 COLLATE utf8_general_ci;
#) ENGINE = MYISAM CHARACTER SET utf8 COLLATE utf8_general_ci;
or croak $dbh->errstr;
$dbh->do('DROP TABLE IF EXISTS attribution;') or croak $dbh->errstr;
$dbh->do('CREATE TABLE IF NOT EXISTS attribution (
attr_id INTEGER NOT NULL AUTO_INCREMENT,
name TEXT,
PRIMARY KEY(attr_id)
);') or croak $dbh->errstr;
$dbh->do('DROP TABLE IF EXISTS category;') or croak $dbh->errstr;
$dbh->do('CREATE TABLE IF NOT EXISTS category (
catg_id INTEGER NOT NULL AUTO_INCREMENT,
catg TEXT,
PRIMARY KEY(catg_id)
);') or croak $dbh->errstr;
$dbh->do('DROP TABLE IF EXISTS quote_catg;') or croak $dbh->errstr;
$dbh->do('CREATE TABLE IF NOT EXISTS quote_catg (
id INTEGER NOT NULL AUTO_INCREMENT,
catg_id INTEGER,
quot_id INTEGER,
PRIMARY KEY(id)
);') or croak $dbh->errstr;
$dbh->disconnect or warn $dbh->errstr;
$dbh = undef;
};
return $@ and croak 'Cannot create database tables!';
}
sub create_db_tables_sqlite {
my $db = QDBI->get_current_db_path;
#XXX is there really no way to do this with the existing
# connection?!(class dbi)
my $dbh = DBI->connect('dbi:SQLite:dbname='.$db, '', '')
|| croak "$db cannot be accessed $! $DBI::errstr";
#-- sqlite does not have a varchar datatype: VARCHAR(255)
#-- A column declared INTEGER PRIMARY KEY will autoincrement.
eval {
$dbh->do('DROP TABLE IF EXISTS quote;') or croak $dbh->errstr;
$dbh->do('CREATE TABLE IF NOT EXISTS quote (
quot_id INTEGER PRIMARY KEY,
attr_id INTEGER,
quote TEXT,
source TEXT,
rating REAL
);')
or croak $dbh->errstr;
$dbh->do('DROP TABLE IF EXISTS attribution;') or croak $dbh->errstr;
$dbh->do('CREATE TABLE IF NOT EXISTS attribution (
attr_id INTEGER PRIMARY KEY,
name TEXT
);') or croak $dbh->errstr;
$dbh->do('DROP TABLE IF EXISTS category;') or croak $dbh->errstr;
$dbh->do('CREATE TABLE IF NOT EXISTS category (
catg_id INTEGER PRIMARY KEY,
catg TEXT
);') or croak $dbh->errstr;
$dbh->do('DROP TABLE IF EXISTS quote_catg;') or croak $dbh->errstr;
$dbh->do('CREATE TABLE IF NOT EXISTS quote_catg (
id INTEGER PRIMARY KEY,
catg_id INTEGER,
quot_id INTEGER
);') or croak $dbh->errstr;
$dbh->disconnect or carp $dbh->errstr;
$dbh = undef;
};
return $@ and croak 'Cannot create database tables!';
}
q(My cat's breath smells like cat food. --Ralph Wiggum);
__END__
=head1 NAME
ACME::QuoteDB::LoadDB - Database loader for ACME::QuoteDB
=head1 VERSION
Version 0.1.1
=head1 SYNOPSIS
load a csv file to quotes database
my $load_db = ACME::QuoteDB::LoadDB->new({
file => '/home/me/data/simpsons_quotes.csv',
file_format => 'csv',
});
$load_db->data_to_db;
print $load_db->success; # bool
header columns of the csv file as follows:
"Quote", "Attribution Name", "Attribution Source", "Category", "Rating"
=head1 DESCRIPTION
This module is part of L<ACME::QuoteDB>. This is a Database loader, it
takes (quotes) data and loads into a database
(currently L<sqlite3 or mysql|/'CONFIGURATION AND ENVIRONMENT'>),
which is then accessed by L<ACME::QuoteDB>.
There are several ways to get quote data into the db via this loader:
(There are more aimed towards 'batch' operations, i.e load a bunch of
records quickly)
=over 4
=item 1
* csv file (pre determined format)
pros: quick and easy to load.
cons: getting the quotes data into the correct format need by this module
=item 2
lib/ACME/QuoteDB/LoadDB.pm view on Meta::CPAN
=head2 debug_record
dump record (show what is set on the internal data structure)
e.g. Data::Dumper
=head2 set_record
only needed it one plans to sub-class this module.
otherwise, is transparent in usage.
if you are sub-classing this module, you would have to populate
this record. (L</write_record> knows about/uses this data structure)
possible fields consist of:
$self->set_record(quote => q{});
$self->set_record(rating => q{});
$self->set_record(name => q{});
$self->set_record(source => q{});
$self->set_record(catg => q{});
currently can only set one attribute at a time.
ie. you cant do this:
$self->set_record(
name => $name,
source => $source
);
# or this even
$self->set_record({
name => $name,
source => $source
});
=head2 get_record
only useful it one plans to sub-class this module.
otherwise, is transparent in usage.
if you are sub-classing this module, you would have to populate
this record. [see L</set_record>]
(L</write_record> knows about/uses this data structure)
possible fields consist of:
$self->get_record('quote');
$self->get_record('rating');
$self->get_record('name');
$self->get_record('source');
$self->get_record('catg');
=head2 success
indicates that the database load was successfull
is undef on failure or if trying a L</dry_run>
=head2 write_record
takes the data structure 'record' '$self->get_record'
(which must exist). checks if attribution name ($self->get_record('name')) exists,
if so, uses existing attribution name, otherwsie creates a new one
Load from html is not supported because there are too many
ways to represt the data. (see tests for examples)
One can subclass ACME::QuoteDB::LoadDB and override dbload,
to do our html parsing
=head2 create_db_tables
create an empty quotes database (with correct tables).
(usually only performed the first time you load data)
B<NOTE: will overwrite ALL existing data>
Set 'create_db' parameter (boolean) to a true value upon instantiation
to enable.
The default action is to assume the database (and tables) exist and just
append new L<ACME::QuoteDB::LoadDB> loads to that.
=begin comment
keep pod coverage happy.
# Coverage for ACME::QuoteDB::LoadDB is 71.4%, with 3 naked subroutines:
# Catg
# Quote
# Attr
# QuoteCatg
pod tests incorrectly state, Catg, Quote and Attr are subroutines, well they
are,... (as aliases) but are imported into here, not defined within
TODO: explore the above (is this a bug, if so, who's?, version effected,
create use case, etc)
=head2 Attr
=head2 Catg
=head2 Quote
=head2 QuoteCatg
=head2 QDBI
=end comment
=begin comment
These methods are more or less private.
( run in 0.613 second using v1.01-cache-2.11-cpan-d80b1682f3f )