view release on metacpan or  search on metacpan

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

        $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}){
            if ($c_obj->catg eq $c){
              # use cat_id if already exists
              push @{$catg_ids}, $c_obj->catg_id;
            }
          }
        }
        else {
          if ($c_obj->catg eq $catgs){
            # use cat_id if already exists
            push @{$catg_ids}, $c_obj->catg_id;
          }
        }
    }
    return $catg_ids;
}

sub _get_quote_id_from_catg_id {
    my ($catg_ids) = @_;

    my $quote_ids = ();
    RECS:
    foreach my $qc_obj (QuoteCatg->retrieve_all){
        next RECS if not $qc_obj->quot_id;

        if (ref $catg_ids eq 'ARRAY'){
          foreach my $c (@{$catg_ids}){
            if ($qc_obj->catg_id eq $c){
              # use cat_id if already exists
              push @{$quote_ids}, $qc_obj->quot_id;
            }
          }
        }
        else {
          if ($qc_obj->catg_id eq $catg_ids){
            # use cat_id if already exists
            push @{$quote_ids}, $qc_obj->quot_id;
          }
        }
    }
    return $quote_ids;
}

sub _untaint_data {
   my ($arr_ref) = @_;
   my $ut_ref = ();
   foreach my $q (@{$arr_ref}){
      if ($q =~ m{\A([0-9]+)\z}sm){
          push @{$ut_ref}, $1;
      }
   }
   return $ut_ref;
}

# TODO fixme: arg list too long
sub _get_rand_quote_for_attribution {
    my ($attr_name, $lower, $upper, $limit, $contain, $source, $catgs) = @_;

    $attr_name ||= q{};
    $lower     ||= q{};
    $upper     ||= q{};
    $limit     ||= q{};
    $contain   ||= q{};
    $source    ||= q{};
    $catgs     ||= q{};

    my $ids = _get_attribution_ids_from_name($attr_name);
    my $phs = _make_correct_num_of_sql_placeholders($ids);

    if ($attr_name) {
        $attr_name =  qq/ attr_id IN ($phs) /;
    }
    else {
        # why would we want this method without a attribution arg?
        # still, let's handle gracefully
        $attr_name =  q/ attr_id IS NOT NULL /;
        $ids = [];
    }

    if ($source) {
        $source =~ s{'}{''}gsm; # sql escape single quote
        $source =  qq/ AND source = '$source' /;
    }
    my $qids =  q{};
    if ($catgs) {
        $catgs  = _get_ids_if_catgs_exist($catgs);
        my $qid_ref = _get_quote_id_from_catg_id($catgs);
        $qids =  join ',', @{_untaint_data($qid_ref)};
        $qids  =  qq/ AND quot_id IN ($qids) /;
    }

    ($lower, $upper) = _get_if_rating($lower, $upper);

    if ($contain) { $contain =  qq/ AND quote LIKE '%$contain%' / }
    if ($limit) { $limit =  qq/ LIMIT '$limit' / };

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