File Coverage

blib/lib/Bif/DB.pm

Criterion	Covered	Total	%
statement	22	79	27.8
branch	0	16	0.0
condition	1	16	6.2
subroutine	7	18	38.8
pod	1	1	100.0
total	31	130	23.8

package Bif::DB;
use strict;
use warnings;
use DBD::SQLite;
use DBIx::ThinSQL ();
use Carp          ();
use Log::Any '$log';

our $VERSION = '0.1.5_7';
our @ISA     = ('DBIx::ThinSQL');

sub _connected {
    my $dbh   = shift;
    my $debug = shift;

    $dbh->sqlite_trace( sub { $log->debug(@_) } ) if $debug;

    # $dbh->trace('1|SQL',\*STDOUT) if $debug;

    $dbh->do('PRAGMA query_only = ON;');
    $dbh->do('PRAGMA foreign_keys = ON;');
    $dbh->do('PRAGMA temp_store = MEMORY;');

    # TODO remove before the first production release.
    $dbh->do('PRAGMA reverse_unordered_selects = ON;');
    return;
}

sub connect {
    my $class = shift;
    my ( $dsn, $username, $password, $attrs, $debug ) = @_;

    $attrs ||= {
        RaiseError                 => 1,
        PrintError                 => 0,
        ShowErrorStatement         => 1,
        sqlite_see_if_its_a_number => 1,
        sqlite_unicode             => 1,
        Callbacks                  => {
            connected => sub { _connected( shift, $debug ) },
        },
    };

    return $class->SUPER::connect( $dsn, $username, $password, $attrs, );
}

package Bif::DB::db;
DBIx::ThinSQL->import(qw/ qv bv case coalesce/);

our @ISA = ('DBIx::ThinSQL::db');

sub uuid2id {
    my $self = shift;
    my $uuid = shift || return;

    if ( length($uuid) == 40 ) {

        # In this case we know we will only get one match back

        return $self->xarrayref(
            select => [ 'n.id', 'n.uuid', ],
            from   => 'nodes n',
            where => { 'n.uuid' => $uuid },
            limit => 1,
        );
    }

    return $self->xarrayrefs(
        select_distinct => [ 'n.id',         'n.uuid AS uuid', ],
        from            => 'nodes n',
        where           => [ 'n.uuid LIKE ', qv( $uuid . '%' ) ],
    );
}

sub get_change {
    my $self = shift;
    my $token = shift || return;

    if ( $token =~ m/^(\d+)\.(\d+)$/ ) {
        my $id        = $1;
        my $change_id = $2;
        my $data      = $self->xhashref(
            select => [
                'nodes.id',   'nodes.kind',
                'nodes.uuid', 'changes.id AS change_id',
                qv(undef)->as('project_id'),
            ],
            from       => 'nodes',
            inner_join => 'changes',
            on         => { 'changes.id' => $change_id },
            where      => { 'nodes.id' => $id },
        );
        return $data;
    }

    return;
}

sub get_local_hub_id {
    my $self = shift;

    my $id = $self->xval(
        select => 'b.hub_id',
        from   => 'bifkv b',
        where  => { 'b.key' => 'local_hub' },
    );

    return $id;
}

sub get_projects {
    my $self = shift;
    my $path = shift || return;

    if ( $path =~ m/^\d+$/ ) {
        return $self->xhashrefs(
            select => [
                'n.id AS id',
                'n.kind AS kind',
                'n.uuid AS uuid',
                'p.parent_id AS parent_id',
                'n.path AS path',
                'n.first_change_id AS first_change_id',
                'p.default_hub_id AS default_hub_id',
                'p.local AS local',
                'h.name AS hub_name',
            ],
            from       => 'projects p',
            inner_join => 'nodes n',
            on         => 'n.id = p.id',
            left_join  => 'nodes h',
            on         => 'h.id = p.default_hub_id',
            where      => { 'p.id' => $path },
        );
    }

    return $self->xhashrefs(
        select => [
            'n.id AS id',
            'n.kind AS kind',
            'n.uuid AS uuid',
            'n.parent_id AS parent_id',
            'n.path AS path',
            'n.first_change_id AS first_change_id',
            'p.default_hub_id AS default_hub_id',
            'p.local AS local',
            'h.name AS hub_name',
        ],
        from       => 'nodes n',
        inner_join => 'projects p',
        on         => 'p.id = n.id',
        left_join  => 'nodes h',
        on         => 'h.id = p.default_hub_id',
        where      => [ 'n.path = ', qv($path), ' OR n.name = ', qv($path) ],
        order_by   => [qw/n.path/],
    );
}

sub status_ids {
    my $self       = shift;
    my $project_id = shift;
    my $kind       = shift;

    return ( [], [] ) unless $project_id and $kind and @_;

    my @ids;
    my %invalid = map { defined $_ ? ( $_ => 1 ) : () } @_;

    my @known = $self->xarrayrefs(
        select => 'id, status',
        from   => $kind . '_status',
        where  => { project_id => $project_id },
    );

    foreach my $known (@known) {
        push( @ids, $known->[0] )
          if delete $invalid{ $known->[1] };
    }

    # sorted keys so we can test
    return \@ids, [ sort keys %invalid ];
}

