imported initial version of youri svn

2 files changed, 394 insertions, 0 deletions

diff --git a/lib/Youri/Check/Resultset/DBI.pm b/lib/Youri/Check/Resultset/DBI.pm
new file mode 100644
index 0000000..8537af4
--- /dev/null
+++ b/lib/Youri/Check/Resultset/DBI.pm
@@ -0,0 +1,372 @@
+# $Id: Result.pm 485 2005-08-01 21:48:21Z guillomovitch $
+package Youri::Check::Resultset::DBI;
+
+=head1 NAME
+
+Youri::Check::Resultset::DBI - DBI-based resultset
+
+=head1 DESCRIPTION
+
+This is a DBI-based L<Youri::Check::Resultset> implementation.
+
+It can be created with any DBI-supported database.
+
+=cut
+
+use warnings;
+use strict;
+use Carp;
+use DBI 1.38;
+use base 'Youri::Check::Resultset';
+
+my %tables = (
+    packages => {
+        id         => 'SERIAL PRIMARY KEY',
+        package    => 'TEXT',
+        media      => 'TEXT',
+        maintainer => 'TEXT',
+    }
+);
+
+my %queries = (
+    add_package =>
+        'INSERT INTO packages (package, media, maintainer) VALUES (?, ?, ?)',
+    get_package_id =>
+        'SELECT id FROM packages WHERE package = ?',
+    get_maintainers =>
+        'SELECT DISTINCT(maintainer) FROM packages WHERE maintainer IS NOT NULL',
+);
+
+=head1 CLASS METHODS
+
+=head2 new(%hash)
+
+Creates and returns a new Youri::Check::Resultset::DBI object.
+
+Specific parameters:
+
+=over
+
+=item driver $driver
+
+Use given string as DBI driver.
+
+=item base $base
+
+Use given string as database name.
+
+=item port $port
+
+Use given string as database port.
+
+=item user $user
+
+Use given string as database user.
+
+=item pass $pass
+
+Use given string as database password.
+
+=back
+
+=cut
+
+sub _init {
+    my $self    = shift;
+    my %options = (
+        driver => '', # driver
+        base   => '', # base
+        port   => '', # port
+        user   => '', # user
+        pass   => '', # pass
+        @_
+    );
+
+    croak "No driver defined" unless $options{driver};
+    croak "No base defined" unless $options{base};
+
+    my $datasource = "DBI:$options{driver}:dbname=$options{base}";
+    $datasource .= ";host=$options{host}" if $options{host};
+    $datasource .= ";port=$options{port}" if $options{port};
+
+    $self->{_dbh} = DBI->connect($datasource, $options{user}, $options{pass}, {
+        RaiseError => 1,
+        PrintError => 0,
+        AutoCommit => 1
+    }) or croak "Unable to connect: $DBI::errstr";
+
+   $self->{_dbh}->trace($options{verbose} - 1) if $options{verbose} > 1;
+}
+
+sub clone {
+    my ($self) = @_;
+    croak "Not a class method" unless ref $self;
+
+    my $clone = bless {
+        _test     => $self->{_test},
+        _verbose  => $self->{_verbose},
+        _resolver => $self->{_resolver},
+        _dbh      => $self->{_dbh}->clone()
+    }, ref $self;
+
+    return $clone;
+}
+
+sub reset {
+    my ($self) = @_;
+    croak "Not a class method" unless ref $self;
+
+    foreach my $table ($self->_get_tables()) {
+        my $query = "DROP TABLE $table";
+        $self->{_dbh}->do($query); 
+    }
+
+    foreach my $table (keys %tables) {
+        $self->_create_table($table, $tables{$table});
+    }
+}
+
+sub _get_tables {
+    my ($self) = @_;
+    my @tables = $self->{_dbh}->tables(undef, undef, '%', 'TABLE');
+    # unquote table name if needed
+    my $char = $self->{_dbh}->get_info(29);
+    @tables = map { substr($_, 1 , -1) } @tables if $char;
+    return @tables;
+}
+
+sub _get_columns {
+    my ($self, $table) = @_;
+    # proper way would be to use column_info(), but unfortunatly DBD::SQLite 
+    # doesn't support it :(
+    return 
+        keys
+        %{$self->{_dbh}->selectrow_hashref("SELECT * from $table")};
+}
+
+sub _create_table {
+    my ($self, $name, $fields) = @_;
+
+    my $query = "CREATE TABLE $name (" .
+        join(',',
+            map { "$_ $fields->{$_}" }
+            keys %$fields
+        ) .
+        ")";
+    $self->{_dbh}->do($query);
+}
+
+sub add_result {
+    my ($self, $type, $media, $package, $values) = @_;
+    croak "Not a class method" unless ref $self;
+    croak "No type defined" unless $type;
+    croak "No package defined" unless $package;
+    croak "No values defined" unless $values;
+
+    my $key = "add_$type";
+    my $sth = $self->{_sths}->{$key};
+
+    unless ($sth) {
+        my @fields = keys %$values;
+        $self->_create_table($type, {
+            'package_id' => 'INT',
+            map { $_ => 'TEXT' } @fields
+        });
+        my $query = "INSERT INTO $type (" .
+           join(',', 'package_id', @fields) .
+          ") VALUES (" .
+           join(',', '?', map { '?' } @fields) .
+          ")";
+        $sth = $self->{_dbh}->prepare($query);
+        $self->{_sths}->{$key} = $sth;
+    }
+
+    print "adding result for type $type and package $package\n"
+        if $self->{_verbose} > 0;
+
+    $sth->execute(
+        $self->_get_package_id(
+            $package->get_canonical_name(),
+            $media->get_name(),
+        ),
+        values %$values
+    );
+}
+
+sub get_types {
+    my ($self) = @_;
+
+    return
+        grep { ! $tables{$_} }
+        $self->_get_tables();
+}
+
+sub get_maintainers {
+    my ($self) = @_;
+
+    return $self->_get_multiple_values('get_maintainers');
+}
+
+sub get_iterator {
+    my ($self, $id, $sort, $filter) = @_;
+
+    die 'No id given, aborting'
+        unless $id;
+    die 'sort should be an arrayref'
+        if $sort and ref $sort ne 'ARRAY';
+    die 'filter should be an hashref'
+        if $filter and ref $filter ne 'HASH';
+        
+    my $query = $self->_get_iterator_query($id, $sort, $filter);
+
+    my $sth = $self->{_dbh}->prepare($query);
+    $sth->execute();
+
+    return Youri::Check::Resultset::DBI::Iterator->new($sth);
+}
+
+sub _get_iterator_query {
+    my ($self, $table, $sort, $filter) = @_;
+
+    my @fields =
+        grep { ! /package_id/ }
+        $self->_get_columns($table);
+
+    my $query = "SELECT DISTINCT " .
+        join(',', qw/package media maintainer/, @fields) .
+        " FROM $table, packages" .
+        " WHERE packages.id = $table.package_id";
+
+    if ($filter) {
+        foreach my $column (keys %{$filter}) {
+            foreach my $value (@{$filter->{$column}}) {
+                $query .= " AND $column = " . $self->{_dbh}->quote($value);
+            }
+        }
+    }
+
+    if ($sort) {
+        $query .= " ORDER BY " . join(', ', @{$sort});
+    }
+
+    return $query;
+}
+
+sub _get_package_id {
+    my ($self, $package, $media) = @_;
+
+    my $id = $self->_get_single_value(
+        'get_package_id',
+        $package
+    );
+    $id = $self->_add_package($package, $media) unless $id;
+
+    return $id;
+}
+
+sub _add_package {
+    my ($self, $package, $media) = @_;
+
+    my $maintainer = $self->{_resolver} ? 
+        $self->{_resolver}->get_maintainer($package) :
+        undef;
+
+    my $sth =
+        $self->{_sths}->{add_package} ||=
+        $self->{_dbh}->prepare($queries{add_package});
+
+    $sth->execute(
+        $package,
+        $media,
+        $maintainer
+    );
+
+    my $id = $self->{_dbh}->last_insert_id(undef, undef, 'packages', 'id');
+
+    return $id;
+}
+
+sub _get_single_value {
+    my ($self, $query, @values) = @_;
+
+    my $sth =
+        $self->{_sths}->{$query} ||=
+        $self->{_dbh}->prepare($queries{$query});
+
+    $sth->execute(@values);
+
+    my @row = $sth->fetchrow_array();
+    return @row ? $row[0]: undef;
+}
+
+sub _get_multiple_values {
+    my ($self, $query, @values) = @_;
+
+    my $sth =
+        $self->{_sths}->{$query} ||=
+        $self->{_dbh}->prepare($queries{$query});
+
+    $sth->execute(@values);
+
+    my @results;
+    while (my @row = $sth->fetchrow_array()) {
+        push @results, $row[0];
+    }
+    return @results;
+}
+
+# close database connection
+sub DESTROY {
+    my ($self) = @_;
+
+    foreach my $sth (values %{$self->{_sths}}) {
+        $sth->finish() if $sth;
+    }
+
+    # warning, may be called before _dbh is created
+    $self->{_dbh}->disconnect() if $self->{_dbh};
+}
+
+package Youri::Check::Resultset::DBI::Iterator;
+
+sub new {
+    my ($class, $sth) = @_;
+
+    my $self = bless {
+        _sth    => $sth,
+        _queue  => []
+    }, $class;
+
+    return $self;
+}
+
+sub has_results {
+    my ($self) = @_;
+
+    return 1 if @{$self->{_queue}};
+
+    push(
+        @{$self->{_queue}},
+        $self->{_sth}->fetchrow_hashref()
+    );
+    
+    return defined $self->{_queue}->[-1];
+}
+
+sub get_result {
+    my ($self) = @_;
+    
+    return @{$self->{_queue}} ?
+        shift @{$self->{_queue}}:
+        $self->{_sth}->fetchrow_hashref();
+}
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2002-2006, YOURI project
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/lib/Youri/Check/Resultset/Iterator.pm b/lib/Youri/Check/Resultset/Iterator.pm
new file mode 100644
index 0000000..56e7e9a
--- /dev/null
+++ b/lib/Youri/Check/Resultset/Iterator.pm
@@ -0,0 +1,22 @@
+# $Id: Base.pm 483 2005-08-01 21:39:05Z guillomovitch $
+package Youri::Check::Resultset::Iterator;
+
+=head1 INSTANCE METHODS
+
+=head2 has_results()
+
+Returns true if results are available.
+
+=head2 get_result()
+
+Returns next available result, as an field => value hash reference.
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2002-2006, YOURI project
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1;