view release on metacpan or  search on metacpan

lib/App/CamelPKI/CADB.pm  view on Meta::CPAN

=head2 _fetch_infos()

Functions as L</_fetch_certificates> (which is called before each operation
of this method), grab in one shot all nominative informations about
certificates, and cache them in $self->{infos} in the form of a reference
to a list of same length as @{$self->{certs}} and ordored the same way,
which contains as many multi-valued hash tables to store informations
as passed by L</add> at the time of the respective certificates insertion.

=cut

sub _fetch_infos {
    my ($self) = @_;
    return if $self->{infos};
    $self->_fetch_certificates;

    my %infos;

    # FIXME: we could repeat the $self->{cursor} SQL instead.
    # This could helps to play too much DBI placeholders...
    my $infocursor = $self->{infos_set}->search
        ({ certid => { in => [ map { $_->certid } @{$self->{certs}} ] }});
    $infocursor->reset;
    while(my $info = $infocursor->next) {
        push(@{$infos{$info->certid}->{$info->key}},
             $info->val);
    }

    $self->{infos} = [ map { ($infos{$_->certid} || {}) }
                       @{$self->{certs}} ];
    return;
}

=head2 _current()

Returns the tuple object currently under the cursor.

=cut

sub _current {
    my ($self) = @_;
    $self->_fetch_certificates;
    return $self->{certs}->[$self->{index}];
}

=end internals

=head2 count

Returns the total number of entries in this cursor, independently of the number
of times L</next> has already been called.

=cut

sub count {
    my ($self) = @_;
    return @{$self->{certs}} if $self->{certs};
    # No-camel optimization, isn't it? No! learning test of
    # DBIx::Class! Syntagm found in
    # L<DBIx::Class::Manual::Cookbook>.
    my $count = $self->{cursor}->search
        ({}, {
              select => [ { count => { distinct => 'me.certid' } } ],
              as     => [ 'count' ]
             });
    my $retval = $count->next->get_column("count");
    $count->next; # Reach the end of records, close the statment
    # subjacent handle, and so remove an useless warning.
    return $retval;
}

=head2 has_more

Returns true if, and only if, the cursor has still some results to propose.
All methods hereafter have an undef behavior when I<has_more> returns false.

=cut

sub has_more { defined(shift->_current) }

=head2 next

Makes the cursor advance one position.

=cut

sub next {
    my ($self) = @_;
    $self->{index}++;
    return;
}

=head2 certificate

Returns the certificate currently under the cursor, in a
L<App::CamelPKI::Certificate> object.

=cut

sub certificate { App::CamelPKI::Certificate->parse(shift->_current->der) }

=head2 infos

Returns a table of structures and contents simliar to the table 
%infos passed to L</add> at the time of the certiticate insertion
in database. In a scalar context, returns a reference on a hash
which contains references on lists; In a list context, returns this
same hash "flat" (a list alternating scalar keys and values which
are references on lists).

The order of the %info keys, and the order of values contained in when
more than on key provided, is B<not> preserved.

=cut

sub infos {
    my ($self) = @_;
    $self->_fetch_infos;
    return wantarray ? %{$self->{infos}->[$self->{index}]} :
        $self->{infos}->[$self->{index}];

lib/App/CamelPKI/CADB.pm  view on Meta::CPAN

    );

__PACKAGE__->set_primary_key("certid");
__PACKAGE__->has_many("infos",
                      "App::CamelPKI::CADB::_Schema::CertInfo", "certid");

=head2 App::CamelPKI::CADB::_Schema::Sequence

This class represents the "sequences" table, which contains one line
for each sequence created with L</next_serial> or L</max_serial>.

=cut

package App::CamelPKI::CADB::_Schema::Sequence;
use base qw/DBIx::Class/;
__PACKAGE__->load_components(qw(Core));

__PACKAGE__->table("sequences");

__PACKAGE__->add_columns
    # The name of the sequence, in minor case
    (name => { data_type => "text",
               is_nullable => 0,
             },
     # The current sequence number
     val =>  { data_type => "integer",
               is_nullable => 0,
             });

__PACKAGE__->set_primary_key("name");


=head2 App::CamelPKI::CADB::_Schema

This class represents the whole database schema. Instances of this 
class (created by L</_connect>) represent a connection to a concrete
database.

=cut

package App::CamelPKI::CADB::_Schema;
use base qw/DBIx::Class::Schema/;

__PACKAGE__->load_classes(qw(Certificate CertInfo Sequence));

=head3 throw_exception

Overload of the parent class to throw 
L<App::CamelPKI::Error/App::CamelPKI::Error::Database>.

=cut

sub throw_exception {
    my $self = shift;
    throw App::CamelPKI::Error::Database(join(" ", @_));
}

=head2 App::CamelPKI::CADB::_Logger

Auxilliary class to observe SQL requests, as suggested in
L<DBIx::Class:Manual::Cookbook/Profiling>. Used by L</load>
to honor the setting done by L</debug_statements>.

=cut

package App::CamelPKI::CADB::_Logger;

sub new {
    my ($class, $debugfunc) = @_;
    bless { debugfunc => $debugfunc }, $class;
}

sub txn_begin {}
sub txn_commit {}
sub query_start {}

sub query_end {
    my ($self, @params) = @_;
    $self->{debugfunc}->(@params);
}

require My::Tests::Below unless caller;
1;

__END__

=head1 TEST SUITE

=cut

use Test::More qw(no_plan);
use Test::Group;
use File::Spec::Functions qw(catfile catdir);
use IO::File;
use Fatal qw(mkdir);
use File::Slurp qw(read_file);
use App::CamelPKI::Error;
use App::CamelPKI::Sys qw(fork_and_do);
use App::CamelPKI::Test qw(%test_self_signed_certs
                      %test_entity_certs);
use App::CamelPKI::Certificate;
use Crypt::OpenSSL::CA;

test "learning: storing with real pieces of NUL characters "
    . "inside" => sub {
        # Let's prepare a dummy schema...
        {
            package Bogus::Schema::Beware;
            use base qw/DBIx::Class/;
            __PACKAGE__->load_components(qw(Core));

            __PACKAGE__->table("beware");
            __PACKAGE__->add_columns("blob" => { data_type => "blob" });

            package Bogus::Schema;
            use base qw/DBIx::Class::Schema/;

            __PACKAGE__->load_classes(qw(Beware));
        }
        # This comment only serves to help Emacs out...