• Your recent searches
ACME-QuoteDB
8 results

 view release on metacpan or  search on metacpan

MANIFEST  view on Meta::CPAN 

lib/ACME/QuoteDB/LoadDB.pm
Makefile.PL
MANIFEST
META.yml
README
t/00-load.t
t/01-load_quotes.t
t/02-get_quotes.t
t/03-load_quotes_env.t
t/04-get_quotes_more.t
t/04-load_get_quote_utf8.t
t/05-load_quotes_remote.t
t/boilerplate.t
t/data/futurama
t/data/python_quotes.txt
t/data/simpsons_quotes.csv
t/data/simpsons_quotes.tsv.csv
t/data/utf8.csv
t/data/www.amk.ca/quotations/python-quotes/index.html
t/data/www.amk.ca/quotations/python-quotes/page-10.html
t/data/www.amk.ca/quotations/python-quotes/page-2.html
t/data/www.amk.ca/quotations/python-quotes/page-3.html
t/pod-coverage.t
t/pod.t

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

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

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

=item 2 

perl replacement for 'fortune'

=item 3 

Dynamic signature generation

=item 4 

international languages (has utf8 support)

=item 5 

convenient storing/sharing collections of quotes

=item 6 

for me to finally have a place to store (and manage) quotes (that can
be easily backed up or even to a remote db if desired)

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


    my $database = $ENV{ACME_QUOTEDB_DB};
    my $host     = $ENV{ACME_QUOTEDB_HOST};
    my $user     = $ENV{ACME_QUOTEDB_USER};
    my $pass     = $ENV{ACME_QUOTEDB_PASS};

    ACME::QuoteDB::DB::DBI->connection(
           "DBI:mysql:database=$database;host=$host",$user,$pass,
               {
                   RaiseError        => 1,
                   mysql_enable_utf8 => 1,
               }
               
           )
      || croak "can not connect to: $database $!";
}
else {

  ACME::QuoteDB::DB::DBI->connection(
           'dbi:SQLite:dbname='.$QUOTES_DATABASE, '', '',
               {

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

# '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;

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

sub dbload_from_csv {
  my ($self, $file) = @_;

  my $delim = $self->{delim} || ',';
  my $csv = Text::CSV->new({
     sep_char => $delim,
     binary => 1
  });
  $csv->column_names (@QUOTE_FIELDS);

  open my $source, '<:encoding(utf8)', $file || croak $!;

  _confirm_header_order($csv->getline_hr($source));

  while (my $hr = $csv->getline_hr($source)) {
      next unless $hr->{quote} and $hr->{name};

      if ($self->{verbose}){
          print "\n",
                'Quote:   ', $hr->{quote},"\n",
                'Name:    ', $hr->{name},"\n",

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

  return $self;
}

# sub class this - i.e. provide this method in your code (see test
# 01-load_quotes.t)
sub dbload {
  croak 'Override this. Provide this method in a sub class (child) of this object';
  # see tests: t/01-load_quotes.t for examples
}

sub _to_utf8 {
    my ($self) = @_;

    RECORD:
    foreach my $r (@QUOTE_FIELDS){
        my $val = $self->{record}->{$r};
        if (ref $val eq 'ARRAY'){
         foreach my $v (@{$val}){
           if (!is_utf8($v)){
             push @{$self->{record}->{$r}}, decode($FILE_ENCODING, $v);
           }
         }
        }
        else {
          if (!is_utf8($val)){
            $self->{record}->{$r} = decode($FILE_ENCODING, $val);
          }
        }
    }

    return $self;
}

# XXX refactor (the following 3 methods)

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

          $catg_id = $c_obj->catg_id;
        }
    }
    return $catg_id;
}

#TODO : refactor
sub write_record {
    my ($self) = @_;

    $self->_to_utf8;

    if ($self->{verbose} and $self->get_record('name')){
        print 'Attribution Name: ',$self->get_record('name'),"\n";
    };

    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}) {

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

    }
    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'

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

        $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;

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


=item  attr_source - extracted from data if exists, otherwise will use what you
specify

example:

{attr_source => 'The Simpsons'}

=item  file_encoding - optional

Files being loaded are assumed to be utf8 encoded. if utf8 flag is not detected,
falls back to latin1 (iso-8859-1). If neither of these is correct, set this
option to the encoding your file is in.

=back

=head4 Operation Related Parameters

=over 4

=item  dry_run - optional

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


=head2 data_to_db

takes the data input provided to new, process' it and writes to the database.
should appropriatly blow up if not successful

=head2 dbload_from_csv

takes a csv file (in our defined format) as an argument, parses it and writes
the data to the database. (uses L<Text::CSV> with pure perl parser)
utf-8 safe. (opens file as utf8)

will croak with message if not successful


=head2 dbload

if your file format is set to 'html' or 'custom' you must 
define this method to do your parsing in a sub class.

Load from html is not supported because there are too many

t/01-load_quotes.t  view on Meta::CPAN 

  # this is an example of importing a file in the 'fortune' format
  # subclass ACME::QuoteDB::LoadDB and override dbload, to do our parsing
  package Fortune2QuoteDB;
  use base 'ACME::QuoteDB::LoadDB';
  use Carp qw/croak/;
  use Data::Dumper qw/Dumper/;

  sub dbload {
    my ($self, $file) = @_;

    open my $source, '<:encoding(utf8)', $file || croak $!;

    local $/ = $self->{delim};

    my $q = q{};

    while (my $line = <$source>){

      #$self->debug_record;

      $q .= $line;

t/04-load_get_quote_utf8.t  view on Meta::CPAN 

#!perl -T
# /* vim:et: set ts=4 sw=4 sts=4 tw=78 encoding=utf-8: */

use 5.008005;        # require perl 5.8.5
                     # DBD::SQLite Unicode is not supported before 5.8.5
use strict;
use warnings;
use utf8; # yes this source code does contain utf8 characters

use ACME::QuoteDB;
use ACME::QuoteDB::LoadDB;

#use Test::More 'no_plan';
use Test::More tests => 8;
use File::Basename qw/dirname/;
use Data::Dumper qw/Dumper/;
use Carp qw/croak/;
use File::Temp;

t/04-load_get_quote_utf8.t  view on Meta::CPAN 

    $@ and croak 'DBD::SQLite is a required dependancy';

    # give alternate path to the DB
    $ENV{ACME_QUOTEDB_PATH} = 
          File::Temp->new( UNLINK => 0,
                           EXLOCK => 0,
                           SUFFIX => '.dat',
                     );
}

# matches the data in our utf8.csv file, soon to be in our quote db
my $utf8_quotes = [
    '¥ · £ · € · $ · ¢ · ₡ · ₢ · ₣ · ₤ · ₥ · ₦ · ₧ · ₨ · ₩ · ₪ · ₫ · ₭ · ₮ · ₯',
    '我能吞下玻璃而不伤身体。',
    '私はガラスを食べられます。それは私を傷つけません。',
    '나는 유리를 먹을 수 있어요. 그래도 아프지 않아요',
    'Tsésǫʼ yishą́ągo bííníshghah dóó doo shił neezgai da. ',
    'Μπορώ να φάω σπασμένα γυαλιά χωρίς να πάθω τίποτα.',
    'मैं काँच खा सकता हूँ, मुझे उस से कोई पीडा नहीं होती.',
    'אני יכול לאכול זכוכית וזה לא מזיק לי',
];# any takers for specifying each multibyte code sequence for the above,.. ;)

{
    #make test db writeable
    use ACME::QuoteDB::DB::DBI;
    # yeah, this is supposed to be covered by the build process
    # but is failing sometimes,...
    chmod 0666, ACME::QuoteDB::DB::DBI->get_current_db_path;

    my $q = File::Spec->catfile((dirname(__FILE__),'data'), 
        'utf8.csv'
    );
    my $load_db = ACME::QuoteDB::LoadDB->new({
                                file        => $q,
                                file_format => 'csv',
                                delimiter   => "\t",
                                create_db   => 1
                            });

    isa_ok $load_db, 'ACME::QuoteDB::LoadDB';
    $load_db->data_to_db;
    is $load_db->success, 1;
}

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

# matches the data in our utf8.csv file, attribution's to the 'quotes' above
my @expected_attribution_list = (
    'UTF-8 Sampler Currency',
    'I can eat grass (Chinese)',
    'I can eat grass (Japanese)',
    'I can eat grass (Korean)',
    'I can eat grass (Navajo)',
    'I can eat grass (Greek)',
    'I can eat grass (Hindi)',
    'I can eat grass (Hebrew)',
);
is( $sq->list_attr_names, join "\n", sort @expected_attribution_list);

ok $sq->get_quote; # default get random quote
ok $sq->get_quote =~ m{\w+};

is $sq->get_quote({AttrName => $expected_attribution_list[1]}),
      $utf8_quotes->[1] . "\n-- " . $expected_attribution_list[1];

is $sq->get_quote({AttrName => $expected_attribution_list[6]}),
      $utf8_quotes->[6] . "\n-- " . $expected_attribution_list[6];

is @{ $sq->get_quotes({ Rating => '10' })}, @{$utf8_quotes};

t/data/utf8.csv  view on Meta::CPAN 

"Quote"	"Attribution Name"	"Attribution Source"	"Category"	"Rating"
"¥ · £ · € · $ · ¢ · ₡ · ₢ · ₣ · ₤ · ₥ · ₦ · ₧ · ₨ · ₩ · ₪ · ₫ · ₭ · ₮ · ₯"	"UTF-8 Sampler Currency"	"http://www.columbia.edu/kermit/utf8.html"	"Educational"	10
"我能吞下玻璃而不伤身体。"	"I can eat grass (Chinese)"	"http://www.columbia.edu/kermit/utf8.html"	"Educational"	10
"私はガラスを食べられます。それは私を傷つけません。"	"I can eat grass (Japanese)"	"http://www.columbia.edu/kermit/utf8.html"	"Educational"	10
"나는 유리를 먹을 수 있어요. 그래도 아프지 않아요"	"I can eat grass (Korean)"	"http://www.columbia.edu/kermit/utf8.html"	"Educational"	10
"Tsésǫʼ yishą́ągo bííníshghah dóó doo shił neezgai da. "	"I can eat grass (Navajo)"	"http://www.columbia.edu/kermit/utf8.html"	"Educational"	10
"Μπορώ να φάω σπασμένα γυαλιά χωρίς να πάθω τίποτα."	"I can eat grass (Greek)"	"http://www.columbia.edu/kermit/utf8.html"	"Educational"	10
"मैं काँच खा सकता हूँ, मुझे उस से कोई पीडा नहीं होती."	"I can eat grass (Hindi)"	"http://www.columbia.edu/kermit/utf8.html"	"Educational"	10
"אני יכול לאכול זכוכית וזה לא מזיק לי"	"I can eat grass (Hebrew)"	"http://www.columbia.edu/kermit/utf8.html"	"Educational"	10



( run in 0.551 second using v1.01-cache-2.11-cpan-49f99fa48dc )