From: Matt S Trout Date: Tue, 19 Jul 2005 13:14:45 +0000 (+0000) Subject: Imported a couple extra modules, added retrieve_all X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=dbd7896fad83f2233729bab2cb6c12ef8369703e;p=dbsrgits%2FDBIx-Class-Historic.git Imported a couple extra modules, added retrieve_all --- diff --git a/lib/DBIx/Class/CDBICompat/Convenience.pm b/lib/DBIx/Class/CDBICompat/Convenience.pm new file mode 100644 index 0000000..f0f98cd --- /dev/null +++ b/lib/DBIx/Class/CDBICompat/Convenience.pm @@ -0,0 +1,35 @@ +package DBIx::Class::CDBICompat::Convenience; + +use strict; +use warnings; + +sub find_or_create { + my $class = shift; + my $hash = ref $_[0] eq "HASH" ? shift: {@_}; + my ($exists) = $class->search($hash); + return defined($exists) ? $exists : $class->create($hash); +} + +sub id { + my ($self) = @_; + die "Can't call id() as a class method" unless ref $self; + my @pk = $self->_ident_value; + return (wantarray ? @pk : $pk[0]); +} + +#sub insert { +# my $self = shift; +# $self->NEXT::insert(@_); +# my @pk = keys %{ $self->_primaries }; +# if ((@pk == 1) && (!$self->{_column_data}{$pk[0]})) { +# $self->{_column_data}{$pk[0]} = $self->_get_dbh->last_insert_id; +# } +# return $self; +#} + +sub retrieve_all { + my ($class) = @_; + return $class->search( { 1 => 1 } ); +} + +1; diff --git a/lib/DBIx/Class/CDBICompat/ImaDBI.pm b/lib/DBIx/Class/CDBICompat/ImaDBI.pm new file mode 100644 index 0000000..37495af --- /dev/null +++ b/lib/DBIx/Class/CDBICompat/ImaDBI.pm @@ -0,0 +1,23 @@ +package DBIx::Class::CDBICompat::ImaDBI; + +use strict; +use warnings; + +use NEXT; + +sub db_Main { + return $_[0]->_get_dbh; +} + +sub _dbi_connect { + my ($class, @info) = @_; + $info[3] = { %{ $info[3] || {}} }; + $info[3]->{RootClass} = 'DBIx::ContextualFetch'; + return $class->NEXT::_dbi_connect(@info); +} + +sub __driver { + return $_[0]->_get_dbh->{Driver}->{Name}; +} + +1; diff --git a/lib/DBIx/Class/PK.pm b/lib/DBIx/Class/PK.pm new file mode 100644 index 0000000..a2f5564 --- /dev/null +++ b/lib/DBIx/Class/PK.pm @@ -0,0 +1,45 @@ +package DBIx::Class::PK; + +use strict; +use warnings; + +use base qw/Class::Data::Inheritable DBIx::Class::SQL/; + +__PACKAGE__->mk_classdata('_primaries' => {}); + +sub _ident_cond { + my ($class) = @_; + return join(" AND ", map { "$_ = ?" } keys %{$class->_primaries}); +} + +sub _ident_values { + my ($self) = @_; + return (map { $self->{_column_data}{$_} } keys %{$self->_primaries}); +} + +sub set_primary { + my ($class, @cols) = @_; + my %pri; + $pri{$_} = {} for @cols; + $class->_primaries(\%pri); +} + +sub retrieve { + my ($class, @vals) = @_; + my @pk = keys %{$class->_primaries}; + die "Can't retrieve unless primary columns are defined" unless @pk; + my $query; + if (ref $vals[0] eq 'HASH') { + $query = $vals[0]; + } elsif (@pk == 1 && @vals == 1) { + return ($class->retrieve_from_sql($class->_ident_cond, $vals[0]))[0]; + } else { + $query = {@vals}; + } + die "Can't retrieve unless all primary keys are specified" + unless (keys %$query >= @pk); # If we check 'em we run afoul of uc/lc + # column names etc. Not sure what to do yet + return ($class->search($query))[0]; +} + +1;