sub get_hub {
    my $self = shift;
    my $hub = shift || return;

    return $self->xhashref(
        select => [
            qw/h.id n.name n.kind n.path n.uuid h.location n.first_change_id/,
            , 'b.hub_id AS is_default'
        ],
        from       => 'nodes n',
        inner_join => 'hubs h',
        on         => 'h.id = n.id',
        inner_join => 'projects p',
        on         => 'p.id = h.id',
        left_join  => 'bifkv b',
        on         => 'b.key = "local" AND b.hub_id = h.id',
        where      => [
            'n.name = ',   qv($hub), ' OR h.location = ', qv($hub),
            ' OR h.id = ', qv($hub)
        ],
    );
}

sub get_max_change_id {
    my $self = shift;
    my $uid  = $self->xval(
        select => ['MAX(c.id)'],
        from   => 'changes c',
    );

    return $uid;

}

sub check_fks {
    my $self = shift;
    my $sth = $self->table_info( '%', '%', '%' );

    my %seen;

    while ( my $t_info = $sth->fetchrow_hashref('NAME_lc') ) {
        my $sth2 =
          $self->foreign_key_info( undef, undef, undef, undef, undef,
            $t_info->{table_name} );

        while ( my $fk_info = $sth2->fetchrow_hashref('NAME_lc') ) {

            next
              if $seen{ $fk_info->{fktable_name}
                  . $fk_info->{fkcolumn_name}
                  . $fk_info->{pktable_name}
                  . $fk_info->{pkcolumn_name} }++;

            my @missing = $self->xarrayrefs(
                select_distinct => "$fk_info->{fkcolumn_name} AS col1",
                from            => $fk_info->{fktable_name},
                where           => "$fk_info->{fkcolumn_name} IS NOT NULL",
                except_select   => $fk_info->{pkcolumn_name},
                from            => $fk_info->{pktable_name},
                where           => "$fk_info->{pkcolumn_name} IS NOT NULL",
            );

            print "$fk_info->{fktable_name}.$fk_info->{fkcolumn_name}: $_->[0]"
              . " ($fk_info->{pktable_name}.$fk_info->{pkcolumn_name})\n"
              for @missing;

        }
    }
}

package Bif::DB::st;
our @ISA = ('DBIx::ThinSQL::st');

1;

=head1 NAME

=for bif-doc #perl

Bif::DB - helper methods for a read-only bif database

=head1 VERSION

0.1.5_7 (2015-11-25)

=head1 SYNOPSIS

    use strict;
    use warnings;
    use Bif::DB;

    # Bif::DB inherits from DBIx::ThinSQL, which inherits from DBI.
    my $db = Bif::DB->connect( $dsn );

    # Read only operations on a bif database:
    my @ids = $db->uuid2id( $uuid );

=head1 DESCRIPTION

B is a L derivative that provides various read-only
methods for retrieving information from a L repository. For a
read-write equivalent see L. The read-only and read-write
parts are separated for performance reasons.

=head1 METHODS

=over

=item uuid2id( $UUID ) -> List[Int]

Returns the (possibly multiple) integer ID(s) matching a node C<$UUID>.

=item get_change( "$ID.$UPDATE_ID" ) -> HashRef

Looks up the change identified by C<$ID.$UPDATE_ID> and returns undef
or a hash reference containg the following keys:

=over

=item * id - the node ID

=item * change_id - the ID of the change

=item * kind - the type of the node

=item * uuid - the universally unique identifier of the node

=back

=item get_local_hub_id -> Int

Returns the ID for the local repository node.

=item get_projects( $PATH ) -> @HashRefs | \@HashRefs

Looks up the project(s) identified by C<$PATH> (in [HUB/]PATH format)
and returns a list of hash references containg the following keys:

=over

=item * id - the node ID

=item * first_change_id - the change_id that created the node

=item * kind - the type of the node

=item * uuid - the universally unique identifier of the node

=item * path - the path of the project

=item * parent_id - the parent ID of the project

=item * default_hub_id - the id of the project's default hub

=item * hub_name - the name of the project's hub

=item * local - true if the project is locally synchronized

=back

The list is sorted by hub name then by project path.

NOTE: The underlying DBIx::ThinSQL method returns an Array References
to the list in scalar context.

=item status_ids( $project_id, $kind, @status ) -> \@ids, \@invalid

Takes a project ID, a thread type (task, issue, etc) and a list of
status names and returns an arrayref of matching IDs, and an arrayref
of invalid names. This method will silently ignore any @status which
are undefined.

=item get_hub( $name ) -> @HashRef

Returns a HASH reference containing information about the hub
identified by C<$name> with the following keys:

=over

=item * first_change_id - the first change ID

=item * id - the node ID for the hub

=item * location - the location of the hub

=item * name - the name of the hub

=item * path - the path of the hub node

=item * uuid - the node unique identifier

=back

Returns C if C<$name> (a name, an ID, or a location) is not
found.

=item get_max_change_id

Returns the maximum change ID in the database.

=item check_fks

This is developer aide to print out foreign key relationship that are
not satisfied (i.e. where the target row/column doesn't exist).

=back

=head1 SEE ALSO

L

=head1 AUTHOR

Mark Lawrence [e-mail]

=head1 COPYRIGHT AND LICENSE

Copyright 2013-2015 Mark Lawrence

This program is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the
Free Software Foundation; either version 3 of the License, or (at your
option) any later version.