ACME-QuoteDB
view release on metacpan or search on metacpan
lib/ACME/QuoteDB/LoadDB.pm view on Meta::CPAN
$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;
}
lib/ACME/QuoteDB/LoadDB.pm view on Meta::CPAN
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;
}
lib/ACME/QuoteDB/LoadDB.pm view on Meta::CPAN
# #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'
lib/ACME/QuoteDB/LoadDB.pm view on Meta::CPAN
$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;
lib/ACME/QuoteDB/LoadDB.pm view on Meta::CPAN
$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__
lib/ACME/QuoteDB/LoadDB.pm view on Meta::CPAN
$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)
t/01-load_quotes.t view on Meta::CPAN
attr_source => 'The Simpsons',
dry_run => 1, # don't write to the database
#verbose => 1, # show what is being done
create_db => 1, # need to create the database
});
isa_ok $load_db, 'ACME::QuoteDB::LoadDB';
$load_db->data_to_db;
#flag not set on dry_run
is $load_db->success, undef; # success only after a database write,
my $sq = ACME::QuoteDB->new;
isa_ok $sq, 'ACME::QuoteDB';
ok ! $sq->list_attr_names;
}
{
my $load_db = ACME::QuoteDB::LoadDB->new({
file =>
#dirname(__FILE__).'/data/simpsons_quotes.tsv.csv',
t/02-get_quotes.t view on Meta::CPAN
"two non-consecutive occasions!\n-- Grandpa Simpson";
is $sq->get_quotes_contain({
Contain => 'til the cow'
})->[0], $gs;
is $sq->get_quotes_contain({
Contain => 'til the cow',
Rating => '1-5',
Limit => 2
})->[0], undef;
eval {
$sq->get_quotes_contain({
Contain => 'til the cow',
Rating => '-7',
Limit => 2
})};
if ($@) {
pass if $@ =~ m/negative range not permitted/;
t/03-load_quotes_env.t view on Meta::CPAN
my @expected_attribution_list = (
'Apu Nahasapemapetilon',
'Chief Wiggum',
'Comic Book Guy',
'Grandpa Simpson',
'Ralph Wiggum',
);
is( $sq->list_attr_names, join "\n", sort @expected_attribution_list);
$load_db = undef;
}
ok ! -z $ENV{ACME_QUOTEDB_PATH};
my $dbh = DBI->connect('dbi:SQLite:dbname='.$ENV{ACME_QUOTEDB_PATH},'','');
my $count = $dbh->selectrow_hashref('SELECT COUNT(*) AS COUNT FROM quote');
is $count->{COUNT}, 29 ;
t/04-get_quotes_more.t view on Meta::CPAN
{
# crud
# get_quote id, update quote content, delete quote
my $qid = $sq->get_quote_id({Quote => $FG_QUOTE});
my $qu = $FG_QUOTE;
$qu =~ s/Lois/Marge/xmsg;
$qu =~ s/Peter/Homer/xmsg;
is $sq->get_quote({Rating => '9.6'}), undef;
$sq->update_quote({
QuoteId => $qid,
Quote => $qu,
AttrName => 'Lois Simpson',
Source => 'The Simpsons Guys',
Rating => '9.6',
Category => 'Cartoon Noir',
});
t/04-get_quotes_more.t view on Meta::CPAN
is $sq->get_quote({AttrName => 'Lois Simpson'}), $qu;
is $sq->get_quote({AttrName => 'Lois S'}), $qu;
is $sq->get_quote({Rating => '9.6'}), $qu;
is $sq->get_quote({Source => 'The Simpsons Guys'}), $qu;
is $sq->get_quote({Category => 'Cartoon Noir'}), $qu;
$sq->delete_quote({QuoteId => $qid});
# see, bye, bye
is $sq->get_quote({AttrName => 'Lois S'}), undef;
is $sq->get_quote({Rating => '9.6'}), undef;
}
# TODO
{ # add new quote to the db
$sq->add_quote({
Quote => $FG_QUOTE,
AttrName => 'Peter Griffin',
Source => 'Family Guy',
t/05-load_quotes_remote.t view on Meta::CPAN
my @expected_attribution_list = (
'Apu Nahasapemapetilon',
'Chief Wiggum',
'Comic Book Guy',
'Grandpa Simpson',
'Ralph Wiggum',
);
is( $sq->list_attr_names, join "\n", sort @expected_attribution_list);
$load_db = undef;
}
my $dbh = DBI->connect("DBI:mysql:database=$database;host=$host",$user,$pass)
|| croak "can not connect to: $database $!";
my $count = $dbh->selectrow_hashref('SELECT COUNT(*) AS COUNT FROM quote');
is $count->{COUNT}, 29 ;
my $qc = $dbh->selectrow_hashref('SELECT COUNT(*) AS COUNT FROM quote_catg');
is $qc->{COUNT}, 29 ;
t/data/python_quotes.txt view on Meta::CPAN
essential part of the process, and they catch a large portion, not a small
portion. The dynamic people say they add enormous complexity, and they catch a
small portion, and point out that the static people have bad breath. The static
people assert that the dynamic people must be too stupid to cope with a real
language and rigorous requirements, and are ugly besides.
This is when both sides start throwing rocks.
-- Quinn Dunkan, 13 Jul 2001
I am becoming convinced that Unicode is a multi-national plot to take over the
minds of our most gifted (and/or most obsessive) programmers, in pursuit of an
elusive, unresolvable, and ultimately, undefinable goal.
-- Ken Manheimer, 19 Jul 2001
Unicode is the first technology I have to deal with which makes me hope I die
before I really really *really* need to understand it fully.
-- David Ascher, 19 Jul 2001
Moore's law is slowly making type declarations irrelevant...
-- Paul Prescod, 29 Jul 2001
The mark of a mature programmer is willingness to throw out code you spent time
( run in 1.707 second using v1.01-cache-2.11-cpan-d80b1682f3f )