view release on metacpan or  search on metacpan

lib/File/Sticker/Database.pm  view on Meta::CPAN

Checks if a given table exists.
This can be relevant with a readonly database where
tables are not guaranteed to have been created.

=cut
sub _table_exists {
    my $self = shift;
    my $table = shift;
    say STDERR whoami(), ' ', $table if $self->{verbose} > 2;

    my $dbh = $self->{dbh};
    my $type = "'TABLE','VIEW'";
    my $sth = $dbh->table_info(undef, undef, $table, $type);

    my $table_does_exist = 0;
    my $found_table = '';
    my @row;
    while (@row = $sth->fetchrow_array)
    {
        say STDERR sprintf('found a table: %s (%s)', $row[2], $row[3])
            if $self->{verbose} > 2;
        $found_table = $row[2];
        $table_does_exist = 1;
    }
    return $table_does_exist;
} # _table_exists

=head2 _add_tag_prefixes

Add prefixes to the given array of tags.

    my @pref_tags = $self->_add_tag_prefixes($field, \@values);

=cut
sub _add_tag_prefixes {
    my $self = shift;
    my $field = shift;
    my $values = shift;

    my @prefixed_tags = ();
    if ($self->{taggable_fields}->{$field}) # has a field-specific prefix
    {
        my $pr = $self->{taggable_fields}->{$field};
        @prefixed_tags = map { "${pr}$_" } @{$values};
    }
    elsif ($self->{tagprefix}) # simple prefix for all tags
    {
        @prefixed_tags = map { "${field}-$_" } @{$values};
    }
    else # no prefix needed
    {
        @prefixed_tags = @{$values};
    }
    return @prefixed_tags;
} # _add_tag_prefixes

=head2 _do_one_col_query

Do a SELECT query, and return the first column of results.
This is a freeform query, so the caller must be careful to formulate it correctly.

my $results = $self->_do_one_col_query($query);

=cut

sub _do_one_col_query {
    my $self = shift;
    my $q = shift;

    if ($q !~ /^SELECT /)
    {
        # bad boy! Not a SELECT.
        return undef;
    }
    my $dbh = $self->{dbh};

    my $sth = $self->_prepare($q);
    if (!$sth)
    {
        croak "FAILED to prepare '$q' $DBI::errstr";
    }
    my $ret = $sth->execute();
    if (!$ret)
    {
        croak "FAILED to execute '$q' $DBI::errstr";
    }
    my @results = ();
    my @row;
    while (@row = $sth->fetchrow_array)
    {
        push @results, $row[0];
    }
    return \@results;

} # _do_one_col_query

=head2 _prepare

Prepare and cache prepared queries.

    my $sth = $self->_prepare($q);

=cut
sub _prepare {
    my $self = shift;
    my $q = shift;

    my $sth;
    if (exists $self->{_queries}->{$q}
            and defined $self->{_queries}->{$q})
    {
        $sth = $self->{_queries}->{$q};
    }
    else
    {
        $sth = $self->{dbh}->prepare($q);
        if (!$sth)
        {
            die "FAILED to prepare query '$q' $DBI::errstr";
        }