view release on metacpan or  search on metacpan

lib/ACME/QuoteDB.pm  view on Meta::CPAN

    _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 ) = @_;

    if (not $arg_ref) {croak 'QuoteId required'}

    _args_are_valid($arg_ref, [qw/QuoteId/]);

    my $q = Quote->retrieve($arg_ref->{'QuoteId'});

    #$q->quote($arg_ref->{'QuoteId'});

    return $q->delete;

}

sub get_quote {
    my ( $self, $arg_ref ) = @_;

    # default use case, return random quote from all
    if (not $arg_ref) {
        return _get_one_rand_quote_from_all;
    }

    _args_are_valid($arg_ref, [qw/Rating AttrName Source Category/]);

    my ($lower, $upper) = (q{}, q{});
    if ($arg_ref->{'Rating'}) {
        ($lower, $upper) = _get_rating_params($arg_ref->{'Rating'});
    }

    my $attr_name = q{};
    if ( $arg_ref->{'AttrName'} ) {
        $attr_name = _rm_beg_end_space($arg_ref->{'AttrName'});
    }

    my $source = q{};
    if ( $arg_ref->{'Source'} ) {
        $source = _rm_beg_end_space($arg_ref->{'Source'});
    }

    my $catg; # will become scalar or array ref
    if ( $arg_ref->{'Category'} ) {
       $catg = _rm_beg_end_space($arg_ref->{'Category'});
    }

    # use case for attribution, return random quote
    my $quotes_ref =
          _get_rand_quote_for_attribution($attr_name, $lower,
                     $upper, q{}, q{}, $source, $catg);

    # one random from specified pool
    return $quotes_ref->[rand scalar @{$quotes_ref}];

}

# XXX isn't there a method in DBI for this, bind something,...
# TODO follow up 
sub _make_correct_num_of_sql_placeholders {
    my ($ids) = @_;
    # XXX a hack to make a list of '?' placeholders
    my @qms = ();
    for (1..scalar @{$ids}) {
       push @qms, '?';
    }
    return join ',', @qms;
}

sub get_quotes {
    my ( $self, $arg_ref ) = @_;

    # default use case, return random quote from all
    if (not $arg_ref) {
        return _get_one_rand_quote_from_all;
    }

    _args_are_valid($arg_ref, [qw/Rating AttrName Limit Category Source/]);

    my ($lower, $upper) = (q{}, q{});
    if ($arg_ref->{'Rating'}) {
        ($lower, $upper) = _get_rating_params($arg_ref->{'Rating'});
    }

    my $limit = q{};
    if ($arg_ref->{'Limit'}) {
        # specify 'n' amount of quotes to limit by
        $limit = _rm_beg_end_space($arg_ref->{'Limit'});
    }

    my $attribution = q{};
    if ( $arg_ref->{'AttrName'} ) {
        $attribution = _rm_beg_end_space($arg_ref->{'AttrName'});
    }

    my $source = q{};
    if ( $arg_ref->{'Source'} ) {
        $source = _rm_beg_end_space($arg_ref->{'Source'});
    }

    my $catg = q{};
    if ( $arg_ref->{'Category'} ) {
        $catg = _rm_beg_end_space($arg_ref->{'Category'});
    }
    # use case for attribution, return random quote
    return _get_rand_quote_for_attribution($attribution, $lower,
                     $upper, $limit, q{}, $source, $catg);

}


sub get_quotes_contain {
    my ( $self, $arg_ref ) = @_;


    my $contain = q{};
    if ($arg_ref->{'Contain'}) {
        $contain = _rm_beg_end_space($arg_ref->{'Contain'});
    }
    else {
        croak 'Contain is a mandatory parameter';
    }

    _args_are_valid($arg_ref, [qw/Contain Rating AttrName Limit/]);

    my ($lower, $upper) = (q{}, q{});
    if ($arg_ref->{'Rating'}) {
        ($lower, $upper) = _get_rating_params($arg_ref->{'Rating'});
    }

    my $limit = q{};
    if ($arg_ref->{'Limit'}) {
        $limit = _rm_beg_end_space($arg_ref->{'Limit'});
    }

    # default use case for attribution, return random quote
    my $attr_name = q{};
    if ( $arg_ref->{'AttrName'} ) {
        # return 'n' from random from specified pool
        $attr_name = _rm_beg_end_space($arg_ref->{'AttrName'});
    }

    return _get_rand_quote_for_attribution($attr_name, $lower, $upper, $limit, $contain);
}

1 and 'Chief Wiggum: Uh, no, you got the wrong number. This is 9-1... 2.';


__END__

=head1 NAME

ACME::QuoteDB - API implements CRUD for a Collection of Quotes (adages/proverbs/sayings/epigrams, etc)


=head1 VERSION

Version 0.1.2


=head1 SYNOPSIS

Easy access to a collection of quotes (the 'Read' part)

As quick one liner:

    # randomly display one quote from all available. (like motd, 'fortune')
    perl -MACME::QuoteDB -le 'print quote()'

    # Say you have populated your quotes database with some quotes from 
    # 'The Simpsons'
    # randomly display one quote from all available for person 'Ralph'
    perl -MACME::QuoteDB -le 'print quote({AttrName => "ralph"})'

    # example of output
    Prinskipper Skippel... Primdable Skimpsker... I found something!
    -- Ralph Wiggum

    # get 1 quote, only using these categories (you have defined)
    perl -MACME::QuoteDB -le 'print quote({Category => [qw(Humor Cartoon ROTFLMAO)]})'


In a script/module, OO usage:

    use ACME::QuoteDB;

    my $sq = ACME::QuoteDB->new;

    # get random quote from any attribution
    print $sq->get_quote; 

    # get random quote from specified attribution
    print $sq->get_quote({AttrName => 'chief wiggum'}); 

    # example of output
    I hope this has taught you kids a lesson: kids never learn.

lib/ACME/QuoteDB.pm  view on Meta::CPAN

    $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