ACME-QuoteDB

 view release on metacpan or  search on metacpan

Build.PL  view on Meta::CPAN

use strict;
use warnings;
use Module::Build;

my $class = Module::Build->subclass(code => <<'EOF');
   use File::Spec;
   use File::Copy;
   use File::Basename qw/dirname/;

   sub process_db_files {
      my $self = shift;
      my $qdb = File::Spec->catfile(qw(lib ACME QuoteDB DB quotedb), 'quotes.db');
      my $_t = File::Spec->catfile(qw(blib lib ACME QuoteDB DB quotedb), 'quotes.db');
      mkdir dirname($_t);
      chmod(0777, dirname($_t));
      copy($qdb, $_t);
      chmod(0666, $_t);
   }


   sub ACTION_install {
       my $self = shift;
       $self->SUPER::ACTION_install(@_);
       my $ddir =  $self->install_destination('lib');
       #TODO give user choices about installing the quotes database
       #my $ques = 'Where do you want to install the quotes database?';
       #my $quote_dest = $self->prompt($ques, $ddir);
       my $db = q{};
       my $perms = 0666;
       my $d_perms = 0777;
       #if ($quote_dest != $ddir) {

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

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;
        # if doesn't exist and not a dup
        if (! $f_obj->$field || scalar grep {/$s/sm} @{$arr_ref}){
            next RECORDS;
        }
        push @{ $arr_ref }, $f_obj->$field;
    }
    return join "\n", sort @{$arr_ref};
}

sub _get_attribution_ids_from_name {
    my ($attr_name) = @_;

    my $c_ids = [];
    # a bug: what if string starts with what we specify
    #i.e. => %Griffin% doesn' match 'Griffin' (no quotes)
    RESULTS:
    foreach my $c_obj (Attr->search_like(name => "%$attr_name%")){
       next RESULTS unless $c_obj->attr_id;
       push @{ $c_ids }, $c_obj->attr_id;
    }

    if (not scalar @{$c_ids}) {
        croak 'attribution not found';
    }

    return $c_ids;

}

sub _get_quote_id_from_quote {
    my ($quote) = @_;

    my $q_ids = [];
    # a bug: what if string starts with what we specify
    #i.e. => %Griffin% doesn' match 'Griffin' (no quotes)
    RESULTS:
    foreach my $c_obj (Quote->search(quote => $quote)){
       next RESULTS unless $c_obj->quot_id;
       push @{ $q_ids }, $c_obj->quot_id;
    }

    if (not scalar @{$q_ids}) {
        croak 'quote not found';
    }

    return $q_ids;

}

# can handle scalar or array ref
sub _rm_beg_end_space {
    my ($v) = @_;
    return unless $v;
    if (ref $v eq 'ARRAY'){
      my $arr_ref = ();
      foreach my $vl (@{$v}){
          push @{$arr_ref}, _rm_beg_end_space($vl);
      }
      return $arr_ref;
    }
    else {
      $v =~ s/\A\s+//xmsg;
      $v =~ s/\s+\z//xmsg;
      return $v;
    }
  return;
}

sub _get_one_rand_quote_from_all {
    #my $quotes_ref = [];
    #foreach my $q_obj (Quote->retrieve_all){
    #    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";
    #}
    my $quotes_ref = _get_quote_ref_from_all(Quote->retrieve_all);
    return $quotes_ref->[rand scalar @{$quotes_ref}];
}

sub _get_rating_params {
    my ($rating) = @_;
    return unless $rating;

    my ($lower, $upper) = (q{}, q{});
    ($lower, $upper) = split /-/sm, $rating;

    if ($upper && !$lower) { croak 'negative range not permitted'};

    return (_rm_beg_end_space($lower), _rm_beg_end_space($upper));
}

sub _get_if_rating {
    my ($lower, $upper) = @_;

    if ($lower and $upper) { # a range, find within
        $lower =  qq/ AND rating >= '$lower' /;
        $upper =  qq/ AND rating <= '$upper' /;
    }
    elsif ($lower and not $upper) { # not a range, find exact rating
        $lower =  qq/ AND rating = '$lower' /
        #$upper = q{};
    }
    elsif ($upper and not $lower) {
        $upper =  qq/ AND rating = '$upper' /
        #$lower = q{};
    }

    return ($lower, $upper);
}

sub _get_ids_if_catgs_exist {
    my ($catgs) = @_;

    my $catg_ids = ();
    # get category id
    RECS:
    foreach my $c_obj (Catg->retrieve_all){
        next RECS if not $c_obj->catg;

        if (ref $catgs eq 'ARRAY'){
          foreach my $c (@{$catgs}){

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

                   #busy_timeout => 3600000
               }
           )
      || croak "$QUOTES_DATABASE does not exist, or cant be created $!";

      # how to enable this function?
      #ACME::QuoteDB::DB::DBI->set_sql(func( 3600000, 'busy_timeout' ); 
}


sub get_current_db_path {
    return $QUOTES_DATABASE;
}

sub _untaint_db_path {
    my $sane_path = abs_path(dirname(__FILE__));
    # appease taint mode, what a dir path looks like,... (probably not)
    $sane_path =~ m{([a-zA-Z0-9-_\.:\/\\\s]+)}; #add '.', ':' for win32
    return $1 || croak 'cannot untaint db path';
}


1;

__END__

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

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

t/boilerplate.t  view on Meta::CPAN

#!perl -T

use strict;
use warnings;
use Test::More tests => 3;
use File::Basename qw/dirname/;
use File::Spec;

sub not_in_file_ok {
    my ($filename, %regex) = @_;
    my $file = File::Spec->catfile((dirname(__FILE__), '..'), $filename);
    open( my $fh, '<', $file )
        or die "couldn't open $file for reading: $!";

    my %violated;

    while (my $line = <$fh>) {
        while (my ($desc, $regex) = each %regex) {
            if ($line =~ $regex) {

 view all matches for this distribution
 view release on metacpan -  search on metacpan