From a4f149873af1e9cff9ab0829adfcd3eca1a3780d Mon Sep 17 00:00:00 2001 From: Nicolas Vigier Date: Thu, 6 Jan 2011 01:07:55 +0000 Subject: search in core, nonfree, tainted instead of main, contrib --- lib/Youri/Check/Resultset/DBI.pm | 372 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 372 insertions(+) create mode 100644 lib/Youri/Check/Resultset/DBI.pm (limited to 'lib/Youri/Check/Resultset/DBI.pm') 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 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; -- cgit v1.2.1