ACME-QuoteDB
view release on metacpan or search on metacpan
lib/ACME/QuoteDB.pm view on Meta::CPAN
#$Id: QuoteDB.pm,v 1.36 2009/09/30 07:37:09 dinosau2 Exp $
# /* vim:et: set ts=4 sw=4 sts=4 tw=78: */
package ACME::QuoteDB;
use 5.008005; # require perl 5.8.5, re: DBD::SQLite Unicode
use warnings;
use strict;
#major-version.minor-revision.bugfix
use version; our $VERSION = qv('0.1.2');
#use criticism 'brutal'; # use critic with a ~/.perlcriticrc
use Exporter 'import';
our @EXPORT = qw/quote/; # support one liner
use Carp qw/croak/;
use Data::Dumper qw/Dumper/;
use ACME::QuoteDB::LoadDB;
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';
binmode STDOUT, ':encoding(utf8)';
binmode STDERR, ':encoding(utf8)';
sub new {
my $class = shift;
my $self = bless {}, $class;
return $self;
}
# provide 1 non OO method for one liners
sub quote {
my ($arg_ref) = @_;
return get_quote(q{}, $arg_ref);
}
# list of quote attributions (names) (makes searching easier)
sub list_attr_names {
return _get_field_all_from('name', Attr->retrieve_all);
}
# list of quote categories
sub list_categories {
return _get_field_all_from('catg', Catg->retrieve_all);
}
## list of quote sources
sub list_attr_sources {
return _get_field_all_from('source', Quote->retrieve_all);
}
sub _get_field_all_from {
my ($field, @all_stored) = @_;
my $arr_ref = [];
RECORDS:
foreach my $f_obj (@all_stored){
my $s = $f_obj->$field;
lib/ACME/QuoteDB.pm view on Meta::CPAN
my @q = Quote->retrieve_from_sql(
qq{ $attr_name $lower $upper $source $qids $contain $limit },
@{$ids}
);
# XXX code duplication but smaller footprint
# choosing not less code duplication, we'll see,...
#my $quotes_ref = [];
#foreach my $q_obj ( @q ){
# next unless $q_obj->quote;
# my $record = Attr->retrieve($q_obj->attr_id);
# my $attr_name = $record->name || q{};
# push @{ $quotes_ref }, $q_obj->quote . "\n-- $attr_name";
#}
#return _get_quote_ref_from_all(\@q);
# XXX array_ref does not work here!
return _get_quote_ref_from_all(@q);
#return $quotes_ref;
}
sub _get_quote_ref_from_all {
my (@results) = @_;
#my ($results) = @_;
my $quotes_ref = [];
#foreach my $q_obj ( @{$results} ){
foreach my $q_obj ( @results ){
next unless $q_obj->quote;
my $rec = Attr->retrieve($q_obj->attr_id);
my $attr_name = $rec->name || q{};
push @{ $quotes_ref }, $q_obj->quote . "\n-- $attr_name";
}
return $quotes_ref;
}
sub _args_are_valid {
my ( $arg_ref, $accepted ) = @_;
my $arg_ok = 0;
foreach my $arg ( %{$arg_ref} ) {
if ( scalar grep { $arg =~ $_ } @{$accepted} ) {
$arg_ok = 1;
}
}
if (!$arg_ok) {croak 'unsupported argument option passed'}
}
sub add_quote {
my ( $self, $arg_ref ) = @_;
_args_are_valid($arg_ref, [qw/Quote AttrName Source Rating Category/]);
my $load_db = ACME::QuoteDB::LoadDB->new({
#verbose => 1,
});
$load_db->set_record(quote => $arg_ref->{Quote});
$load_db->set_record(name => $arg_ref->{AttrName});
$load_db->set_record(source => $arg_ref->{Source});
$load_db->set_record(catg => $arg_ref->{Category});
$load_db->set_record(rating => $arg_ref->{Rating});
if ($load_db->get_record('quote') and $load_db->get_record('name')) {
return $load_db->write_record;
}
else {
croak 'quote and attribution name are mandatory parameters';
}
return;
}
# XXX lame, can only get an id from exact quote
sub get_quote_id {
my ( $self, $arg_ref ) = @_;
if (not $arg_ref) {croak 'Quote required'}
_args_are_valid($arg_ref, [qw/Quote/]);
my $ids = _get_quote_id_from_quote($arg_ref->{'Quote'});
return join "\n", sort @{$ids};
}
sub update_quote {
my ( $self, $arg_ref ) = @_;
if (not $arg_ref) {croak 'QuoteId and Quote required'}
_args_are_valid($arg_ref, [qw/Quote QuoteId Source
Category Rating AttrName/]);
my $q = Quote->retrieve($arg_ref->{'QuoteId'});
my $atr = Attr->retrieve($q->attr_id);
# XXX need to support multi categories
#my $ctg = Catg->retrieve($q->catg_id);
my $qc = QuoteCatg->retrieve($q->quot_id);
my $ctg = Catg->retrieve($qc->catg_id);
$q->quote($arg_ref->{'Quote'});
if ($arg_ref->{'Source'}){$q->source($arg_ref->{'Source'})}
if ($arg_ref->{'Rating'}){$q->rating($arg_ref->{'Rating'})};
if ($arg_ref->{'AttrName'}){$atr->name($arg_ref->{'AttrName'})};
# XXX need to support multi categories
if ($arg_ref->{'Category'}){
$ctg->catg($arg_ref->{'Category'})
}
return ($q->update && $atr->update && $ctg->update);
}
sub delete_quote {
my ( $self, $arg_ref ) = @_;
lib/ACME/QuoteDB.pm view on Meta::CPAN
others? (let me know what you do, if you want, if you do)
=back
See L</DESCRIPTION> above
Also see L<ACME::QuoteDB::LoadDB>
=head1 USAGE
use ACME::QuoteDB;
my $sq = ACME::QuoteDB->new;
print $sq->get_quote;
# examples are based on quotes data in the test database.
# (see tests t/data/)
# get specific quote based on basic text search.
# search all 'ralph' quotes for string 'wookie'
print $sq->get_quotes_contain({
Contain => 'wookie',
AttrName => 'ralph',
Limit => 1 # only return 1 quote (if any)
});
# output:
I bent my wookie.
-- Ralph Wiggums
# returns all quotes attributed to 'ralph', with a rating between
# (and including) 7 to 9
print join "\n", @{$sq->get_quotes({
AttrName => 'ralph',
Rating => '7-9'
})
};
# same thing but limit to 2 results returned
# (and including) 7 to 9
print join "\n", @{$sq->get_quotes({
AttrName => 'ralph',
Rating => '7-9',
Limit => 2
})
};
# get 6 random quotes (any attribution)
foreach my $q ( @{$sq->get_quotes({Limit => 6})} ) {
print "$q\n";
}
# get list of available attributions (that have quotes provided by this module)
print $sq->list_attr_names;
# any unique part of name will work
# i.e these will all return the same results (because of our limited
# quotes db data set)
print $sq->get_quotes({AttrName => 'comic book guy'});
print $sq->get_quotes({AttrName => 'comic book'});
print $sq->get_quotes({AttrName => 'comic'});
print $sq->get_quotes({AttrName => 'book'});
print $sq->get_quotes({AttrName => 'book guy'});
print $sq->get_quotes({AttrName => 'guy'});
# get all quotes, only using these categories (you have defined)
print @{$sq->get_quotes({ Category => [qw(Humor ROTFLMAO)] })};
# get all quotes from Futurama
print @{$sq->get_quotes({Source => Futurama})};
Also see t/02* included with this distribution.
(available from the CPAN if not included on your system)
=head1 SUBROUTINES/METHODS
For the most part this is an OO module. There is one function (quote) provided
for command line 'one liner' convenience.
=head2 quote
returns one quote. (is exported).
this takes identical arguments to 'get_quote'. (see below)
example:
perl -MACME::QuoteDB -le 'print quote()'
=head2 new
instantiate a ACME::QuoteDB object.
takes no arguments
# example
my $sq = ACME::QuoteDB->new;
=head2 get_quote
returns one quote
# get random quote from any attribution
print $sq->get_quote;
# get random quote from specified attribution
print $sq->get_quote({AttrName => 'chief wiggum'});
Optional arguments, a hash ref.
available keys: AttrName, Rating
my $args_ref = {
AttrName => 'chief wiggum'
Rating => 7,
};
lib/ACME/QuoteDB.pm view on Meta::CPAN
Contain specifies a text string to search quotes for. If a AttrName
option is included, search is limited to that attribution.
Contain is a simple text string only. Regex not supported
Contain literally becomes: AND quote LIKE '%$contain%'
=head2 list_attr_names
returns a list of attributions (name) for which we have quotes.
# get list of available attributions (that have quotes provided by this module)
print $sq->list_attr_names;
=head2 list_categories
returns a list of categories defined in the database
# get list of available categories (that have quotes provided by this module)
print $sq->list_categories;
=head2 list_attr_sources
returns a list of attribution sources defined in the database
# get list of attribution sources (that have quotes provided by this module)
print $sq->list_attr_sources;
=head1 LOADING QUOTES
In order to actually use this module, one has to load quotes content,
hopefully this is relativly easy,... (see t/01-load_quotes.t in tests)
=over 4
=item 1 add_quote, one record at a time, probably within an iteration loop
see L</add_quote>
=item 1 (Batch Load) load quotes from a csv file. (tested with comma and tab delimiters)
format of file must be as follows: (headers)
"Quote", "Attribution Name", "Attribution Source", "Category", "Rating"
for example:
"Quote", "Attribution Name", "Attribution Source", "Category", "Rating"
"I hope this has taught you kids a lesson: kids never learn.","Chief Wiggum","The Simpsons","Humor",9
"Sideshow Bob has no decency. He called me Chief Piggum. (laughs) Oh wait, I get it, he's all right.","Chief Wiggum","The Simpsons","Humor",8
=item 1 if these dont suit your needs, ACME::QuoteDB::LoadDB is sub-classable,
so one can extract data anyway they like and populate the db themselves.
(there is a test that illustrates overriding the stub method, 'dbload')
you need to populate a record data structure:
$self->set_record(quote => q{}); # mandatory
$self->set_record(name => q{}); # mandatory
$self->set_record(source => q{}); # optional but useful
$self->set_record(catg => q{}); # optional but useful
$self->set_record(rating => q{}); # optional but useful
# then to write the record you call
$self->write_record;
NOTE: this is a record-by-record operation, so one would perform this within a
loop. there is no bulk (memory dump) write operation currently.
=back
For more see L<ACME::QuoteDB::LoadDB>
=begin comment
keep pod coverage happy.
# Coverage for ACME::QuoteDB is 71.4%, with 3 naked subroutines:
# Attr
# Quote
# Catg
# QuoteCatg
pod tests incorrectly state, Attr, Quote and Catg are subroutines, well they
are,... (as aliases) but act on a different object.
TODO: explore the above (is this a bug, if so, who's?, version effected,
create use case, etc)
=head2 Attr
=head2 Quote
=head2 Catg
=head2 QuoteCatg
=end comment
=head1 DIAGNOSTICS
An error such as:
C<DBD::SQLite::db prepare_cached failed: no such table: ,...>
probably means that you do not have a database created in the correct format.
basically, you need to create the database, usually, on a first run
you need to add the flag (to the loader):
create_db => 1, # first run, create the db
appending to an existing database is the default behaviour
see L<ACME::QuoteDB::LoadDB/create_db_tables>
=head1 CONFIGURATION AND ENVIRONMENT
if you are running perl > 5.8.5 and have access to
install cpan modules, you should have no problem installing this module
(utf-8 support in DBD::SQLite not avaible until 5.8 - we don't support 'non
utf-8 mode)
=over 1
=item * By default, the quotes database used by this module installs in the
system path, 'lib', (See L<Module::Build/"INSTALL PATHS">)
as world writable - i.e. 0666 (and probably owned by root)
If you don't like this, you can modify Build.PL to not chmod the file and it
will install as 444/readonly, you can also set a chown in there for whoever
you want to have RW access to the quotes db.
Alternativly, one can specify a location to a quotes database (file) to use.
(Since the local mode is sqlite3, the file doesn't even need to exist, just
needs read/write access to the path on the filesystem)
Set the environmental variable:
$ENV{ACME_QUOTEDB_PATH} (untested on windows)
(this has to be set before trying a database load and also (everytime before
using this module, obviouly)
Something such as:
BEGIN {
# give alternate path to the DB
# doesn't need to exist, will create
$ENV{ACME_QUOTEDB_PATH} = '/home/me/my_stuff/my_quote_db'
}
* (NOTE: be sure this (BEGIN) exists *before* the 'use ACME::QuoteDB' lines)
The default is to use sqlite3.
In order to connect to a mysql database, several environmental variables
are required.
BEGIN {
# have to set this to use remote database
$ENV{ACME_QUOTEDB_REMOTE} = 'mysql';
$ENV{ACME_QUOTEDB_DB} = 'acme_quotedb';
$ENV{ACME_QUOTEDB_HOST} = 'localhost';
$ENV{ACME_QUOTEDB_USER} = 'acme_user';
$ENV{ACME_QUOTEDB_PASS} = 'acme';
}
Set the above in a begin block.
The database connection is transparent.
Module usage wise, all operations are the same but now
you will be writing to the remote mysql database specified.
(The user will need read/write permissions to the db/tables)
(mysql admin duties are beyond the scope of this module)
The only supported databases at this time are sqlite and mysql.
It is trivial to add support for others
=back
=head1 DEPENDENCIES
L<Carp>
L<Data::Dumper>
L<criticism> (pragma - enforce Perl::Critic if installed)
L<version>(pragma - version numbers)
L<aliased>
L<Test::More>
L<DBD::SQLite>
L<DBI>
L<Class::DBI>
L<File::Basename>
L<Readonly>
L<Cwd>
L<Module::Build>
=head1 INCOMPATIBILITIES
none known of
=head1 SEE ALSO
man fortune (unix/linux)
lib/ACME/QuoteDB.pm view on Meta::CPAN
David Wright, C<< <david_v_wright at yahoo.com> >>
=head1 TODO
=over 2
=item 1 if the database cannot be found, no error is printed!!!
or if you have no write access to it!
"you'll just get 'no attribute can be found,,...", which is cryptic to say
the least!
=item 1 add a dump backup to csv
a backup mechanism for your db to a regular text csv file.
=item 1 clean up tests 'skip if module X' not installed
(one of sqlite3 or mysql is required). currently dies if DBD::SQLite not
installed
=item 1 support multiple categories from LoadDB
how to load multipul categories from a csv file?
(try to avoid somthing ugly in our csv file format). or maybe don't support
this.
=item 1 (possibly) support long/short quotes output (see 'man fortune')
=back
=head1 BUGS AND LIMITATIONS
The CRUD stuff is weak for sure.
(i.e. add_quote, update_quote, delete_quote, get_quote_id)
For example, currently you can only get the quote id from the exact quote
In the future, I may just expose the DBI::Class object directly
to those that need/want it.
=begin comment
get_quotes_contain uses %search% to do it's pattern mattching, so that will
miss some obvious searches, which it should find.
i.e.
'Bill' will not find 'Bill' , beginning and endings of words will be off.
XXX - look at search_like, instead of what you are doing now
=end comment
currently, I am not encapsulating the record data structure used
by LoadDB->write. (i.e. it's a typical perl5 ojbect, the blessed hash)
I will for sure be encapsulating all data in a future version.
(so, don't have code that does $self->{record}->{name} = 'value', or you won't
be happy down the road). Instead use $self->get_record('name') (getter) or
$self->set_record(name => 'my attrib') (setter)
When we are using a SQLite database backend ('regular' local usage), we
should probably be using, ORLite instead of Class::DBI
(although we have not seen any issues yet).
Please report any bugs or feature requests to C<bug-acme-quotedb at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=ACME-QuoteDB>.
I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc ACME::QuoteDB
You can also look for information at:
=over 4
=item * RT: CPAN's request tracker
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=ACME-QuoteDB>
=item * AnnoCPAN: Annotated CPAN documentation
L<http://annocpan.org/dist/ACME-QuoteDB>
=item * CPAN Ratings
L<http://cpanratings.perl.org/d/ACME-QuoteDB>
=item * Search CPAN
L<http://search.cpan.org/dist/ACME-QuoteDB/>
=back
=head1 ACKNOWLEDGEMENTS
The construction of this module was guided by:
Perl Best Practices - Conway
Test Driven Development
Object Oriented Programming
Gnu
vim
Debian Linux
Mac OSX
The collective wisdom and code of The CPAN
( run in 1.796 second using v1.01-cache-2.11-cpan-39bf76dae61 )