-package Jifty::DBI;
use warnings;
use strict;
-$Jifty::DBI::VERSION = '0.42';
+package DBIx::Class::JDBICompat;
+
+use DBIx::Class::Schema;
+
+our $VERSION = '1.99_01';
+
+BEGIN {
+ for my $subclass (
+ qw(Class/Trigger HasFilters Filter Column Handle Record Collection SchemaGenerator Schema),
+ (map {"Handle/$_"} qw(Pg SQLite mysql)),
+ (map {"Filter/$_"} qw(DateTime Date SaltHash Storable Time Truncate YAML base64 utf8))
+ ) {
+ require "DBIx/Class/JDBICompat/${subclass}.pm";
+ $INC{"Jifty/DBI/${subclass}.pm"} = __FILE__;
+ }
+ $INC{"Jifty/DBI.pm"} = __FILE__;
+}
+
+{
+ my $schema = DBIx::Class::Schema->clone;
+ sub global_schema { $schema; }
+}
=head1 NAME
use DBI ();
use Class::ReturnValue ();
use Encode ();
+use DBIx::Class::Storage::DBI;
use base qw/Jifty::DBI::HasFilters/;
-use vars qw(%DBIHandle $PrevHandle $DEBUG $TRANSDEPTH);
+use vars qw($DEBUG $TRANSDEPTH);
$TRANSDEPTH = 0;
@_
);
- if ( $args{'driver'}
- && !$self->isa( 'Jifty::DBI::Handle::' . $args{'driver'} ) )
- {
- if ( $self->_upgrade_handle( $args{'driver'} ) ) {
- return ( $self->connect(%args) );
- }
- }
-
- my $dsn = $self->dsn || '';
-
-# Setting this actually breaks old RT versions in subtle ways. So we need to explicitly call it
+ # Setting this actually breaks old RT versions in subtle ways. So we need to explicitly call it
$self->build_dsn(%args);
+ my $dsn = $self->dsn || '';
- # Only connect if we're not connected to this source already
- if ( ( !$self->dbh ) || ( !$self->dbh->ping ) || ( $self->dsn ne $dsn ) )
- {
- my $handle
- = DBI->connect( $self->dsn, $args{'user'}, $args{'password'} )
- || Carp::croak "Connect Failed $DBI::errstr\n";
-
-#databases do case conversion on the name of columns returned.
-#actually, some databases just ignore case. this smashes it to something consistent
- $handle->{FetchHashKeyName} = 'NAME_lc';
-
- #Set the handle
- $self->dbh($handle);
-
- return (1);
- }
-
- return (undef);
-
-}
-
-=head2 _upgrade_handle DRIVER
-
-This private internal method turns a plain Jifty::DBI::Handle into one
-of the standard driver-specific subclasses.
-
-=cut
-
-sub _upgrade_handle {
- my $self = shift;
-
- my $driver = shift;
- my $class = 'Jifty::DBI::Handle::' . $driver;
+ my $schema = DBIx::Class::JDBICompat->global_schema->connect($dsn, $args{'user'},$args{'password'});
+ # $schema->storage->ensure_connected; # we can lazy connect.. or can we?
+ $self->schema($schema);
- local $@;
- eval "require $class";
- return if $@;
-
- bless $self, $class;
- return 1;
}
=head2 build_dsn PARAMHASH
=cut
+sub schema {
+ my $self = shift;
+ $self->{'dbic_schema'} = shift if (@_);
+ return $self->{'dbic_schema'}
+}
+
sub dbh {
my $self = shift;
+ my $storage = $self->schema->storage();
+ return $storage->dbh;
+}
- #If we are setting the database handle, set it.
- $DBIHandle{$self} = $PrevHandle = shift if (@_);
- return ( $DBIHandle{$self} ||= $PrevHandle );
-}
=head2 delete $table_NAME @KEY_VALUE_PAIRS
-Takes a table name and a set of key-value pairs in an array. splits the key value pairs, constructs an DELETE statement and performs the delete. Returns the row_id of this row.
+Takes a table name and a set of key-value pairs in an array. splits the key value pairs, constructs an DELETE statement and performs the delete.
=cut
sub delete {
- my ( $self, $table, @pairs ) = @_;
-
- my @bind = ();
- my $where = 'WHERE ';
- while (my $key = shift @pairs) {
- $where .= $key . "=?" . " AND ";
- push( @bind, shift(@pairs) );
+ my ( $self, $table, @attrs ) = @_;
+ my %to_delete = @attrs;
+ my $source = $self->schema->source($table);
+ my $storage = $self->schema->storage;
+ eval {
+ $storage->delete($source, \%to_delete); # XXX TODO may throw an exception
+ };
+ if ($@) {
+ warn $@;
+ return undef;
}
-
- $where =~ s/AND $//;
- my $query_string = "DELETE FROM " . $table . ' ' . $where;
- $self->simple_query( $query_string, @bind );
+ return 1;
+
}
+
+
=head2 insert $table_NAME @KEY_VALUE_PAIRS
Takes a table name and a set of key-value pairs in an array. splits the key value pairs, constructs an INSERT statement and performs the insert. Returns the row_id of this row.
=cut
sub insert {
- my ( $self, $table, @pairs ) = @_;
- my ( @cols, @vals, @bind );
-
-#my %seen; #only the *first* value is used - allows drivers to specify default
- while ( my $key = shift @pairs ) {
- my $value = shift @pairs;
-
- # next if $seen{$key}++;
- push @cols, $key;
- push @vals, '?';
- push @bind, $value;
+ my ( $self, $table, @attrs ) = @_;
+ my %to_insert = @attrs;
+ my $source = $self->schema->source($table);
+ my $storage = $self->schema->storage;
+ eval {
+ $storage->insert($source, \%to_insert); # XXX TODO may throw an exception
+ };
+ if ($@) {
+ warn $@;
+ return undef;
}
-
- my $query_string = "INSERT INTO $table ("
- . CORE::join( ", ", @cols )
- . ") VALUES " . "("
- . CORE::join( ", ", @vals ) . ")";
-
- my $sth = $self->simple_query( $query_string, @bind );
- return ($sth);
+ return $storage->last_insert_id;
}
=head2 update_record_value
column => undef,
is_sql_function => undef,
primary_keys => undef,
+ value => undef,
@_
);
+
return 1 unless grep {defined} values %{$args{primary_keys}};
- my @bind = ();
- my $query = 'UPDATE ' . $args{'table'} . ' ';
- $query .= 'SET ' . $args{'column'} . '=';
+ my $to_set = { $args{'column'} => ($args{'is_sql_function'} ? \$args{'value'} : $args{'value'}) };
- ## Look and see if the column is being updated via a SQL function.
- if ( $args{'is_sql_function'} ) {
- $query .= $args{'value'} . ' ';
- } else {
- $query .= '? ';
- push( @bind, $args{'value'} );
- }
-
- ## Constructs the where clause.
- my $where = 'WHERE ';
- foreach my $key ( keys %{ $args{'primary_keys'} } ) {
- $where .= $key . "=?" . " AND ";
- push( @bind, $args{'primary_keys'}{$key} );
+ eval {
+ $self->schema->storage->update(
+ $self->schema->source($args{'table'}),
+ $to_set, $args{'primary_keys'}
+ );
+ };
+ if ($@) {
+ warn $@;
+ return undef;
}
- $where =~ s/AND\s$//;
-
- my $query_str = $query . $where;
- return ( $self->simple_query( $query_str, @bind ) );
+ return 1;
}
=head2 update_table_value table COLUMN NEW_value RECORD_ID IS_SQL
my $query_string = shift;
my @bind_values;
@bind_values = (@_) if (@_);
+ my $sth;
+ eval {
- my $sth = $self->dbh->prepare($query_string);
+ $sth = $self->dbh->prepare($query_string);
+ };
unless ($sth) {
if ($DEBUG) {
die "$self couldn't prepare the query '$query_string'"
my $self = shift;
my %args = ( short => 1, @_ );
+ die "database_version not currently implemented";
+
unless ( defined $self->{'database_version'} ) {
# turn off error handling, store old values to restore later
}
-=head2 DESTROY
-
-When we get rid of the L<Jifty::DBI::Handle>, we need to disconnect
-from the database
-
-=cut
-
-sub DESTROY {
- my $self = shift;
- $self->disconnect;
- delete $DBIHandle{$self};
-}
-
1;
__END__
+++ /dev/null
-# $Header: $
-
-package Jifty::DBI::Handle::Informix;
-use Jifty::DBI::Handle;
-@ISA = qw(Jifty::DBI::Handle);
-
-use vars qw($VERSION @ISA $DBIHandle $DEBUG);
-use strict;
-
-=head1 NAME
-
- Jifty::DBI::Handle::Informix - An Informix specific Handle object
-
-=head1 SYNOPSIS
-
-
-=head1 DESCRIPTION
-
-This module provides a subclass of Jifty::DBI::Handle that
-compensates for some of the idiosyncrasies of Informix.
-
-=head1 METHODS
-
-=cut
-
-=head2 insert
-
-Takes a table name as the first argument and assumes that the rest of the arguments are an array of key-value pairs to be inserted.
-
-If the insert succeeds, returns the id of the insert, otherwise, returns
-a Class::ReturnValue object with the error reported.
-
-=cut
-
-sub insert {
- my $self = shift;
-
- my $sth = $self->SUPER::insert(@_);
- if ( !$sth ) {
- print "no sth! (" . $self->dbh->{ix_sqlerrd}[1] . ")\n";
- return ($sth);
- }
-
- $self->{id} = $self->dbh->{ix_sqlerrd}[1];
- warn "$self no row id returned on row creation" unless ( $self->{'id'} );
- return ( $self->{'id'} ); #Add Succeded. return the id
-}
-
-=head2 case_sensitive
-
-Returns 1, since Informix's searches are case sensitive by default
-
-=cut
-
-sub case_sensitive {
- my $self = shift;
- return (1);
-}
-
-=head2 apply_limits STATEMENTREF ROWS_PER_PAGE FIRST_ROW
-
-takes an SQL SELECT statement and massages it to return ROWS_PER_PAGE starting with FIRST_ROW;
-
-
-=cut
-
-sub apply_limits {
- my $self = shift;
- my $statementref = shift;
- my $per_page = shift;
- my $first = shift;
-
- # XXX TODO THIS only works on the FIRST page of results. that's a bug
- if ($per_page) {
- $$statementref =~ s[^\s*SELECT][SELECT FIRST $per_page]i;
- }
-}
-
-=head2 disconnect
-
-Disconnects and completely unreferences the handle for Informix.
-
-=cut
-
-sub disconnect {
- my $self = shift;
- if ( $self->dbh ) {
- my $status = $self->dbh->disconnect();
- $self->dbh(undef);
- return $status;
- } else {
- return;
- }
-}
-
-=head2 distinct_query STATEMENTREF
-
-takes an incomplete SQL SELECT statement and massages it to return a DISTINCT result set.
-
-
-=cut
-
-sub distinct_query {
- my $self = shift;
- my $statementref = shift;
- my $sb = shift;
- my $table = $sb->table;
-
- if ( $sb->_order_clause =~ /(?<!main)\./ ) {
-
- # Don't know how to do ORDER BY when the DISTINCT is in a subquery
- warn
- "Query will contain duplicate rows; don't how how to ORDER BY across DISTINCT";
- $$statementref = "SELECT main.* FROM $$statementref";
- } else {
-
- # Wrapper select query in a subselect as Informix doesn't allow
- # DISTINCT against CLOB/BLOB column types.
- $$statementref
- = "SELECT * FROM $table main WHERE id IN ( SELECT DISTINCT main.id FROM $$statementref )";
- }
- $$statementref .= $sb->_group_clause;
- $$statementref .= $sb->_order_clause;
-}
-
-1;
-
-__END__
-
-=head1 AUTHOR
-
-Oliver Tappe, oliver@akso.de
-
-=head1 SEE ALSO
-
-perl(1), Jifty::DBI
-
-=cut
+++ /dev/null
-package Jifty::DBI::Handle::ODBC;
-use Jifty::DBI::Handle;
-@ISA = qw(Jifty::DBI::Handle);
-
-use vars qw($VERSION @ISA $DBIHandle $DEBUG);
-use strict;
-
-=head1 NAME
-
- Jifty::DBI::Handle::ODBC - An ODBC specific Handle object
-
-=head1 SYNOPSIS
-
-
-=head1 DESCRIPTION
-
-This module provides a subclass of L<Jifty::DBI::Handle> that
-compensates for some of the idiosyncrasies of ODBC.
-
-=head1 METHODS
-
-=cut
-
-=head2 case_sensitive
-
-Returns a false value.
-
-=cut
-
-sub case_sensitive {
- my $self = shift;
- return (undef);
-}
-
-=head2 build_dsn
-
-=cut
-
-sub build_dsn {
- my $self = shift;
- my %args = (
- driver => undef,
- database => undef,
- host => undef,
- port => undef,
- @_
- );
-
- $args{dbname} ||= delete $args{database};
-
- my $dsn = "dbi:$args{driver}:$args{dbname}";
- $dsn .= ";host=$args{'host'}" if $args{'host'};
- $dsn .= ";port=$args{'port'}" if $args{'port'};
-
- $self->{'dsn'} = $dsn;
-}
-
-=head2 apply_limits
-
-=cut
-
-sub apply_limits {
- my $self = shift;
- my $statementref = shift;
- my $per_page = shift or return;
- my $first = shift;
-
- my $limit_clause = " TOP $per_page";
- $limit_clause .= " OFFSET $first" if $first;
- $$statementref =~ s/SELECT\b/SELECT $limit_clause/;
-}
-
-=head2 distinct_query
-
-=cut
-
-sub distinct_query {
- my $self = shift;
- my $statementref = shift;
-
- my $sb = shift;
-
- $$statementref = "SELECT main.* FROM $$statementref";
- $$statementref .= $sb->_group_clause;
- $$statementref .= $sb->_order_clause;
-}
-
-=head2 encoding
-
-=cut
-
-sub encoding {
-}
-
-1;
-
-__END__
-
-=head1 AUTHOR
-
-Audrey Tang C<cpan@audreyt.org>
-
-=head1 SEE ALSO
-
-L<Jifty::DBI>, L<Jifty::DBI::Handle>, L<DBD::ODBC>
-
-=cut
sub connect {
my $self = shift;
- my %args = (
- driver => undef,
- database => undef,
- user => undef,
- password => undef,
- sid => undef,
- host => undef,
- @_
- );
-
- $self->SUPER::connect(%args);
-
$self->dbh->{LongTruncOk} = 1;
$self->dbh->{LongReadLen} = 8000;
return ($DBIHandle);
}
-
-=head2 database_version
-
-Returns value of ORA_OCI constant, see L<DBD::Oracle/Constants>.
-
-=cut
-
-sub database_version {
- return ''. ORA_OCI;
-}
-
-
-=head2 insert
-
-Takes a table name as the first argument and assumes that the rest of
-the arguments are an array of key-value pairs to be inserted.
-
-=cut
-
-sub insert {
- my $self = shift;
- my $table = shift;
- my ($sth);
-
- # Oracle Hack to replace non-supported mysql_rowid call
-
- my %attribs = @_;
- my ( $unique_id, $query_string );
-
- if ( $attribs{'Id'} || $attribs{'id'} ) {
- $unique_id = ( $attribs{'Id'} ? $attribs{'Id'} : $attribs{'id'} );
- } else {
-
- $query_string = "SELECT " . $table . "_seq.nextval FROM DUAL";
-
- $sth = $self->simple_query($query_string);
- if ( !$sth ) {
- if ($main::debug) {
- die "Error with $query_string";
- } else {
- return (undef);
- }
- }
-
- #needs error checking
- my @row = $sth->fetchrow_array;
-
- $unique_id = $row[0];
-
- }
-
- #TODO: don't hardcode this to id pull it from somewhere else
- #call super::insert with the new column id.
-
- $attribs{'id'} = $unique_id;
- delete $attribs{'Id'};
- $sth = $self->SUPER::insert( $table, %attribs );
-
- unless ($sth) {
- if ($main::debug) {
- die "Error with $query_string: " . $self->dbh->errstr;
- } else {
- return (undef);
- }
- }
-
- $self->{'id'} = $unique_id;
- return ( $self->{'id'} ); #Add Succeded. return the id
-}
-
-=head2 build_dsn PARAMHASH
-
-Takes a bunch of parameters:
-
-Required: Driver, Database or Host/SID,
-Optional: Port and RequireSSL
-
-Builds a dsn suitable for an Oracle DBI connection
-
-=cut
-
-sub build_dsn {
- my $self = shift;
- my %args = (
- driver => undef,
- database => undef,
- host => undef,
- port => undef,
- sid => undef,
- requiressl => undef,
- @_
- );
-
- my $dsn = "dbi:$args{'driver'}:";
-
- if ( defined $args{'host'}
- && $args{'host'}
- && defined $args{'sid'}
- && $args{'sid'} )
- {
- $dsn .= "host=$args{'host'};sid=$args{'sid'}";
- } else {
- $dsn .= "$args{'database'}"
- if ( defined $args{'database'} && $args{'database'} );
- }
- $dsn .= ";port=$args{'port'}"
- if ( defined $args{'port'} && $args{'port'} );
- $dsn .= ";requiressl=1"
- if ( defined $args{'requiressl'} && $args{'requiressl'} );
-
- $self->{'dsn'} = $dsn;
-}
-
=head2 blob_params column_NAME column_type
Returns a hash ref for the bind_param call to identify BLOB types used
);
}
-=head2 apply_limits STATEMENTREF ROWS_PER_PAGE FIRST_ROW
-
-takes an SQL SELECT statement and massages it to return ROWS_PER_PAGE
-starting with FIRST_ROW;
-
-=cut
-
-sub apply_limits {
- my $self = shift;
- my $statementref = shift;
- my $per_page = shift;
- my $first = shift;
-
- # Transform an SQL query from:
- #
- # SELECT main.*
- # FROM Tickets main
- # WHERE ((main.EffectiveId = main.id))
- # AND ((main.Type = 'ticket'))
- # AND ( ( (main.Status = 'new')OR(main.Status = 'open') )
- # AND ( (main.Queue = '1') ) )
- #
- # to:
- #
- # SELECT * FROM (
- # SELECT limitquery.*,rownum limitrownum FROM (
- # SELECT main.*
- # FROM Tickets main
- # WHERE ((main.EffectiveId = main.id))
- # AND ((main.Type = 'ticket'))
- # AND ( ( (main.Status = 'new')OR(main.Status = 'open') )
- # AND ( (main.Queue = '1') ) )
- # ) limitquery WHERE rownum <= 50
- # ) WHERE limitrownum >= 1
- #
-
- if ($per_page) {
-
- # Oracle orders from 1 not zero
- $first++;
-
- # Make current query a sub select
- $$statementref
- = "SELECT * FROM ( SELECT limitquery.*,rownum limitrownum FROM ( $$statementref ) limitquery WHERE rownum <= "
- . ( $first + $per_page - 1 )
- . " ) WHERE limitrownum >= "
- . $first;
- }
-}
-
-=head2 distinct_query STATEMENTREF
-
-takes an incomplete SQL SELECT statement and massages it to return a
-DISTINCT result set.
-
-=cut
-
-sub distinct_query {
- my $self = shift;
- my $statementref = shift;
- my $sb = shift;
- my $table = $sb->Table;
-
- # Wrapp select query in a subselect as Oracle doesn't allow
- # DISTINCT against CLOB/BLOB column types.
- if ( $sb->_order_clause =~ /(?<!main)\./ ) {
-
- # If we are ordering by something not in 'main', we need to GROUP
- # BY and adjust the ORDER_BY accordingly
- local $sb->{group_by}
- = [ @{ $sb->{group_by} || [] }, { column => 'id' } ];
- local $sb->{order_by} = [
- map {
- ( $_->{alias} and $_->{alias} ne "main" )
- ? { %{$_}, column => "min(" . $_->{column} . ")" }
- : $_
- } @{ $sb->{order_by} }
- ];
- my $group = $sb->_group_clause;
- my $order = $sb->_order_clause;
- $$statementref
- = "SELECT main.* FROM ( SELECT main.id FROM $$statementref $group $order ) distinctquery, $table main WHERE (main.id = distinctquery.id)";
- } else {
- $$statementref
- = "SELECT main.* FROM ( SELECT DISTINCT main.id FROM $$statementref ) distinctquery, $table main WHERE (main.id = distinctquery.id) ";
- $$statementref .= $sb->_group_clause;
- $$statementref .= $sb->_order_clause;
- }
-}
-
-1;
-
-__END__
-
-=head1 AUTHOR
-
-Jesse Vincent, jesse@fsck.com
-
-=head1 SEE ALSO
-
-L<Jifty::DBI>, L<Jifty::DBI::Handle>, L<DBD::Oracle>
-
-=cut
return ($DBIHandle);
}
-=head2 insert
-
-Takes a table name as the first argument and assumes that the rest of
-the arguments are an array of key-value pairs to be inserted.
-
-In case of insert failure, returns a L<Class::ReturnValue> object
-preloaded with error info
-
-=cut
-
-sub insert {
- my $self = shift;
- my $table = shift;
- my %args = (@_);
- my $sth = $self->SUPER::insert( $table, %args );
-
- unless ($sth) {
- return ($sth);
- }
-
- if ( $args{'id'} || $args{'Id'} ) {
- $self->{'id'} = $args{'id'} || $args{'Id'};
- return ( $self->{'id'} );
- }
-
- my $sequence_name = $self->id_sequence_name($table);
- unless ($sequence_name) { return ($sequence_name) } # Class::ReturnValue
- my $seqsth = $self->dbh->prepare(
- qq{SELECT CURRVAL('} . $sequence_name . qq{')} );
- $seqsth->execute;
- $self->{'id'} = $seqsth->fetchrow_array();
-
- return ( $self->{'id'} );
-}
-
-=head2 id_sequence_name TABLE
-
-Takes a TABLE name and returns the name of the sequence of the primary key for that table.
-
-=cut
-
-sub id_sequence_name {
- my $self = shift;
- my $table = shift;
-
- return $self->{'_sequences'}{$table}
- if ( exists $self->{'_sequences'}{$table} );
-
- #Lets get the id of that row we just inserted
- my $seq;
- my $colinfosth = $self->dbh->column_info( undef, undef, lc($table), '%' );
- while ( my $foo = $colinfosth->fetchrow_hashref ) {
-
- # Regexp from DBIx::Class's Pg handle. Thanks to Marcus Ramberg
- if ( defined $foo->{'COLUMN_DEF'}
- && $foo->{'COLUMN_DEF'}
- =~ m!^nextval\(+'"?([^"']+)"?'(::(?:text|regclass)\))+!i )
- {
- return $self->{'_sequences'}{$table} = $1;
- }
-
- }
- my $ret = Class::ReturnValue->new();
- $ret->as_error(
- errno => '-1',
- message => "Found no sequence for $table",
- do_backtrace => undef
- );
- return ( $ret->return_value );
-
-}
-
-=head2 blob_params column_NAME column_type
-
-Returns a hash ref for the bind_param call to identify BLOB types used
-by the current database for a particular column type. The current
-Postgres implementation only supports BYTEA types.
-
-=cut
-
-sub blob_params {
- my $self = shift;
- my $name = shift;
- my $type = shift;
-
- # Don't assign to key 'value' as it is defined later.
- return ( { pg_type => DBD::Pg::PG_BYTEA() } ) if $type =~ /^(?:blob|bytea)$/;
- return ( {} );
-}
-
-=head2 apply_limits STATEMENTREF ROWS_PER_PAGE FIRST_ROW
-
-takes an SQL SELECT statement and massages it to return ROWS_PER_PAGE
-starting with FIRST_ROW;
-
-=cut
-
-sub apply_limits {
- my $self = shift;
- my $statementref = shift;
- my $per_page = shift;
- my $first = shift;
-
- my $limit_clause = '';
-
- if ($per_page) {
- $limit_clause = " LIMIT ";
- $limit_clause .= $per_page;
- if ( $first && $first != 0 ) {
- $limit_clause .= " OFFSET $first";
- }
- }
-
- $$statementref .= $limit_clause;
-
-}
-
-=head2 _make_clause_case_insensitive column operator VALUE
-
-Takes a column, operator and value. performs the magic necessary to make
-your database treat this clause as case insensitive.
-
-Returns a column operator value triple.
-
-=cut
-
-sub _make_clause_case_insensitive {
- my $self = shift;
- my $column = shift;
- my $operator = shift;
- my $value = shift;
-
- if ($self->_case_insensitivity_valid($column, $operator, $value)) {
- if ( $operator =~ /(?:LIKE|=)/i ) {
- $column = "LOWER($column)";
- $value = "LOWER($value)";
- }
- }
- return ( $column, $operator, $value );
-}
-
-=head2 distinct_query STATEMENTREF
-
-takes an incomplete SQL SELECT statement and massages it to return a DISTINCT result set.
-
-=cut
-
-sub distinct_query {
- my $self = shift;
- my $statementref = shift;
- my $sb = shift;
- my $table = $sb->table;
-
- if (
- grep {
- ( defined $_->{'alias'} and $_->{'alias'} ne 'main' )
- || defined $_->{'function'}
- } @{ $sb->order_by }
- )
- {
-
- # If we are ordering by something not in 'main', we need to GROUP
- # BY and adjust the ORDER_BY accordingly
- local $sb->{group_by}
- = [ @{ $sb->{group_by} || [] }, { column => 'id' } ];
- local $sb->{order_by} = [
- map {
- my $alias = $_->{alias} || '';
- my $column = $_->{column};
- $alias .= '.' if $alias;
- #warn "alias $alias => column $column\n";
- ((!$alias or $alias eq 'main.') and $column eq 'id')
- ? $_
- : { %{$_}, alias => '', column => "min($alias$column)" }
- } @{ $sb->{order_by} }
- ];
- my $group = $sb->_group_clause;
- my $order = $sb->_order_clause;
- $$statementref
- = "SELECT ".$sb->_preload_columns." FROM ( SELECT main.id FROM $$statementref $group $order ) distinctquery, $table main WHERE (main.id = distinctquery.id)";
- }
- else {
- $$statementref = "SELECT DISTINCT ".$sb->_preload_columns." FROM $$statementref";
- $$statementref .= $sb->_group_clause;
- $$statementref .= $sb->_order_clause;
- }
-}
-
1;
-
-__END__
-
-=head1 SEE ALSO
-
-L<Jifty::DBI>, L<Jifty::DBI::Handle>, L<DBD::Pg>
-
-=cut
-
+++ /dev/null
-
-package Jifty::DBI::Handle::SQLite;
-use Jifty::DBI::Handle;
-@ISA = qw(Jifty::DBI::Handle);
-
-use vars qw($VERSION @ISA $DBIHandle $DEBUG);
-use strict;
-
-=head1 NAME
-
- Jifty::DBI::Handle::SQLite -- A SQLite specific Handle object
-
-=head1 SYNOPSIS
-
-
-=head1 DESCRIPTION
-
-This module provides a subclass of Jifty::DBI::Handle that
-compensates for some of the idiosyncrasies of SQLite.
-
-=head1 METHODS
-
-=head2 database_version
-
-Returns the version of the SQLite library which is used, e.g., "2.8.0".
-SQLite can only return short variant.
-
-=cut
-
-sub database_version {
- my $self = shift;
- return '' unless $self->dbh;
- return $self->dbh->{sqlite_version} || '';
-}
-
-=head2 insert
-
-Takes a table name as the first argument and assumes that the rest of the arguments
-are an array of key-value pairs to be inserted.
-
-If the insert succeeds, returns the id of the insert, otherwise, returns
-a Class::ReturnValue object with the error reported.
-
-=cut
-
-sub insert {
- my $self = shift;
- my $table = shift;
- my %args = ( id => undef, @_ );
-
- # We really don't want an empty id
-
- my $sth = $self->SUPER::insert( $table, %args );
- return unless $sth;
-
-# If we have set an id, then we want to use that, otherwise, we want to lookup the last _new_ rowid
- $self->{'id'} = $args{'id'} || $self->dbh->func('last_insert_rowid');
-
- warn "$self no row id returned on row creation" unless ( $self->{'id'} );
- return ( $self->{'id'} ); #Add Succeded. return the id
-}
-
-=head2 case_sensitive
-
-Returns 1, since SQLite's searches are case sensitive by default.
-Note, however, SQLite's C<like> operator is case I<in>sensitive.
-
-=cut
-
-sub case_sensitive {
- my $self = shift;
- return (1);
-}
-
-=head2 distinct_count STATEMENTREF
-
-takes an incomplete SQL SELECT statement and massages it to return a DISTINCT result count
-
-
-=cut
-
-sub distinct_count {
- my $self = shift;
- my $statementref = shift;
-
- # Wrapper select query in a subselect as Oracle doesn't allow
- # DISTINCT against CLOB/BLOB column types.
- $$statementref
- = "SELECT count(*) FROM (SELECT DISTINCT main.id FROM $$statementref )";
-
-}
-
-1;
-
-__END__
-
-=head1 AUTHOR
-
-Jesse Vincent, jesse@fsck.com
-
-=head1 SEE ALSO
-
-perl(1), Jifty::DBI
-
-=cut
+++ /dev/null
-package Jifty::DBI::Handle::Sybase;
-use Jifty::DBI::Handle;
-@ISA = qw(Jifty::DBI::Handle);
-
-use vars qw($VERSION @ISA $DBIHandle $DEBUG);
-use strict;
-
-=head1 NAME
-
- Jifty::DBI::Handle::Sybase -- a Sybase specific Handle object
-
-=head1 SYNOPSIS
-
-=head1 DESCRIPTION
-
-This module provides a subclass of L<Jifty::DBI::Handle> that
-compensates for some of the idiosyncrasies of Sybase.
-
-=head1 METHODS
-
-=head2 insert
-
-Takes a table name as the first argument and assumes that the rest of
-the arguments are an array of key-value pairs to be inserted.
-
-If the insert succeeds, returns the id of the insert, otherwise,
-returns a L<Class::ReturnValue> object with the error reported.
-
-=cut
-
-sub insert {
- my $self = shift;
-
- my $table = shift;
- my %pairs = @_;
- my $sth = $self->SUPER::insert( $table, %pairs );
- if ( !$sth ) {
- return ($sth);
- }
-
- # Can't select identity column if we're inserting the id by hand.
- unless ( $pairs{'id'} ) {
- my @row = $self->fetch_result('SELECT @@identity');
-
- # TODO: Propagate Class::ReturnValue up here.
- unless ( $row[0] ) {
- return (undef);
- }
- $self->{'id'} = $row[0];
- }
- return ( $self->{'id'} );
-}
-
-=head2 database_version
-
-return the database version, trimming off any -foo identifier
-
-=cut
-
-sub database_version {
- my $self = shift;
- my $v = $self->SUPER::database_version();
-
- $v =~ s/\-(.*)$//;
- return ($v);
-
-}
-
-=head2 case_sensitive
-
-Returns undef, since Sybase's searches are not case sensitive by default
-
-=cut
-
-sub case_sensitive {
- my $self = shift;
- return (1);
-}
-
-# sub apply_limits {
-# my $self = shift;
-# my $statementref = shift;
-# my $per_page = shift;
-# my $first = shift;
-#
-# }
-
-=head2 distinct_query STATEMENTREF
-
-Takes an incomplete SQL SELECT statement and massages it to return a
-DISTINCT result set.
-
-=cut
-
-sub distinct_query {
- my $self = shift;
- my $statementref = shift;
- my $sb = shift;
- my $table = $sb->table;
-
- if ( $sb->_order_clause =~ /(?<!main)\./ ) {
-
- # Don't know how to do ORDER BY when the DISTINCT is in a subquery
- warn
- "Query will contain duplicate rows; don't how how to ORDER BY across DISTINCT";
- $$statementref = "SELECT main.* FROM $$statementref";
- } else {
-
- # Wrapper select query in a subselect as Sybase doesn't allow
- # DISTINCT against CLOB/BLOB column types.
- $$statementref
- = "SELECT main.* FROM ( SELECT DISTINCT main.id FROM $$statementref ) distinctquery, $table main WHERE (main.id = distinctquery.id) ";
- }
- $$statementref .= $sb->_group_clause;
- $$statementref .= $sb->_order_clause;
-}
-
-1;
-
-__END__
-
-=head1 AUTHOR
-
-Jesse Vincent, jesse@fsck.com
-
-=head1 SEE ALSO
-
-L<Jifty::DBI>, L<Jifty::DBI::Handle>, L<DBD::Sybase>
-
-=cut
+++ /dev/null
-package Jifty::DBI::Handle::mysql;
-use Jifty::DBI::Handle;
-@ISA = qw(Jifty::DBI::Handle);
-
-use vars qw($VERSION @ISA $DBIHandle $DEBUG);
-use strict;
-
-=head1 NAME
-
- Jifty::DBI::Handle::mysql - A mysql specific Handle object
-
-=head1 SYNOPSIS
-
-
-=head1 DESCRIPTION
-
-This module provides a subclass of L<Jifty::DBI::Handle> that
-compensates for some of the idiosyncrasies of MySQL.
-
-=head1 METHODS
-
-=cut
-
-=head2 insert
-
-Takes a table name as the first argument and assumes that the rest of
-the arguments are an array of key-value pairs to be inserted.
-
-If the insert succeeds, returns the id of the insert, otherwise,
-returns a L<Class::ReturnValue> object with the error reported.
-
-=cut
-
-sub insert {
- my $self = shift;
-
- my $sth = $self->SUPER::insert(@_);
- if ( !$sth ) {
- return ($sth);
- }
-
- $self->{'id'} = $self->dbh->{'mysql_insertid'};
-
- # Yay. we get to work around mysql_insertid being null some of the time :/
- unless ( $self->{'id'} ) {
- $self->{'id'} = $self->fetch_result('SELECT LAST_INSERT_ID()');
- }
- warn "$self no row id returned on row creation" unless ( $self->{'id'} );
-
- return ( $self->{'id'} ); #Add Succeded. return the id
-}
-
-=head2 database_version
-
-Returns the mysql version, trimming off any -foo identifier
-
-=cut
-
-sub database_version {
- my $self = shift;
- my $v = $self->SUPER::database_version();
-
- $v =~ s/\-.*$//;
- return ($v);
-}
-
-=head2 case_sensitive
-
-Returns undef, since mysql's searches are not case sensitive by default
-
-=cut
-
-sub case_sensitive {
- my $self = shift;
- return (undef);
-}
-
-1;
-
-__END__
-
-=head1 AUTHOR
-
-Jesse Vincent, jesse@fsck.com
-
-=head1 SEE ALSO
-
-L<Jifty::DBI>, L<Jifty::DBI::Handle>, L<DBD::mysql>
-
-=cut
-
+++ /dev/null
-package Jifty::DBI::Handle::mysqlPP;
-use Jifty::DBI::Handle::mysql;
-@ISA = qw(Jifty::DBI::Handle::mysql);
-
-use vars qw($VERSION @ISA $DBIHandle $DEBUG);
-use strict;
-
-1;
-
-__END__
-
-=head1 NAME
-
-Jifty::DBI::Handle::mysqlPP - A mysql specific Handle object
-
-=head1 DESCRIPTION
-
-A Handle subclass for the "pure perl" mysql database driver.
-
-This is currently identical to the Jifty::DBI::Handle::mysql class.
-
-=head1 AUTHOR
-
-
-
-=head1 SEE ALSO
-
-Jifty::DBI::Handle::mysql
-
-=cut
-
-package Jifty::DBI::HasFilters;
-
use warnings;
use strict;
+package Jifty::DBI::HasFilters;
+
use base qw/Class::Accessor::Fast/;
-__PACKAGE__->mk_accessors qw/
- input_filters
- output_filters
- filters
- /;
+__PACKAGE__->mk_accessors qw/ input_filters output_filters filters /;
=head1 NAME
use Lingua::EN::Inflect ();
use Jifty::DBI::Column ();
use UNIVERSAL::require ();
+use DBIx::Class::ResultSource::Table ();
use Scalar::Util qw(blessed);
use Jifty::DBI::Class::Trigger; # exports by default
-
+use Scalar::Defer ();
use base qw/
Class::Data::Inheritable
our $VERSION = '0.01';
Jifty::DBI::Record->mk_classdata(qw/COLUMNS/);
+Jifty::DBI::Record->mk_classdata(qw/_RESULT_SOURCE/);
Jifty::DBI::Record->mk_classdata(qw/TABLE_NAME/ );
Jifty::DBI::Record->mk_classdata(qw/_READABLE_COLS_CACHE/);
Jifty::DBI::Record->mk_classdata(qw/_WRITABLE_COLS_CACHE/);
Jifty::DBI::Record->mk_classdata(qw/_COLUMNS_CACHE/ );
+sub RESULT_SOURCE {
+ my $self = shift;
+ unless ($self->_RESULT_SOURCE) {
+ my $class = ref($self) || $self;
+ my $source = DBIx::Class::ResultSource::Table->new;
+ $source->result_class($class);
+ $source->name($class->table);
+ my $schema = DBIx::Class::JDBICompat->global_schema;
+ $schema->register_source($class->table => $source);
+ $self->_RESULT_SOURCE($schema->source($class));
+ }
+ $self->_RESULT_SOURCE;
+}
+
=head1 NAME
Jifty::DBI::Record - Superclass for records loaded by Jifty::DBI::Collection
return if defined $self->COLUMNS;
$self->COLUMNS( {} );
+ my $source = $self->RESULT_SOURCE;
+
+ my @pri = @{$self->_primary_keys};
- foreach my $column_name ( @{ $self->_primary_keys } ) {
+ $source->add_columns(@pri);
+ $source->set_primary_key(@pri);
+
+ foreach my $column_name ( @pri ) {
my $column = $self->add_column($column_name);
$column->writable(0);
$column->readable(1);
$self->_init_methods_for_column($column);
}
+
+
+
}
=head2 _init_methods_for_columns
my $self = shift;
my $name = shift;
$name = lc $name;
-
- $self->COLUMNS->{$name} = Jifty::DBI::Column->new()
- unless exists $self->COLUMNS->{$name};
+
+ unless (exists $self->COLUMNS->{$name}) {
+ $self->RESULT_SOURCE->add_column($name); # naive, no column metadata stored yet
+ $self->COLUMNS->{$name} = Jifty::DBI::Column->new();
+ }
$self->_READABLE_COLS_CACHE(undef);
$self->_WRITABLE_COLS_CACHE(undef);
$self->_COLUMNS_CACHE(undef );
my $action = $args{'direction'} eq 'output' ? 'decode' : 'encode';
foreach my $filter_class (@filters) {
local $UNIVERSAL::require::ERROR;
- $filter_class->require() unless
- $INC{ join('/', split(/::/,$filter_class)).".pm" };
+ $filter_class->require() unless $INC{ join('/', split(/::/,$filter_class)).".pm" };
if ($UNIVERSAL::require::ERROR) {
- warn $UNIVERSAL::require::ERROR;
+ die $UNIVERSAL::require::ERROR;
next;
}
my $filter = $filter_class->new(
=cut
sub import {
- my $self = shift;
+ my $self = shift;
my $caller = caller;
- for ($self->columns) {
- $caller->COLUMNS->{$_->name} = $_ ;
- $caller->_init_methods_for_column($_);
+ for ( $self->columns ) {
+ $caller->RESULT_SOURCE->add_column( $_->name )
+ ; # XXX TODO, should get refactored to share code with ::Record->add_columnj
+ $caller->COLUMNS->{ $_->name } = $_;
+ $caller->_init_methods_for_column($_);
}
- $self->export_to_level(1,undef);
-
- if (my $triggers = $self->can('register_triggers') ) {
- $triggers->($caller)
+ $self->export_to_level( 1, undef );
+
+ if ( my $triggers = $self->can('register_triggers') ) {
+ $triggers->($caller);
}
}
}
$from->COLUMNS->{$name} = $column;
+ $from->RESULT_SOURCE->add_column($name); # XXX TODO, should get refactored to share code with ::Record->add_columnj
+
# Heuristics: If we are called through Jifty::DBI::Schema,
# then we know that we are going to initialize methods later
use strict;
use Test::More;
-BEGIN { require "t/utils.pl" }
+BEGIN { require "t/jdbi-t/utils.pl" }
our (@available_drivers);
use constant TESTS_PER_DRIVER => 4;
use warnings;
use File::Spec;
use Test::More;
-BEGIN { require "t/utils.pl" }
+BEGIN { require "t/jdbi-t/utils.pl" }
our (@available_drivers);
use constant TESTS_PER_DRIVER => 71;
use warnings;
use File::Spec;
use Test::More;
-BEGIN { require "t/utils.pl" }
+BEGIN { require "t/jdbi-t/utils.pl" }
our (@available_drivers);
use constant TESTS_PER_DRIVER => 82;
use File::Spec;
use Test::More;# import => [qw(isa_ok skip plan)];
-BEGIN { require "t/utils.pl" }
+BEGIN { require "t/jdbi-t/utils.pl" }
our (@available_drivers);
use constant TESTS_PER_DRIVER => 7;
use warnings;
use File::Spec;
use Test::More;
-BEGIN { require "t/utils.pl" }
+BEGIN { require "t/jdbi-t/utils.pl" }
use constant TESTS_PER_DRIVER => 35;
use File::Spec;
use Test::More;
-BEGIN { require "t/utils.pl" }
+BEGIN { require "t/jdbi-t/utils.pl" }
our (@available_drivers);
use constant TESTS_PER_DRIVER => 9;
use File::Spec;
use Test::More;
-BEGIN { require "t/utils.pl" }
+BEGIN { require "t/jdbi-t/utils.pl" }
our (@available_drivers);
use constant TESTS_PER_DRIVER => 47;
use Test::More;
use Jifty::DBI::Handle;
-BEGIN { require "t/utils.pl" }
+BEGIN { require "t/jdbi-t/utils.pl" }
our (@available_drivers);
use constant TESTS_PER_DRIVER => 4;
use Test::More;
-BEGIN { require 't/utils.pl' }
+BEGIN { require 't/jdbi-t/utils.pl' }
use constant TESTS_PER_DRIVER => 1;
use strict;
use Test::More;
-BEGIN { require "t/utils.pl" }
+BEGIN { require "t/jdbi-t/utils.pl" }
plan tests => 6;
# test for Jifty::DBI::Filter class only
# create new t/06filter_*.t files for specific filters
use strict;
use Test::More;
-BEGIN { require "t/utils.pl" }
+BEGIN { require "t/jdbi-t/utils.pl" }
our (@available_drivers);
use constant TESTS_PER_DRIVER => 18;
use warnings;
use Test::More;
-BEGIN { require "t/utils.pl" }
+BEGIN { require "t/jdbi-t/utils.pl" }
our (@available_drivers);
use constant TESTS_PER_DRIVER => 9;
use strict;
use Test::More;
-BEGIN { require "t/utils.pl" }
+BEGIN { require "t/jdbi-t/utils.pl" }
our (@available_drivers);
use constant TESTS_PER_DRIVER => 15;
}
-sub schema_mysql_4_1 {
-
-<<EOF;
-CREATE TEMPORARY table users (
- id integer auto_increment primary key,
- login binary(5),
- name varbinary(10),
- disabled int(4) default 0
-)
-EOF
-
-}
# XXX: Pg adds trailing spaces to CHAR columns
# when other don't, must be fixed for consistency
use strict;
use Test::More;
-BEGIN { require "t/utils.pl" }
+BEGIN { require "t/jdbi-t/utils.pl" }
our (@available_drivers);
use constant TESTS_PER_DRIVER => 24;
use warnings;
use Test::More;
-BEGIN { require "t/utils.pl" }
+BEGIN { require "t/jdbi-t/utils.pl" }
our (@available_drivers);
use constant TESTS_PER_DRIVER => 9;
our @available_drivers;
BEGIN {
- require("t/utils.pl");
+ require("t/jdbi-t/utils.pl");
my $total = 3 + scalar(@available_drivers) * TESTS_PER_DRIVER;
if( not eval { require DBIx::DBSchema } ) {
plan skip_all => "DBIx::DBSchema not installed";
use File::Spec;
use Test::More;
-BEGIN { require "t/utils.pl" }
+BEGIN { require "t/jdbi-t/utils.pl" }
our (@available_drivers);
use constant TESTS_PER_DRIVER => 67;
use File::Spec;
use Test::More;
-BEGIN { require "t/utils.pl" }
+BEGIN { require "t/jdbi-t/utils.pl" }
our (@available_drivers);
use constant TESTS_PER_DRIVER => 41;
use strict;
use Test::More;
-BEGIN { require "t/utils.pl" }
+BEGIN { require "t/jdbi-t/utils.pl" }
our (@available_drivers);
use constant TESTS_PER_DRIVER => 16;
use strict;
use Test::More;
-BEGIN { require "t/utils.pl" }
+BEGIN { require "t/jdbi-t/utils.pl" }
our (@available_drivers);
use constant TESTS_PER_DRIVER => 17;
use strict;
use Test::More;
-BEGIN { require "t/utils.pl" }
+BEGIN { require "t/jdbi-t/utils.pl" }
our (@available_drivers);
use constant TESTS_PER_DRIVER => 9;
}
}
-sub schema_sqlite_024 {
- return q{
- CREATE TABLE addresses (
- id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL ,
- employee_id integer ,
- name varchar DEFAULT 'Frank' ,
- phone varchar ,
- street varchar
- ) ;
- }
-}
-
sub schema_pg {
return q{
CREATE TABLE addresses (
};
}
-sub schema_pg_024 {
- return q{
- CREATE TABLE addresses (
- id serial NOT NULL ,
- employee_id integer ,
- name varchar DEFAULT 'Frank' ,
- phone varchar ,
- street varchar ,
- PRIMARY KEY (id)
- ) ;
- };
-}
-
1;
our @supported_drivers = qw(
SQLite
- Informix
mysql
- mysqlPP
- ODBC
- Oracle
Pg
- Sybase
);
=head2 @available_drivers
$method = '' unless UNIVERSAL::can( $class, $method );
return $method;
} else {
- my $ver = $driver->database_version;
- return has_schema( $class, handle_to_driver( $driver ) ) unless $ver;
-
- my $method = 'schema_'. lc handle_to_driver( $driver );
- $ver =~ s/-.*$//;
- my @nums = grep $_, map { int($_) } split /\./, $ver;
- while( @nums ) {
- my $m = $method ."_". join '_', @nums;
- return $m if( UNIVERSAL::can( $class, $m ) );
- pop @nums;
- }
return has_schema( $class, handle_to_driver( $driver ) );
}
}
projects / dbsrgits/DBIx-Class-Historic.git / commitdiff