[Rt-commit] [svn] r1628 - in
DBIx-SearchBuilder/branches/1.20-SYBASE: . SearchBuilder
SearchBuilder/Handle SearchBuilder/Record
jesse at pallas.eruditorum.org
jesse at pallas.eruditorum.org
Mon Oct 4 16:09:42 EDT 2004
Author: jesse
Date: Mon Oct 4 16:09:41 2004
New Revision: 1628
Modified:
DBIx-SearchBuilder/branches/1.20-SYBASE/ (props changed)
DBIx-SearchBuilder/branches/1.20-SYBASE/Changes
DBIx-SearchBuilder/branches/1.20-SYBASE/META.yml
DBIx-SearchBuilder/branches/1.20-SYBASE/Makefile.PL
DBIx-SearchBuilder/branches/1.20-SYBASE/SIGNATURE
DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder.pm
DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Handle.pm
DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Handle/Oracle.pm
DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Handle/Sybase.pm
DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Record.pm
DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Record/Cachable.pm
DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Union.pm
Log:
r10393 at tinbook: jesse | 2004-09-27T22:21:23.342987Z
Modified: DBIx-SearchBuilder/branches/1.20-SYBASE/Changes
==============================================================================
--- DBIx-SearchBuilder/branches/1.20-SYBASE/Changes (original)
+++ DBIx-SearchBuilder/branches/1.20-SYBASE/Changes Mon Oct 4 16:09:41 2004
@@ -1,5 +1,48 @@
Revision history for Perl extension DBIx::SearchBuilder.
+1.11
+
+ - When loading an object whose "id" has been altered, as in the case of RT's "Merge" functionality, the wrong object was returned by the caching layer. Special casing for the "id" method was removed.
+
+
+1.10
+
+ - Identical to 1.10_05
+
+
+1.10_05
+
+ - Reworked the _Accessible mechanism in DBIx::SearchBuilder::Record to
+ remove a horribly crufty old caching mechanism that created a copy
+ of the accessible hash for each and every object instantiated,
+ sometimes quite slowly.
+
+
+1.10_04 Mon Aug 30 17:33:18 EDT 2004
+
+
+A query builder fix for an issue that bit RT2:
+
+ Unsatisfied dependency chain in Joins Users_2 at /usr/local/share/perl/5.8.3/DBIx/SearchBuilder/Handle.pm line 965, line 69.
+
+Stack:
+ [/usr/local/share/perl/5.8.3/DBIx/SearchBuilder/Handle.pm:965]
+ [/usr/local/share/perl/5.8.3/DBIx/SearchBuilder.pm:326]
+ [/usr/local/share/perl/5.8.3/DBIx/SearchBuilder.pm:119]
+ [/usr/local/share/perl/5.8.3/DBIx/SearchBuilder.pm:410]
+
+
+1.10_03 Mon Aug 30 14:31:10 EDT 2004
+ - Cache Sanity fixes from Autrijus Tang <autrijus at autrijus.org>
+
+1.10_02 Thu Aug 26 13:31:13 EDT 2004
+
+1.10_01 Thu Aug 26 00:08:31 EDT 2004
+ - Reimplemented DBIx::SearchBuilder:::Record::Cachable
+ to use Cache::Simple::TimedExpiry. This should make it faster and more
+ memory efficient.
+
+
1.02_03 Thu Jul 22 13:29:17 EDT 2004
- Additional bullet proofing for joins.
Now we default to ALIAS1 being "main" (cubic at acronis.ru)
Modified: DBIx-SearchBuilder/branches/1.20-SYBASE/META.yml
==============================================================================
--- DBIx-SearchBuilder/branches/1.20-SYBASE/META.yml (original)
+++ DBIx-SearchBuilder/branches/1.20-SYBASE/META.yml Mon Oct 4 16:09:41 2004
@@ -1,5 +1,5 @@
name: DBIx-SearchBuilder
-version: 1.02_03
+version: 1.11
license: perl
distribution_type: module
build_requires:
@@ -8,7 +8,8 @@
DBI: 0
Want: 0
Class::ReturnValue: 0.4
+ Cache::Simple::TimedExpiry: 0.21
no_index:
directory:
- inc
-generated_by: Module::Install version 0.33
+generated_by: Module::Install version 0.35
Modified: DBIx-SearchBuilder/branches/1.20-SYBASE/Makefile.PL
==============================================================================
--- DBIx-SearchBuilder/branches/1.20-SYBASE/Makefile.PL (original)
+++ DBIx-SearchBuilder/branches/1.20-SYBASE/Makefile.PL Mon Oct 4 16:09:41 2004
@@ -6,6 +6,7 @@
requires('DBI');
requires('Want');
requires('Class::ReturnValue', 0.40);
+requires( 'Cache::Simple::TimedExpiry' => '0.21');
build_requires('Test::More');
&Makefile->write;
Modified: DBIx-SearchBuilder/branches/1.20-SYBASE/SIGNATURE
==============================================================================
--- DBIx-SearchBuilder/branches/1.20-SYBASE/SIGNATURE (original)
+++ DBIx-SearchBuilder/branches/1.20-SYBASE/SIGNATURE Mon Oct 4 16:09:41 2004
@@ -14,34 +14,34 @@
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1
-SHA1 9da6c6139918509986fedfb682c12fa58d5402c0 Changes
+SHA1 dcdabc116a16a44638a8abbba525f38cdccd9b1b Changes
SHA1 f5a02a65c7d73ceb666d3351cdede865555f5fd4 MANIFEST
SHA1 8541c8988476422ee38fbc8714c1dd45b212f7fb MANIFEST.SKIP
-SHA1 e6d644431df07373c222b69116a34e4725f2a9aa META.yml
-SHA1 2948c70821e3394e345c1b5e5352abd01219680d Makefile.PL
-SHA1 e94392074706cf47bded7f821bf50cdb7e61512b SearchBuilder.pm
-SHA1 29733e243934bd59c8433b868554d37d36fe63c3 SearchBuilder/Handle.pm
+SHA1 79802b33f821283c641859c21d1605510b6e7964 META.yml
+SHA1 9921c69b0d05a54c5bb744a13cf1538bb06c4d82 Makefile.PL
+SHA1 c3b01e05d62949d2bb7f56023a815da80a4f4ff5 SearchBuilder.pm
+SHA1 943d4cd29b40706072b2f828d6caa30e30f28f57 SearchBuilder/Handle.pm
SHA1 68a6d7d744e5d123e3c8b59041d12253fcee5d04 SearchBuilder/Handle/Informix.pm
SHA1 35f764ab7e3c675ffc568f5bcb1ebf921813d801 SearchBuilder/Handle/ODBC.pm
SHA1 6f9abc7ece4b28988fa53f45ccafb7bc31454588 SearchBuilder/Handle/Oracle.pm
SHA1 18332427eebac78ea1e6bb8f6ba281f63f65bbf7 SearchBuilder/Handle/Pg.pm
SHA1 2d651d9a1b941be09a2b956a8d7475822da6b662 SearchBuilder/Handle/SQLite.pm
-SHA1 97af6fa4d25c34fa9ffd03c50463fa78d283b2d6 SearchBuilder/Handle/Sybase.pm
+SHA1 dc7f365069e7b7d01cbfc614b338a2b487c8c940 SearchBuilder/Handle/Sybase.pm
SHA1 cf4420e25ae28aa09fbf5e12643ff43f6a2d9241 SearchBuilder/Handle/mysql.pm
SHA1 e9716814b99c423b8e3f46c68a86363047b408fd SearchBuilder/Handle/mysqlPP.pm
-SHA1 001a5767027975ec925eff055b4b730e84aa06ad SearchBuilder/Record.pm
-SHA1 4be7e87f7a4679b36e3ac5e8b44180c52abc8925 SearchBuilder/Record/Cachable.pm
+SHA1 0c6007609af96ff2a2ccff9482e4f951aea68f9e SearchBuilder/Record.pm
+SHA1 ca8536396598df112d5f021cc63c5d8dde63e54a SearchBuilder/Record/Cachable.pm
SHA1 437511f27cc1319839143e560368fa1ceb4d697a SearchBuilder/Union.pm
-SHA1 90c19f4d1cef235e05176f2e89227351a4b65264 inc/Module/Install.pm
+SHA1 54200a94ac7a154d6913e5f5fac41994f5c962f0 inc/Module/Install.pm
SHA1 9d69487127cef5f79db775e9a3de93bb9d90cd71 inc/Module/Install/Base.pm
SHA1 28d2deeca781323948253499889536f28ea0d636 inc/Module/Install/Makefile.pm
SHA1 427c6d91969cbb8e014f3ffe70a63c65573f9d4f inc/Module/Install/Metadata.pm
-SHA1 9768f7bbbd233cb9f2924db07f2f3c3a421a1c4b t/00.load.t
+SHA1 c56b4e38f1bdf2c2c9b4bc415fe1437e11d18686 t/00.load.t
SHA1 e9c6a5881fc60173fbc8d479c1afd2ce3b43bef1 t/pod.t
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.2.4 (Darwin)
-iD8DBQFA//p7Ei9d9xCOQEYRAu79AJ993VqguZtkXTSXBcbe9psflYVk5wCgya9m
-yQmyiqYxWF3eYm1m2a6fDXQ=
-=lZ+h
+iD8DBQFBRfWaEi9d9xCOQEYRAlu+AJ90aYv/zz5rMSWhUvLuAGfP50RMaACgjP4v
+/zeoBrl+9Z20Sh7Meo+wkzE=
+=cUH/
-----END PGP SIGNATURE-----
Modified: DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder.pm
==============================================================================
--- DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder.pm (original)
+++ DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder.pm Mon Oct 4 16:09:41 2004
@@ -5,7 +5,7 @@
use strict;
use vars qw($VERSION);
-$VERSION = "1.02_03";
+$VERSION = "1.12_01";
=head1 NAME
@@ -44,10 +44,8 @@
sub _Init {
my $self = shift;
- my %args = (
- Handle => undef,
- @_
- );
+ my %args = ( Handle => undef,
+ @_ );
$self->{'DBIxHandle'} = $args{'Handle'};
$self->CleanSlate();
@@ -114,154 +112,64 @@
sub _DoSearch {
my $self = shift;
- my ( $QueryString, $Order );
-
- # The initial SELECT or SELECT DISTINCT is decided later
-
- $QueryString = $self->_BuildJoins . " ";
- $QueryString .= $self->_WhereClause . " "
- if ( $self->_isLimited > 0 );
-
- # DISTINCT query only required for multi-table selects
- if ( $self->_isJoined ) {
- $self->_DistinctQuery( \$QueryString, $self->{'table'} );
- }
- else {
- $QueryString = "SELECT main.* FROM $QueryString";
- }
-
- $QueryString .= $self->_OrderClause;
-
- $self->_ApplyLimits( \$QueryString );
- print STDERR "DBIx::SearchBuilder->DoSearch Query: $QueryString\n"
- if ( $self->DEBUG );
+ my $QueryString = $self->BuildSelectQuery();
- # {{{ get $self->{'records'} out of the database
- eval { $self->{'records'} = $self->_Handle->dbh->prepare($QueryString); };
- if ($@) {
- warn "$self couldn't prepare '$QueryString' " . $@;
- return (undef);
- }
-
- if ( !$self->{'records'} ) {
- warn "Error:" . $self->_Handle->dbh->errstr . "\n";
- return (undef);
- }
eval {
- if ( !$self->{'records'}->execute )
- {
- warn "DBIx::SearchBuilder error:"
- . $self->{'records'}->errstr
- . "\n\tQuery String is $QueryString\n";
- return (undef);
- }
- };
- if ($@) {
- warn "$self couldn't execute a search: " . $@;
- return (undef);
- }
-
- # }}}
-
- my $counter = 0;
- # {{{ Iterate through all the rows returned and get child objects
-
- while ( my $row = $self->{'records'}->fetchrow_hashref() ) {
-
- $self->{'items'}[$counter] = $self->NewItem();
- $self->{'items'}[$counter]->LoadFromHash($row);
-
- print STDERR "ID is " . $self->{'items'}[$counter]->Id() . "\n"
- if ( $self->DEBUG );
+ # TODO: finer-grained eval and cheking.
+ my $records = $self->_Handle->SimpleQuery($QueryString);
+ my $counter;
+ $self->{'rows'} = 0;
+ while ( my $row = $records->fetchrow_hashref() ) {
+ my $item = $self->NewItem();
+ $item->LoadFromHash($row);
+ $self->AddRecord($item);
+ }
- $counter++;
- }
+ $self->{'must_redo_search'} = 0;
+ };
- #How many rows did we get out of that?
- $self->{'rows'} = $counter;
+ return ( $self->{'rows'});
+}
- # TODO: It makes sense keeping and reusing the records statement
- # handler. Anyway, I don't see that we need it anymore with the
- # current design, and the statement handler will not easily be
- # stored persistantly.
+# }}}
- $self->{records}->finish;
- delete $self->{records};
+=head2 AddRecord RECORD
- # }}}
+ Adds a record object to this collection
- $self->{'must_redo_search'} = 0;
+=cut
- return ( $self->Count );
+sub AddRecord {
+ my $self = shift;
+ my $record = shift;
+ push @{$self->{'items'}}, $record;
+ $self->{'rows'}++;
}
-# }}}
# {{{ sub _DoCount
sub _DoCount {
my $self = shift;
my $all = shift || 0;
- my ( $QueryString, $Order );
-
- #TODO refactor DoSearch and DoCount such that we only have
- # one place where we build most of the querystring
- $QueryString .= $self->_BuildJoins . " ";
-
- $QueryString .= $self->_WhereClause . " "
- if ( $self->_isLimited > 0 );
-
- # DISTINCT query only required for multi-table selects
- if ( $self->_isJoined ) {
- $QueryString = $self->_Handle->DistinctCount( \$QueryString );
- }
- else {
- $QueryString = "SELECT count(main.id) FROM " . $QueryString;
- }
-
- print STDERR "DBIx::SearchBuilder->DoSearch Query: $QueryString\n"
- if ( $self->DEBUG );
-
- # {{{ get count out of the database
- eval { $self->{'records'} = $self->_Handle->dbh->prepare($QueryString); };
- if ($@) {
- warn "$self couldn't prepare '$QueryString' " . $@;
- return (undef);
- }
- if ( !$self->{'records'} ) {
- warn "Error:" . $self->_Handle->dbh->errstr . "\n";
- return (undef);
- }
+ my $QueryString = $self->BuildSelectCountQuery();
eval {
- if ( !$self->{'records'}->execute )
- {
- warn "DBIx::SearchBuilder error:"
- . $self->{'records'}->errstr
- . "\n\tQuery String is $QueryString\n";
- return (undef);
- }
- };
- if ($@) {
- warn "$self couldn't execute a search: " . $@;
- return (undef);
- }
-
- # }}}
-
- my @row = $self->{'records'}->fetchrow_array();
- $self->{ $all ? 'count_all' : 'raw_rows' } = $row[0];
+ # TODO: finer-grained Eval
+ my $records = $self->_Handle->SimpleQuery($QueryString);
- $self->{records}->finish;
- delete $self->{records};
+ my @row = $records->fetchrow_array();
+ $self->{ $all ? 'count_all' : 'raw_rows' } = $row[0];
- return ( $row[0] );
+ return ( $row[0] );
+ };
}
# }}}
+
=head2 _ApplyLimits STATEMENTREF
This routine takes a reference to a scalar containing an SQL statement.
@@ -271,18 +179,17 @@
=cut
+
sub _ApplyLimits {
my $self = shift;
my $statementref = shift;
- $self->_Handle->ApplyLimits( $statementref, $self->RowsPerPage,
- $self->FirstRow );
+ $self->_Handle->ApplyLimits($statementref, $self->RowsPerPage, $self->FirstRow);
$$statementref =~ s/main\.\*/join(', ', @{$self->{columns}})/eg
- if $self->{columns}
- and @{ $self->{columns} };
- if ( my $groupby = $self->_GroupClause ) {
- $$statementref =~ s/(LIMIT \d+)?$/$groupby $1/;
+ if $self->{columns} and @{$self->{columns}};
+ if (my $groupby = $self->_GroupClause) {
+ $$statementref =~ s/(LIMIT \d+)?$/$groupby $1/;
}
-
+
}
# {{{ sub _DistinctQuery
@@ -301,12 +208,11 @@
my $table = shift;
# XXX - Postgres gets unhappy with distinct and OrderBy aliases
- if ( $self->{order_clause} =~ /(?<!main)\./ ) {
- $self->DEBUG(1);
+ if ($self->{order_clause} =~ /(?<!main)\./) {
$$statementref = "SELECT main.* FROM $$statementref";
}
else {
- $self->_Handle->DistinctQuery( $statementref, $table );
+ $self->_Handle->DistinctQuery($statementref, $table)
}
}
@@ -320,6 +226,7 @@
=cut
+
sub _BuildJoins {
my $self = shift;
@@ -338,21 +245,23 @@
sub _isJoined {
my $self = shift;
- if ( keys( %{ $self->{'left_joins'} } ) ) {
- return (1);
- }
- else {
- return ( @{ $self->{'aliases'} } );
+ if (keys(%{$self->{'left_joins'}})) {
+ return(1);
+ } else {
+ return(@{$self->{'aliases'}});
}
}
# }}}
+
# {{{ sub _LimitClause
# LIMIT clauses are used for restricting ourselves to subsets of the search.
+
+
sub _LimitClause {
my $self = shift;
my $limit_clause;
@@ -387,6 +296,73 @@
# }}} Private utility methods
+# {{{ BuildSelectQuery
+
+=head2 BuildSelectQuery
+
+Builds a query string for a "SELECT rows from Tables" statement for this SB
+object
+
+=cut
+
+sub BuildSelectQuery {
+ my $self = shift;
+
+ # The initial SELECT or SELECT DISTINCT is decided later
+
+ my $QueryString = $self->_BuildJoins . " ";
+ $QueryString .= $self->_WhereClause . " "
+ if ( $self->_isLimited > 0 );
+
+ # DISTINCT query only required for multi-table selects
+ if ($self->_isJoined) {
+ $self->_DistinctQuery(\$QueryString, $self->{'table'});
+ } else {
+ $QueryString = "SELECT main.* FROM $QueryString";
+ }
+
+ $QueryString .= $self->_OrderClause;
+
+ $self->_ApplyLimits(\$QueryString);
+
+ return($QueryString)
+
+}
+
+# }}}
+
+# {{{ BuildSelectCountQuery
+
+=head2 BuildSelectCountQuery
+
+Builds a SELECT statement to find the number of rows this SB object would find.
+
+=cut
+
+sub BuildSelectCountQuery {
+ my $self = shift;
+
+ #TODO refactor DoSearch and DoCount such that we only have
+ # one place where we build most of the querystring
+ my $QueryString = $self->_BuildJoins . " ";
+
+ $QueryString .= $self->_WhereClause . " "
+ if ( $self->_isLimited > 0 );
+
+
+
+ # DISTINCT query only required for multi-table selects
+ if ($self->_isJoined) {
+ $QueryString = $self->_Handle->DistinctCount(\$QueryString);
+ } else {
+ $QueryString = "SELECT count(main.id) FROM " . $QueryString;
+ }
+
+ return ($QueryString);
+}
+
+# }}}
+
# {{{ Methods dealing traversing rows within the found set
# {{{ sub Next
@@ -439,6 +415,7 @@
# {{{ sub GotoItem
+
=head2 GotoItem
Takes an integer, n.
@@ -641,21 +618,31 @@
my $tmp = $self->_Handle->dbh->quote( $args{'VALUE'} );
# Accomodate DBI drivers that don't understand UTF8
- if ( $] >= 5.007 ) {
- require Encode;
- Encode::_utf8_on($tmp) if Encode::is_utf8( $args{'VALUE'} );
-
+ if ($] >= 5.007) {
+ require Encode;
+ if( Encode::is_utf8( $args{'VALUE'} ) ) {
+ Encode::_utf8_on( $tmp );
+ }
}
- $args{'VALUE'} = $tmp;
+ $args{'VALUE'} = $tmp;
}
}
$Alias = $self->_GenericRestriction(%args);
+ warn "No table alias set!"
+ unless $Alias;
+
# We're now limited. people can do searches.
+
$self->_isLimited(1);
+ if ( defined($Alias) ) {
return ($Alias);
+ }
+ else {
+ return (1);
+ }
}
# }}}
@@ -702,8 +689,7 @@
sub _GenericRestriction {
my $self = shift;
- my %args = (
- TABLE => $self->{'table'},
+ my %args = ( TABLE => $self->{'table'},
FIELD => undef,
VALUE => undef,
ALIAS => undef,
@@ -713,38 +699,62 @@
SUBCLAUSE => undef,
CASESENSITIVE => undef,
QUOTEVALUE => undef,
- @_
- );
+ @_ );
+
+ my ( $Clause, $QualifiedField );
+
+ #TODO: $args{'VALUE'} should take an array of values and generate
+ # the proper where clause.
#If we're performing a left join, we really want the alias to be the
#left join criterion.
if ( ( defined $args{'LEFTJOIN'} )
- && ( !defined $args{'ALIAS'} ) )
- {
+ && ( !defined $args{'ALIAS'} ) ) {
$args{'ALIAS'} = $args{'LEFTJOIN'};
}
+ # {{{ if there's no alias set, we need to set it
+
unless ( $args{'ALIAS'} ) {
#if the table we're looking at is the same as the main table
- # this code assumes no self joins on that table.
if ( $args{'TABLE'} eq $self->{'table'} ) {
+
+ # TODO this code assumes no self joins on that table.
+ # if someone can name a case where we'd want to do that,
+ # I'll change it.
+
$args{'ALIAS'} = 'main';
}
+
+ # {{{ if we're joining, we need to work out the table alias
+
else {
$args{'ALIAS'} = $self->NewAlias( $args{'TABLE'} );
}
+ # }}}
}
- my $QualifiedField = $args{'ALIAS'} . "." . $args{'FIELD'};
+ # }}}
- # If we've been handed a subclause, we want to use that,
- # otherwise, we put together one subclause per ALIAS/FIELD combo
- my $Clause = ( $args{'SUBCLAUSE'} || $QualifiedField );
+ # Set this to the name of the field and the alias, unless we've been
+ # handed a subclause name
- my $restriction;
+ $QualifiedField = $args{'ALIAS'} . "." . $args{'FIELD'};
+
+ if ( $args{'SUBCLAUSE'} ) {
+ $Clause = $args{'SUBCLAUSE'};
+ }
+ else {
+ $Clause = $QualifiedField;
+ }
+
+ print STDERR "$self->_GenericRestriction QualifiedField=$QualifiedField\n"
+ if ( $self->DEBUG );
+
+ my ($restriction);
# If we're trying to get a leftjoin restriction, lets set
# $restriction to point htere. otherwise, lets construct normally
@@ -759,12 +769,7 @@
# If it's a new value or we're overwriting this sort of restriction,
- if ( $self->_Handle->CaseSensitive
- && defined $args{'VALUE'}
- && $args{'VALUE'} ne ''
- && $args{'VALUE'} ne "''"
- && ( $args{'OPERATOR'} !~ /IS/ && $args{'VALUE'} !~ /^null$/i ) )
- {
+ if ( $self->_Handle->CaseSensitive && defined $args{'VALUE'} && $args{'VALUE'} ne '' && $args{'VALUE'} ne "''" && ($args{'OPERATOR'} !~/IS/ && $args{'VALUE'} !~ /^null$/i)) {
unless ( $args{'CASESENSITIVE'} || !$args{'QUOTEVALUE'} ) {
( $QualifiedField, $args{'OPERATOR'}, $args{'VALUE'} ) =
@@ -783,15 +788,13 @@
delete $self->{_open_parens}{$Clause};
}
- if (
- (
- defined $args{'ENTRYAGGREGATOR'}
- && $args{'ENTRYAGGREGATOR'} eq 'none'
- )
- || !$$restriction
- )
- {
+ if ( ( ( exists $args{'ENTRYAGGREGATOR'} )
+ and ( $args{'ENTRYAGGREGATOR'} || "" ) eq 'none' )
+ or ( !$$restriction )
+ ) {
+
$$restriction = $prefix . $clause;
+
}
else {
$$restriction .= $args{'ENTRYAGGREGATOR'} . $prefix . $clause;
@@ -841,15 +844,14 @@
my $self = shift;
my ( $subclause, $where_clause );
-#Go through all the generic restrictions and build up the "generic_restrictions" subclause
-# That's the only one that SearchBuilder builds itself.
-# Arguably, the abstraction should be better, but I don't really see where to put it.
+ #Go through all the generic restrictions and build up the "generic_restrictions" subclause
+ # That's the only one that SearchBuilder builds itself.
+ # Arguably, the abstraction should be better, but I don't really see where to put it.
$self->_CompileGenericRestrictions();
#Go through all restriction types. Build the where clause from the
#Various subclauses.
foreach $subclause ( keys %{ $self->{'subclauses'} } ) {
-
# Now, build up the where clause
if ( defined($where_clause) ) {
$where_clause .= " AND ";
@@ -910,7 +912,7 @@
sub OrderBy {
my $self = shift;
- my %args = (@_);
+ my %args = ( @_ );
$self->OrderByCols( \%args );
}
@@ -928,34 +930,31 @@
my $row;
my $clause;
- foreach $row (@args) {
+ foreach $row ( @args ) {
- my %rowhash = (
- ALIAS => 'main',
- FIELD => undef,
- ORDER => 'ASC',
- %$row
- );
- if ( $rowhash{'ORDER'} =~ /^des/i ) {
- $rowhash{'ORDER'} = "DESC";
+ my %rowhash = ( ALIAS => 'main',
+ FIELD => undef,
+ ORDER => 'ASC',
+ %$row
+ );
+ if ($rowhash{'ORDER'} =~ /^des/i) {
+ $rowhash{'ORDER'} = "DESC";
}
else {
- $rowhash{'ORDER'} = "ASC";
+ $rowhash{'ORDER'} = "ASC";
}
- if ( ( $rowhash{'ALIAS'} )
- and ( $rowhash{'FIELD'} )
- and ( $rowhash{'ORDER'} ) )
- {
-
- if ( $rowhash{'FIELD'} =~ /^(\w+\()(.*\))$/ ) {
-
- # handle 'FUNCTION(FIELD)' formatted fields
- $rowhash{'ALIAS'} = $1 . $rowhash{'ALIAS'};
- $rowhash{'FIELD'} = $2;
- }
+ if ( ($rowhash{'ALIAS'}) and
+ ($rowhash{'FIELD'}) and
+ ($rowhash{'ORDER'}) ) {
+
+ if ($rowhash{'FIELD'} =~ /^(\w+\()(.*\))$/) {
+ # handle 'FUNCTION(FIELD)' formatted fields
+ $rowhash{'ALIAS'} = $1 . $rowhash{'ALIAS'};
+ $rowhash{'FIELD'} = $2;
+ }
- $clause .= ( $clause ? ", " : " " );
+ $clause .= ($clause ? ", " : " ");
$clause .= $rowhash{'ALIAS'} . ".";
$clause .= $rowhash{'FIELD'} . " ";
$clause .= $rowhash{'ORDER'};
@@ -963,15 +962,15 @@
}
if ($clause) {
- $self->{'order_clause'} = "ORDER BY" . $clause;
+ $self->{'order_clause'} = "ORDER BY" . $clause;
}
else {
- $self->{'order_clause'} = "";
+ $self->{'order_clause'} = "";
}
$self->RedoSearch();
}
-# }}}
+# }}}
# {{{ sub _OrderClause
@@ -985,9 +984,86 @@
my $self = shift;
unless ( defined $self->{'order_clause'} ) {
- return "";
+ return "";
+ }
+ return ($self->{'order_clause'});
+}
+
+# }}}
+
+# }}}
+
+# {{{ Routines dealing with grouping
+
+# {{{ GroupBy (OBSOLETE)
+
+=head2 GroupBy
+
+OBSOLUTE. You want GroupByCols
+
+=cut
+
+sub GroupBy {
+ my $self = shift;
+ $self->GroupByCols( @_);
+}
+# }}}
+
+# {{{ GroupByCols
+
+=head2 GroupByCols ARRAY_OF_HASHES
+
+Each hash contains the keys ALIAS and FIELD. ALIAS defaults to 'main' if ignored.
+
+=cut
+
+sub GroupByCols {
+ my $self = shift;
+ my @args = @_;
+ my $row;
+ my $clause;
+
+ foreach $row ( @args ) {
+ my %rowhash = ( ALIAS => 'main',
+ FIELD => undef,
+ %$row
+ );
+
+ if ( ($rowhash{'ALIAS'}) and
+ ($rowhash{'FIELD'}) ) {
+
+ $clause .= ($clause ? ", " : " ");
+ $clause .= $rowhash{'ALIAS'} . ".";
+ $clause .= $rowhash{'FIELD'};
+ }
+ }
+
+ if ($clause) {
+ $self->{'group_clause'} = "GROUP BY" . $clause;
+ }
+ else {
+ $self->{'group_clause'} = "";
+ }
+ $self->RedoSearch();
+}
+# }}}
+
+# {{{ _GroupClause
+
+=head2 _GroupClause
+
+Private function to return the "GROUP BY" clause for this query.
+
+
+=cut
+
+sub _GroupClause {
+ my $self = shift;
+
+ unless ( defined $self->{'group_clause'} ) {
+ return "";
}
- return ( $self->{'order_clause'} );
+ return ($self->{'group_clause'});
}
# }}}
@@ -1014,7 +1090,7 @@
my $subclause = "$table $alias";
- push( @{ $self->{'aliases'} }, $subclause );
+ push ( @{ $self->{'aliases'} }, $subclause );
return $alias;
}
@@ -1127,8 +1203,7 @@
if ( $self->RowsPerPage ) {
$self->FirstRow( 1 + ( $self->RowsPerPage * $page ) );
- }
- else {
+ } else {
$self->FirstRow(1);
}
}
@@ -1209,11 +1284,14 @@
=cut
+
+
sub Count {
my $self = shift;
- # An unlimited search returns no tickets
- return 0 unless ( $self->_isLimited );
+ # An unlimited search returns no tickets
+ return 0 unless ($self->_isLimited);
+
# If we haven't actually got all objects loaded in memory, we
# really just want to do a quick count from the database.
@@ -1244,16 +1322,37 @@
=cut
+# 22:24 [Robrt(500 at outer.space)] It has to do with Caching.
+# 22:25 [Robrt(500 at outer.space)] The documentation says it ignores the limit.
+# 22:25 [Robrt(500 at outer.space)] But I don't believe thats true.
+# 22:26 [msg(Robrt)] yeah. I
+# 22:26 [msg(Robrt)] yeah. I'm not convinced it does anything useful right now
+# 22:26 [msg(Robrt)] especially since until a week ago, it was setting one variable and returning another
+# 22:27 [Robrt(500 at outer.space)] I remember.
+# 22:27 [Robrt(500 at outer.space)] It had to do with which Cached value was returned.
+# 22:27 [msg(Robrt)] (given that every time we try to explain it, we get it Wrong)
+# 22:27 [Robrt(500 at outer.space)] Because Count can return a different number than actual NumberOfResults
+# 22:28 [msg(Robrt)] in what case?
+# 22:28 [Robrt(500 at outer.space)] CountAll _always_ used the return value of _DoCount(), as opposed to Count which would return the cached number of
+# results returned.
+# 22:28 [Robrt(500 at outer.space)] IIRC, if you do a search with a Limit, then raw_rows will == Limit.
+# 22:31 [msg(Robrt)] ah.
+# 22:31 [msg(Robrt)] that actually makes sense
+# 22:31 [Robrt(500 at outer.space)] You should paste this conversation into the CountAll docs.
+# 22:31 [msg(Robrt)] perhaps I'll create a new method that _actually_ do that.
+# 22:32 [msg(Robrt)] since I'm not convinced it's been doing that correctly
+
+
+
sub CountAll {
my $self = shift;
- # An unlimited search returns no tickets
- return 0 unless ( $self->_isLimited );
+ # An unlimited search returns no tickets
+ return 0 unless ($self->_isLimited);
# If we haven't actually got all objects loaded in memory, we
# really just want to do a quick count from the database.
- if ( $self->{'must_redo_search'} || !$self->{'count_all'} ) {
-
+ if ( $self->{'must_redo_search'} || !$self->{'count_all'}) {
# If we haven't already asked the database for the row count, do that
$self->_DoCount(1) unless ( $self->{'count_all'} );
@@ -1270,6 +1369,7 @@
# }}}
+
# {{{ sub IsLast
=head2 IsLast
@@ -1303,24 +1403,40 @@
# }}}
+
+
+
# }}}
-sub Column {
- my ( $self, %args ) = @_;
- my $table;
+# {{{ Column
- if ( $args{TABLE} ) {
- $table = $args{TABLE};
- }
- elsif ( $args{ALIAS} =~ /^(.*?)_\d+$/ ) {
+=head2 Column { FIELD => undef }
- # this code relies on the fact that RT generates table aliases
- # of the form TableName_Number to create table aliases.
- $table = $1;
- }
- else {
- $table = $self->{table};
- }
+Specify that we want to load the column FIELD.
+
+Other parameters are TABLE ALIAS AND FUNCTION.
+
+Autrijus and Ruslan owe docs.
+
+=cut
+
+sub Column {
+ my $self = shift;
+ my %args = ( TABLE => undef,
+ ALIAS => undef,
+ FIELD => undef,
+ FUNCTION => undef,
+ @_);
+
+ my $table = $args{TABLE} || do {
+ if ( my $alias = $args{ALIAS} ) {
+ $alias =~ s/_\d+$//;
+ $alias;
+ }
+ else {
+ $self->{table};
+ }
+ };
my $name = ( $args{ALIAS} || 'main' ) . '.' . $args{FIELD};
if ( my $func = $args{FUNCTION} ) {
@@ -1338,15 +1454,42 @@
return $column;
}
+# }}}
+
+# {{{ Columns
+
+
+=head2 Columns LIST
+
+Specify that we want to load only the columns in LIST
+
+=cut
+
sub Columns {
my $self = shift;
$self->Column( FIELD => $_ ) for @_;
}
+# }}}
+
+# {{{ Fields
+
+=head2 Fields TABLE
+
+Return a list of fields in TABLE, lowercased.
+
+TODO: Why are they lowercased?
+
+=cut
+
sub Fields {
- my ( $self, $table ) = @_;
+ my $self = shift;
+ my $table = shift;
+
my $dbh = $self->_Handle->dbh;
+ # TODO: memoize this
+
return map lc( $_->[0] ), @{
eval {
$dbh->column_info( '', '', $table, '' )->fetchall_arrayref( [3] );
@@ -1354,71 +1497,59 @@
|| $dbh->selectall_arrayref("DESCRIBE $table;")
|| $dbh->selectall_arrayref("DESCRIBE \u$table;")
|| []
- };
+ };
}
+# }}}
+
+
+# {{{ HasField
+
+=head2 HasField { TABLE => undef, FIELD => undef }
+
+Returns true if TABLE has field FIELD.
+Return false otherwise
+
+=cut
+
sub HasField {
- my ( $self, %args ) = @_;
+ my $self = shift;
+ my %args = ( FIELD => undef,
+ TABLE => undef,
+ @_);
+
my $table = $args{TABLE} or die;
my $field = $args{FIELD} or die;
return grep { $_ eq $field } $self->Fields($table);
}
-sub SetTable {
- my $self = shift;
- $self->{table} = shift;
- return $self->{table};
-}
+# }}}
-sub Table { $_[0]->{table} }
+# {{{ SetTable
-sub GroupBy {
- my $self = shift;
- my %args = (@_);
- $self->GroupByCols( \%args );
-}
+=head2 Table [TABLE]
-sub GroupByCols {
- my $self = shift;
- my @args = @_;
- my $row;
- my $clause;
+If called with an arguemnt, sets this collection's table.
- foreach $row (@args) {
- my %rowhash = (
- ALIAS => 'main',
- FIELD => undef,
- %$row
- );
-
- if ( ( $rowhash{'ALIAS'} )
- and ( $rowhash{'FIELD'} ) )
- {
+Always returns this collection's table.
- $clause .= ( $clause ? ", " : " " );
- $clause .= $rowhash{'ALIAS'} . ".";
- $clause .= $rowhash{'FIELD'};
- }
- }
+=cut
- if ($clause) {
- $self->{'group_clause'} = "GROUP BY" . $clause;
- }
- else {
- $self->{'group_clause'} = "";
- }
- $self->RedoSearch();
+sub SetTable {
+ my $self = shift;
+ return $self->Table(@_);
}
-sub _GroupClause {
+sub Table {
my $self = shift;
-
- unless ( defined $self->{'group_clause'} ) {
- return "";
- }
- return ( $self->{'group_clause'} );
+ $self->{table} = shift if (@_);
+ return $self->{table};
}
+
+# }}}
+
+
1;
__END__
Modified: DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Handle.pm
==============================================================================
--- DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Handle.pm (original)
+++ DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Handle.pm Mon Oct 4 16:09:41 2004
@@ -6,6 +6,7 @@
use Class::ReturnValue;
use vars qw($VERSION @ISA %DBIHandle $PrevHandle $DEBUG $TRANSDEPTH);
+
$TRANSDEPTH = 0;
$VERSION = '$Version$';
@@ -57,6 +58,8 @@
my $class = ref($proto) || $proto;
my $self = {};
bless ($self, $class);
+
+ @{$self->{'StatementLog'}} = ();
return $self;
}
@@ -76,14 +79,14 @@
# my %seen; #only the *first* value is used - allows drivers to specify default
while ( my $key = shift @pairs ) {
my $value = shift @pairs;
- #$value = $self->dbh->quote($value) unless ( $value =~ /^\d+$/);
# next if $seen{$key}++;
push @cols, $key;
push @vals, '?';
- push @bind, $value;
+ push @bind, $value;
}
- my $QueryString = "INSERT INTO $table (". join(", ", @cols). ") VALUES ".
+ my $QueryString =
+ "INSERT INTO $table (". join(", ", @cols). ") VALUES ".
"(". join(", ", @vals). ")";
my $sth = $self->SimpleQuery($QueryString, @bind);
@@ -151,7 +154,7 @@
Takes a bunch of parameters:
Required: Driver, Database,
-Optional: Server Host, Port and RequireSSL
+Optional: Host, Port and RequireSSL
Builds a DSN suitable for a DBI connection
@@ -159,29 +162,22 @@
sub BuildDSN {
my $self = shift;
- my %args = (
- Driver => undef,
- Database => undef,
- Host => undef,
- Port => undef,
- SID => undef,
- Server => undef,
- RequireSSL => undef,
- @_
- );
-
- my $dsn = "dbi:$args{'Driver'}:";
- $dsn .= "dbname=$args{'Database'};"
- if ( defined $args{'Database'} && $args{'Database'} );
- $dsn .= "sid=$args{'SID'};" if ( defined $args{'SID'} && $args{'SID'} );
- $dsn .= "host=$args{'Host'};" if ( defined $args{'Host'} && $args{'Host'} );
- $dsn .= "port=$args{'Port'};" if ( defined $args{'Port'} && $args{'Port'} );
- $dsn .= "requiressl=1;"
- if ( defined $args{'RequireSSL'} && $args{'RequireSSL'} );
- $dsn .= "server=$args{'Server'};"
- if ( defined $args{'Server'} && $args{'Server'} );
+ my %args = ( Driver => undef,
+ Database => undef,
+ Host => undef,
+ Port => undef,
+ SID => undef,
+ RequireSSL => undef,
+ @_);
+
+
+ my $dsn = "dbi:$args{'Driver'}:dbname=$args{'Database'}";
+ $dsn .= ";sid=$args{'SID'}" if ( defined $args{'SID'} && $args{'SID'});
+ $dsn .= ";host=$args{'Host'}" if (defined$args{'Host'} && $args{'Host'});
+ $dsn .= ";port=$args{'Port'}" if (defined $args{'Port'} && $args{'Port'});
+ $dsn .= ";requiressl=1" if (defined $args{'RequireSSL'} && $args{'RequireSSL'});
- $self->{'dsn'} = $dsn;
+ $self->{'dsn'}= $dsn;
}
# }}}
@@ -240,6 +236,67 @@
# }}}
+=head2 LogSQLStatements BOOL
+
+Takes a boolean argument. If the boolean is true, SearchBuilder will log all SQL
+statements, as well as their invocation times and execution times.
+
+Returns whether we're currently logging or not as a boolean
+
+=cut
+
+sub LogSQLStatements {
+ my $self = shift;
+ if (@_) {
+
+ require Time::HiRes;
+ $self->{'_DoLogSQL'} = shift;
+ return ($self->{'_DoLogSQL'});
+ }
+}
+
+=head2 _LogSQLStatement STATEMENT DURATION
+
+add an SQL statement to our query log
+
+=cut
+
+sub _LogSQLStatement {
+ my $self = shift;
+ my $statement = shift;
+ my $duration = shift;
+ push @{$self->{'StatementLog'}} , ([Time::Hires::time(), $statement, $duration]);
+
+}
+
+=head2 ClearSQLStatementLog
+
+Clears out the SQL statement log.
+
+
+=cut
+
+sub ClearSQLStatementLog {
+ my $self = shift;
+ @{$self->{'StatementLog'}} = ();
+}
+
+
+=head2 SQLStatementLog
+
+Returns the current SQL statement log as an array of arrays. Each entry is a triple of
+
+(Time, Statement, Duration)
+
+=cut
+
+sub SQLStatementLog {
+ my $self = shift;
+ return (@{$self->{'StatementLog'}});
+
+}
+
+
# {{{ AutoCommit
=head2 AutoCommit [MODE]
@@ -317,35 +374,35 @@
sub UpdateRecordValue {
my $self = shift;
- my %args = (
- Table => undef,
- Column => undef,
- IsSQLFunction => undef,
- PrimaryKeys => undef,
- @_
- );
+ my %args = ( Table => undef,
+ Column => undef,
+ IsSQLFunction => undef,
+ PrimaryKeys => undef,
+ @_ );
my @bind = ();
- my $query = 'UPDATE ' . $args{'Table'} . ' SET ' . $args{'Column'} . ' = ';
-
- ## Look and see if the field is being updated via a SQL function.
- if ( $args{'IsSQLFunction'} ) {
- $query .= $args{'Value'} . ' ';
- }
- else {
- $query .= " ? " ;
- push @bind, $args{'Value'};
- }
+ my $query = 'UPDATE ' . $args{'Table'} . ' ';
+ $query .= 'SET ' . $args{'Column'} . '=';
- ## Constructs the where clause.
- my @cols;
- foreach my $key ( keys %{ $args{'PrimaryKeys'} } ) {
- push @cols, "$key = ? ";
- push @bind, { value => $args{PrimaryKeys}{$key}, is_numeric => 1 };
- }
+ ## Look and see if the field is being updated via a SQL function.
+ if ($args{'IsSQLFunction'}) {
+ $query .= $args{'Value'} . ' ';
+ }
+ else {
+ $query .= '? ';
+ push (@bind, $args{'Value'});
+ }
- $query .= "WHERE " . join( ' AND ', @cols );
- return ( $self->SimpleQuery( $query, @bind ) );
+ ## Constructs the where clause.
+ my $where = 'WHERE ';
+ foreach my $key (keys %{$args{'PrimaryKeys'}}) {
+ $where .= $key . "=?" . " AND ";
+ push (@bind, $args{'PrimaryKeys'}{$key});
+ }
+ $where =~ s/AND\s$//;
+
+ my $query_str = $query . $where;
+ return ($self->SimpleQuery($query_str, @bind));
}
@@ -381,100 +438,75 @@
=cut
-sub SimpleQuery {
- my $self = shift;
+sub SimpleQuery {
+ my $self = shift;
my $QueryString = shift;
my @bind_values = (@_);
- ($QueryString, @bind_values) = $self->EmulatePlaceholders($QueryString, @bind_values) if ($QueryString =~ /^\s*(?:INSERT|UPDATE)/i);
- use Data::Dumper;
my $sth = $self->dbh->prepare($QueryString);
unless ($sth) {
- Carp::cluck;
- warn "$self couldn't prepare the query '$QueryString'"
- . $self->dbh->errstr . "\n";
- my $rv = Class::ReturnValue->new();
- $rv->as_error(
- errno => '-1',
- message => "Couldn't prepare the query '$QueryString'."
- . $self->dbh->errstr,
- do_backtrace => undef
- );
- return $rv->return_value;
- }
-
-
- # Check @bind_values for HASH refs
- for ( my $bind_idx = 0 ; $bind_idx < scalar @bind_values ; $bind_idx++ ) {
- if ( ref( $bind_values[$bind_idx] ) eq "HASH" ) {
+ if ($DEBUG) {
+ die "$self couldn't prepare the query '$QueryString'" .
+ $self->dbh->errstr . "\n";
+ }
+ else {
+ warn "$self couldn't prepare the query '$QueryString'" .
+ $self->dbh->errstr . "\n";
+ my $ret = Class::ReturnValue->new();
+ $ret->as_error( errno => '-1',
+ message => "Couldn't prepare the query '$QueryString'.". $self->dbh->errstr,
+ do_backtrace => undef);
+ return ($ret->return_value);
+ }
+ }
+
+ # Check @bind_values for HASH refs
+ for (my $bind_idx = 0; $bind_idx < scalar @bind_values; $bind_idx++) {
+ if (ref($bind_values[$bind_idx]) eq "HASH") {
my $bhash = $bind_values[$bind_idx];
$bind_values[$bind_idx] = $bhash->{'value'};
delete $bhash->{'value'};
- if ($bhash->{sql_type}) {
- $sth->bind_param( $bind_idx + 1, undef, $bhash->{sql_type} );
- } else {
- $sth->bind_param( $bind_idx + 1, undef, $bhash );
-
- }
+ $sth->bind_param($bind_idx+1, undef, $bhash );
}
}
- unless ( $sth->execute(@bind_values) ) {
- Carp::cluck("Failed on $QueryString");
- warn "$self couldn't execute the query '$QueryString'";
-
- my $rv = Class::ReturnValue->new();
- $rv->as_error(
- errno => '-1',
- message => "Couldn't execute the query '$QueryString'"
- . $self->dbh->errstr,
- do_backtrace => undef
- );
- return $rv->return_value;
- }
- return ($sth);
+ my $basetime;
+ if ($self->LogSQLStatements) {
+ $basetime = Time::HiRes::time();
+ }
-}
+ my $executed =$sth->execute(@bind_values);
-# }}}
+ if ($self->LogSQLStatements) {
+ $self->_LogSQLStatement($QueryString ,tv_interval ( $basetime ));
+
+ }
-sub EmulatePlaceholders {
- use Data::Dumper;
- my $self = shift;
- my $QueryString = shift;
- my @bind_values = (@_);
+ unless($executed ) {
+ if ($DEBUG) {
+ die "$self couldn't execute the query '$QueryString'"
+ . $self->dbh->errstr . "\n";
-
- # Replace, starting from the back of the string, so we don't
- # confuse some chunk of a value with a placeholder
- my $new_query = "";
- my @query_chunks = split( /\s*\?\s*/, $QueryString );
- foreach my $chunk ( @query_chunks ) {
- my $value;
- $new_query .= $chunk;
- if (exists $bind_values[0]) {
- my $bind_value = shift @bind_values;
- if (ref $bind_value && $bind_value->{is_numeric}) {
- $value = $bind_value->{value};
- }
- elsif (ref $bind_value && $bind_value->{is_blob}) {
- # Sybase tries to quote blobs with 0x, which doesn't work so
- # well for inline blobs ;)
- $value = $self->dbh->quote($bind_value->{'value'});
- }
- elsif ( ref $bind_value) {
- $value = $self->dbh->quote( $bind_value->{value},
- $bind_value->{sql_type} );
}
else {
- $value = $self->dbh->quote($bind_value);
+ warn "$self couldn't execute the query '$QueryString'";
+
+ my $ret = Class::ReturnValue->new();
+ $ret->as_error(
+ errno => '-1',
+ message => "Couldn't execute the query '$QueryString'"
+ . $self->dbh->errstr,
+ do_backtrace => undef );
+ return ($ret->return_value);
}
- $new_query .= " $value ";
- }
+
}
- return ($new_query);
+ return ($sth);
+
+
+ }
-}
+# }}}
# {{{ sub FetchResult
@@ -826,10 +858,7 @@
}
- unless ($alias) {
- return ( $self->_NormalJoin(%args) );
- }
- if ( $args{'ALIAS1'} ) {
+ if ( !$alias || $args{'ALIAS1'} ) {
return ( $self->_NormalJoin(%args) );
}
@@ -910,8 +939,16 @@
$seen_aliases{'main'} = 1;
+ # We don't want to get tripped up on a dependency on a simple alias.
+ foreach my $alias ( @{ $sb->{'aliases'}} ) {
+ if ( $alias =~ /^(.*?)\s+(.*?)$/ ) {
+ $seen_aliases{$2} = 1;
+ }
+ }
+
my $join_clause = $sb->{'table'} . " main ";
+
my @keys = ( keys %{ $sb->{'left_joins'} } );
my %seen;
Modified: DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Handle/Oracle.pm
==============================================================================
--- DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Handle/Oracle.pm (original)
+++ DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Handle/Oracle.pm Mon Oct 4 16:09:41 2004
@@ -1,11 +1,12 @@
-use strict;
+# $Header: /home/jesse/DBIx-SearchBuilder/history/SearchBuilder/Handle/Oracle.pm,v 1.14 2002/01/28 06:11:37 jesse Exp $
package DBIx::SearchBuilder::Handle::Oracle;
use DBIx::SearchBuilder::Handle;
-use base qw(DBIx::SearchBuilder::Handle);
+ at ISA = qw(DBIx::SearchBuilder::Handle);
-use vars qw($VERSION $DBIHandle $DEBUG);
+use vars qw($VERSION @ISA $DBIHandle $DEBUG);
+use strict;
=head1 NAME
@@ -27,6 +28,14 @@
=cut
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = {};
+ bless ($self, $class);
+ return ($self);
+}
+
# {{{ sub Connect
@@ -56,7 +65,7 @@
$self->SimpleQuery("ALTER SESSION set NLS_DATE_FORMAT = 'YYYY-MM-DD HH24:MI:SS'");
- return ($self->dbh);
+ return ($DBIHandle);
}
# }}}
Modified: DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Handle/Sybase.pm
==============================================================================
--- DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Handle/Sybase.pm (original)
+++ DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Handle/Sybase.pm Mon Oct 4 16:09:41 2004
@@ -1,10 +1,11 @@
-use strict;
+# $Header: /home/jesse/DBIx-SearchBuilder/history/SearchBuilder/Handle/Sybase.pm,v 1.8 2001/10/12 05:27:05 jesse Exp $
package DBIx::SearchBuilder::Handle::Sybase;
use DBIx::SearchBuilder::Handle;
-use base qw(DBIx::SearchBuilder::Handle);
+ at ISA = qw(DBIx::SearchBuilder::Handle);
-use vars qw($VERSION $DEBUG);
+use vars qw($VERSION @ISA $DBIHandle $DEBUG);
+use strict;
=head1 NAME
@@ -25,42 +26,6 @@
=cut
-
-
-# {{{ sub Connect
-
-=head2 Connect PARAMHASH: Driver, Database, Host, User, Password
-
-Takes a paramhash and connects to your DBI datasource.
-
-
-=cut
-
-sub Connect {
- my $self = shift;
-
- my %args = ( Driver => undef,
- Database => undef,
- User => undef,
- Password => undef,
- SID => undef,
- Host => undef,
- @_);
-
- $self->SUPER::Connect(%args);
-
- # Will return dates in the format
- # Nov 15 1998 11:30:11:496AM
- # It'd be really nice if sybase supported ISO dates.
- $self->dbh->func('LONG', '_date_fmt');
-
-
-
- return ($self->dbh);
-}
-# }}}
-
-
# {{{ sub Insert
=head2 Insert
@@ -102,7 +67,20 @@
# }}}
+=head2 DatabaseVersion
+
+return the database version, trimming off any -foo identifier
+=cut
+
+sub DatabaseVersion {
+ my $self = shift;
+ my $v = $self->SUPER::DatabaseVersion();
+
+ $v =~ s/\-(.*)$//;
+ return ($v);
+
+}
=head2 CaseSensitive
@@ -128,9 +106,8 @@
}
-=head2 DistinctQuery STATEMENTREF
+=head2 DistinctQuery STATEMENTREFtakes an incomplete SQL SELECT statement and massages it to return a DISTINCT result set.
-takes an incomplete SQL SELECT statement and massages it to return a DISTINCT result set.
=cut
@@ -159,5 +136,7 @@
return(undef);
}
+# }}}
+
+# }}}
-1;
Modified: DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Record.pm
==============================================================================
--- DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Record.pm (original)
+++ DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Record.pm Mon Oct 4 16:09:41 2004
@@ -2,12 +2,13 @@
package DBIx::SearchBuilder::Record;
use strict;
-use vars qw($VERSION @ISA $AUTOLOAD);
-use Class::ReturnValue;
+use warnings;
+use vars qw($AUTOLOAD);
+use Class::ReturnValue;
-$VERSION = '$VERSION$';
+# {{{ Doc
=head1 NAME
@@ -15,91 +16,80 @@
=head1 SYNOPSIS
- module MyRecord;
- use DBIx::SearchBuilder::Record;
- @ISA = (DBIx::SearchBuilder::Record);
-
+module MyRecord;
+use base qw/DBIx::SearchBuilder::Record/;
- sub _Init {
- my $self = shift;
- my $DBIxHandle = shift; # A DBIx::SearchBuilder::Handle::foo object for your database
+sub _Init {
+ my $self = shift;
+ my $DBIxHandle =
+ shift; # A DBIx::SearchBuilder::Handle::foo object for your database
- $self->_Handle($DBIxHandle);
- $self->Table("Users");
- }
-
+ $self->_Handle($DBIxHandle);
+ $self->Table("Users");
+}
- # Tell Record what the primary keys are
- sub _PrimaryKeys {
- my $self = shift;
- return['id'];
- }
+# Tell Record what the primary keys are
+sub _PrimaryKeys {
+ my $self = shift;
+ return ['id'];
+}
-
- #Preferred and most efficient way to specify fields attributes in a derived
- #class, used by the autoloader to construct Attrib and SetAttrib methods.
+#Preferred and most efficient way to specify fields attributes in a derived
+#class, used by the autoloader to construct Attrib and SetAttrib methods.
- # read: calling $Object->Foo will return the value of this record's Foo column # write: calling $Object->SetFoo with a single value will set Foo's value in
- # both the loaded object and the database
+# read: calling $Object->Foo will return the value of this record's Foo column # write: calling $Object->SetFoo with a single value will set Foo's value in
+# both the loaded object and the database
- sub _ClassAccessible {
- {
- Tofu => { 'read'=>1, 'write'=>1 },
- Maz => { 'auto'=>1, },
- Roo => { 'read'=>1, 'auto'=>1, 'public'=>1, },
+sub _ClassAccessible {
+ {
+ Tofu => { 'read' => 1, 'write' => 1 },
+ Maz => { 'auto' => 1, },
+ Roo => { 'read' => 1, 'auto' => 1, 'public' => 1, },
};
- }
+}
- # specifying an _Accessible subroutine in a derived class is depriciated.
- # only '/' and ',' delimiters work, not full regexes
-
- sub _Accessible {
- my $self = shift;
- my %Cols = (
- id => 'read', # id is an immutable primary key
- Username => 'read/write', #read/write.
- Password => 'write', # password. write only. see sub IsPassword
- Created => 'read' # A created date. read-only
- );
- return $self->SUPER::_Accessible(@_, %Cols);
- }
-
- # A subroutine to check a user's password without ever returning the current password
- #For security purposes, we didn't expose the Password method above
-
- sub IsPassword {
- my $self = shift;
- my $try = shift;
-
- # note two __s in __Value. Subclasses may muck with _Value, but they should
- # never touch __Value
-
- if ($try eq $self->__Value('Password')) {
- return (1);
- }
- else {
- return (undef);
- }
-
- }
+# A subroutine to check a user's password without ever returning the current password
+#For security purposes, we didn't expose the Password method above
+
+sub IsPassword {
+ my $self = shift;
+ my $try = shift;
- # Override DBIx::SearchBuilder::Create to do some checking on create
- sub Create {
- my $self = shift;
- my %fields = ( UserId => undef,
- Password => 'default', #Set a default password
- @_);
-
- #Make sure a userid is specified
- unless ($fields{'UserId'}) {
- die "No userid specified.";
- }
-
- #Get DBIx::SearchBuilder::Record->Create to do the real work
- return ($self->SUPER::Create( UserId => $fields{'UserId'},
- Password => $fields{'Password'},
- Created => time ));
- }
+ # note two __s in __Value. Subclasses may muck with _Value, but they should
+ # never touch __Value
+
+ if ( $try eq $self->__Value('Password') ) {
+ return (1);
+ }
+ else {
+ return (undef);
+ }
+
+}
+
+# Override DBIx::SearchBuilder::Create to do some checking on create
+sub Create {
+ my $self = shift;
+ my %fields = (
+ UserId => undef,
+ Password => 'default', #Set a default password
+ @_
+ );
+
+ #Make sure a userid is specified
+ unless ( $fields{'UserId'} ) {
+ die "No userid specified.";
+ }
+
+ #Get DBIx::SearchBuilder::Record->Create to do the real work
+ return (
+ $self->SUPER::Create(
+ UserId => $fields{'UserId'},
+ Password => $fields{'Password'},
+ Created => time
+ )
+ );
+}
=head1 DESCRIPTION
@@ -329,11 +319,16 @@
=cut
-# Preloaded methods go here.
+# }}}
+
+
+=head2 sub new
+
+Instantiate a new record object.
+
+=cut
-# {{{ sub new
-#instantiate a new record object.
sub new {
my $proto = shift;
@@ -342,11 +337,7 @@
my $self = {};
bless ($self, $class);
$self->_Init(@_);
- $self->{'_AccessibleCache'} = $self->_ClassAccessible()
- if $self->can('_ClassAccessible');
- $self->{'_PrimaryKeys'} = $self->_PrimaryKeys()
- if $self->can('_PrimaryKeys');
return $self;
}
@@ -373,7 +364,7 @@
=head2 primary_keys
=head2 PrimaryKeys
-Matt Knopp owes docs for this function.
+Return a hash of the values of our primary keys for this function.
=cut
@@ -382,7 +373,7 @@
*primary_keys = \&PrimaryKeys;
sub PrimaryKeys {
my $self = shift;
- my %hash = map { $_ => $self->{'values'}->{$_} } @{$self->{'_PrimaryKeys'}};
+ my %hash = map { $_ => $self->{'values'}->{$_} } @{$self->_PrimaryKeys};
return (%hash);
}
@@ -477,50 +468,40 @@
# {{{ sub _Accessible
*_accessible = \&Accessible;
-sub _Accessible {
- my $self = shift;
- my $attr = shift;
- my $mode = lc(shift);
- if ( !defined($self->{'_AccessibleCache'}) && @_ ) {
- my %cols = @_;
- $self->_AccessibleLoad( map { $_ => $cols{$_} }
-# grep !defined($self->{'_AccessibleCache'}->{$_}),
- keys %cols
- );
-
- }
+sub _Accessible {
+ my $self = shift;
+ my $attr = shift;
+ my $mode = lc(shift);
- #return 0 if it's not a valid attribute;
- return 0 unless defined($self->{'_AccessibleCache'}->{$attr});
-
- # return true if we can $mode $Attrib;
- local($^W)=0;
- $self->{'_AccessibleCache'}->{$attr}->{$mode} || 0;
+ # @_ is the Accessible data from our subclass. Time to populate
+ # the accessible columns datastructure (but only if we're using
+ # something with the ancient API that predates ClassAccessible
+
+ # return true if we can $mode $Attrib;
+ local ($^W) = 0;
+ my $attribute = $self->_ClassAccessible(@_)->{$attr};
+ return 0 unless (defined $attribute && $attribute->{$mode});
+ return 1;
}
# }}}
-# {{{ sub _AccessibleLoad
-=head2 _AccessibleLoad COLUMN => OPERATIONS, ...
+=head2 _PrimaryKeys
-=cut
+Return our primary keys. (Subclasses should override this, but our default is "We have one primary key. It's called 'id');
-*_accessible_load = \&AccessibleLoad;
-sub _AccessibleLoad {
- my $self = shift;
- while ( my $col = shift ) {
- $self->{'_AccessibleCache'}->{$col}->{lc($_)} = 1
- foreach split(/[\/,]/, shift);
- }
-}
+=cut
-# }}}
+sub _PrimaryKeys {
+ my $self = shift;
+ return ['id'];
+}
# {{{ sub _ClassAccessible
-=head2 _ClassAccessible HASHREF
+=head2 _ClassAccessible
Preferred and most efficient way to specify fields attributes in a derived
class.
@@ -535,8 +516,23 @@
=cut
+# XXX This is stub code to deal with the old way we used to do _Accessible
+# It should never be called by modern code
+
+sub _ClassAccessible {
+ my $self = shift;
+ my %accessible;
+ while ( my $col = shift ) {
+ $accessible{$col}->{lc($_)} = 1
+ foreach split(/[\/,]/, shift);
+ }
+ return(\%accessible);
+}
+
# }}}
+# sub {{{ ReadableAttributes
+
=head2 ReadableAttributes
Returns an array of the attributes of this class defined as "read" => 1 in this class' _ClassAccessible datastructure
@@ -550,6 +546,9 @@
return (@readable);
}
+# }}}
+
+# {{{ sub WritableAttributes
=head2 WritableAttributes
@@ -565,6 +564,7 @@
}
+# }}}
# {{{ sub __Value {
@@ -579,20 +579,19 @@
*__value = \&__Value;
sub __Value {
my $self = shift;
- my $field =shift;
+ my $field = lc(shift);
- my $lc_field = lc($field);
- if (!$self->{'fetched'}{$lc_field} and my $id = $self->{'values'}{'id'}) {
+ if (!$self->{'fetched'}{$field} and my $id = $self->{'values'}{'id'}) {
my $QueryString = "SELECT $field FROM " . $self->Table . " WHERE id = ?";
my $sth = $self->_Handle->SimpleQuery( $QueryString, $id );
my ($value) = eval { $sth->fetchrow_array() };
warn $@ if $@;
- $self->{'values'}{$lc_field} = $value;
- $self->{'fetched'}{$lc_field} = 1;
+ $self->{'values'}{$field} = $value;
+ $self->{'fetched'}{$field} = 1;
}
- return($self->{'values'}{$lc_field});
+ return($self->{'values'}{$field});
}
# }}}
# {{{ sub _Value
@@ -686,11 +685,6 @@
$args{'Table'} = $self->Table();
$args{'PrimaryKeys'} = { $self->PrimaryKeys() };
- unless ($args{'IsSQLFunction'}) {
- $args{'Value'} = $self->AnnotateColumnValue($args{'Column'}, $args{Value});
-
- }
-
my $val = $self->_Handle->UpdateRecordValue(%args);
unless ($val) {
$ret->as_array( 0,
@@ -708,12 +702,8 @@
$self->Load( $self->Id );
}
else {
- if (ref($args{'Value'})) {
- $self->{'values'}->{"$column"} = $args{'Value'}->{'value'};
- } else {
$self->{'values'}->{"$column"} = $args{'Value'};
}
- }
}
$ret->as_array( 1, "The new value has been set." );
return ($ret->return_value);
@@ -743,6 +733,7 @@
}
# }}}
+
# {{{ sub _Object
=head2 _Object
@@ -757,35 +748,33 @@
=cut
-sub _Object
-{
- my $self = shift;
- return $self->__Object(@_);
+sub _Object {
+ my $self = shift;
+ return $self->__Object(@_);
}
-sub __Object
-{
- my $self = shift;
- my %args = ( Field => '', Args => [], @_ );
+sub __Object {
+ my $self = shift;
+ my %args = ( Field => '', Args => [], @_ );
- my $field = $args{'Field'};
- my $class = $self->_Accessible( $field, 'object' );
+ my $field = $args{'Field'};
+ my $class = $self->_Accessible( $field, 'object' );
-# Globs magic to be sure that we call 'eval "require $class"' only once
-# because eval is quite slow -- cubic at acronis.ru
- no strict qw( refs );
- my $vglob = ${ $class . '::' }{'VERSION'};
- unless ( $vglob && *$vglob{'SCALAR'} ) {
- eval "require $class";
- die "Couldn't use $class: $@" if ( $@ );
+ # Globs magic to be sure that we call 'eval "require $class"' only once
+ # because eval is quite slow -- cubic at acronis.ru
+ no strict qw( refs );
+ my $vglob = ${ $class . '::' }{'VERSION'};
unless ( $vglob && *$vglob{'SCALAR'} ) {
- *{$class."::VERSION"} = '-1, By DBIx::SerchBuilder';
+ eval "require $class";
+ die "Couldn't use $class: $@" if ($@);
+ unless ( $vglob && *$vglob{'SCALAR'} ) {
+ *{ $class . "::VERSION" } = '-1, By DBIx::SerchBuilder';
+ }
}
- }
- my $object = $class->new( @{ $args{'Args'} } );
- $object->LoadById( $self->__Value( $field ) );
- return $object;
+ my $object = $class->new( @{ $args{'Args'} } );
+ $object->LoadById( $self->__Value($field) );
+ return $object;
}
# }}}
@@ -867,7 +856,7 @@
my $value;
my $function = "?";
if (ref $hash{$key} eq 'HASH') {
- $op = ($hash{$key}->{operator} || '=');
+ $op = $hash{$key}->{operator};
$value = $hash{$key}->{value};
$function = $hash{$key}->{function} || "?";
} else {
@@ -906,18 +895,27 @@
my $id = shift;
$id = 0 if (!defined($id));
- return ($self->LoadByCols('id',$id));
+ return ($self->LoadByCols(id => $id));
}
# }}}
+
+# {{{ LoadByPrimaryKeys
+
+=head2 LoadByPrimaryKeys
+
+=cut
+
*load_by_primary_keys = \&LoadByPrimaryKeys;
+
+
sub LoadByPrimaryKeys {
my ($self, $data) = @_;
if (ref($data) eq 'HASH') {
my %cols=();
- foreach (@{$self->{'_PrimaryKeys'}}) {
+ foreach (@{$self->_PrimaryKeys}) {
$cols{$_}=$data->{$_} if (exists($data->{$_}));
}
return ($self->LoadByCols(%cols));
@@ -927,6 +925,7 @@
}
}
+# }}}
# {{{ sub LoadFromHash
@@ -949,7 +948,6 @@
}
$self->{'values'} = $hashref;
- #$self->_DowncaseValuesHash();
return ($self->{'values'}{'id'});
}
@@ -957,6 +955,12 @@
# {{{ sub _LoadFromSQL
+=head2 _LoadFromSQL QUERYSTRING @BIND_VALUES
+
+Load a record as the result of an SQL statement
+
+=cut
+
*load_from_sql = \&LoadFromSQL;
@@ -980,8 +984,6 @@
}
unless ( $self->{'values'} ) {
-
- #warn "something might be wrong here; row not found. SQL: $QueryString";
return ( 0, "Couldn't find row" );
}
@@ -990,8 +992,6 @@
$self->{'fetched'}{lc $f} = 1;
}
- #$self->_DowncaseValuesHash();
-
## I guess to be consistant with the old code, make sure the primary
## keys exist.
@@ -1003,52 +1003,6 @@
}
-sub _LoadFromSQLold {
- my $self = shift;
- my $QueryString = shift;
- my @bind_values = (@_);
-
- my $sth = $self->_Handle->SimpleQuery( $QueryString, @bind_values );
-
- #TODO this only gets the first row. we should check if there are more.
-
-
- return($sth) unless ($sth) ;
-
- my $fetched;
- eval { $fetched = $sth->fetchrow_hashref() };
- if ($@) {
- warn $@;
- }
-
- unless ( $fetched ) {
-
- #warn "something might be wrong here; row not found. SQL: $QueryString";
- return ( 0, "Couldn't find row" );
- }
-
- foreach my $f ( keys %{$fetched||{}} ) {
- $self->{'fetched'}->{lc $f} = 1;
- }
-
- $self->{'values'} = $fetched;
-
- ## I guess to be consistant with the old code, make sure the primary
- ## keys exist.
- #$self->_DowncaseValuesHash();
-
- ## I guess to be consistant with the old code, make sure the primary
- ## keys exist.
-
- eval { $self->PrimaryKeys(); };
- if ($@) {
- return ( 0, "Missing a primary key?: $@" );
- }
- return ( 1, "Found Object" );
-
-
-}
-
# }}}
# }}}
@@ -1066,68 +1020,42 @@
*create = \&Create;
-sub Create {
- my $self = shift;
+sub Create {
+ my $self = shift;
my %attribs = @_;
- foreach my $key ( keys %attribs ) {
- my $method = "Validate$key";
- unless ( $self->$method( $attribs{$key} ) ) {
- delete $attribs{$key};
+ my ($key);
+ foreach $key (keys %attribs) {
+ my $method = "Validate$key";
+ unless ($self->$method($attribs{$key})) {
+ delete $attribs{$key};
+ };
+ }
+ unless ($self->_Handle->KnowsBLOBs) {
+ # Support for databases which don't deal with LOBs automatically
+ my $ca = $self->_ClassAccessible();
+ foreach $key (keys %attribs) {
+ if ($ca->{$key}->{'type'} =~ /^(text|longtext|clob|blob|lob)$/i) {
+ my $bhash = $self->_Handle->BLOBParams($key, $ca->{$key}->{'type'});
+ $bhash->{'value'} = $attribs{$key};
+ $attribs{$key} = $bhash;
+ }
}
}
-
- foreach my $key ( keys %attribs ) {
- $attribs{$key} = $self->AnnotateColumnValue($key, $attribs{$key});
- }
- return ( $self->_Handle->Insert( $self->Table, %attribs ) );
-}
+ return ($self->_Handle->Insert($self->Table, %attribs));
+ }
# }}}
-=head2 AnnotateColumnValue COLUMN VALUE
-
-Peeks inside the ClassAccessible hash to turn a $value into a hash with
-some useful data, so that the database engine doing an insert or an update
-can figure up how to deal with the datatype in question.
-
-=cut
-
-sub AnnotateColumnValue {
- my $self = shift;
- my $key = shift;
- my $value = shift;
- # Support for databases which don't deal with LOBs automatically
- my $ca = $self->_ClassAccessible();
-
- my $bhash;
-
-
-
- if ( !$self->_Handle->KnowsBLOBs
- && $ca->{$key}->{'type'} =~ /^(text|longtext|clob|blob|lob)$/i )
- {
- $bhash = $self->_Handle->BLOBParams( $key, $ca->{$key}->{'type'} );
- }
-
- if (ref $value) {
- $bhash = $value;
- } else {
- $bhash->{'value'} = $value;
- }
- $bhash->{'type'} = $ca->{$key}->{'type'};
- $bhash->{'is_numeric'} = $ca->{$key}->{'is_numeric'};
- $bhash->{'is_blob'} = $ca->{$key}->{'is_blob'};
- $bhash->{'sql_type'} = $ca->{$key}->{'sql_type'};
- return $bhash;
-
-}
# {{{ sub Delete
*delete = \&Delete;
+sub Delete {
+ $_[0]->__Delete;
+}
-sub Delete {
+sub __Delete {
my $self = shift;
#TODO Check to make sure the key's not already listed.
@@ -1145,7 +1073,7 @@
$where =~ s/AND\s$//;
my $QueryString = "DELETE FROM ". $self->Table . ' ' . $where;
return($self->_Handle->SimpleQuery($QueryString, @bind));
- }
+}
# }}}
@@ -1170,8 +1098,7 @@
return ($self->{'table'});
}
-# {{{ Routines dealing with database handles
-
+# }}}
# {{{ sub _Handle
@@ -1193,34 +1120,6 @@
# }}}
-# }}}
-
-# {{{ sub _DowncaseValuesHash
-
-=head2 Private: _DownCaseValuesHash
-
-Takes no parameters and returns no arguments.
-This private routine iterates through $self->{'values'} and makes
-sure that all keys are lowercase.
-
-=cut
-
-*_downcase_values_hash = \&DowncaseValuesHash;
-
-sub _DowncaseValuesHash {
- my $self = shift;
- my ($key);
-
- foreach $key (keys %{$self->{'values'}}) {
- $self->{'new_values'}->{lc $key} = $self->{'values'}->{$key};
- }
-
- $self->{'values'} = $self->{'new_values'};
- delete $self->{'new_values'};
-}
-
-# }}}
-
1;
__END__
Modified: DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Record/Cachable.pm
==============================================================================
--- DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Record/Cachable.pm (original)
+++ DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Record/Cachable.pm Mon Oct 4 16:09:41 2004
@@ -1,60 +1,63 @@
# $Header: /home/jesse/DBIx-SearchBuilder/history/SearchBuilder/Record/Cachable.pm,v 1.6 2001/06/19 04:22:32 jesse Exp $
# by Matt Knopp <mhat at netlag.com>
-package DBIx::SearchBuilder::Record::Cachable;
+package DBIx::SearchBuilder::Record::Cachable;
-use DBIx::SearchBuilder::Record;
+use DBIx::SearchBuilder::Record;
use DBIx::SearchBuilder::Handle;
@ISA = qw (DBIx::SearchBuilder::Record);
-my %_RECORD_CACHE = ();
-my %_KEY_CACHE = ();
+use Cache::Simple::TimedExpiry;
+use strict;
-# Function: new
+my %_CACHES = ();
+
+# Function: new
# Type : class ctor
# Args : see DBIx::SearchBuilder::Record::new
# Lvalue : DBIx::SearchBuilder::Record::Cachable
-sub new () {
- my ($class, @args) = @_;
- my $this = $class->SUPER::new (@args);
-
- if ($this->can(_CacheConfig)) {
- $this->{'_CacheConfig'}=$this->_CacheConfig();
- }
- else {
- $this->{'_CacheConfig'}=__CachableDefaults::_CacheConfig();
- }
+sub new () {
+ my ( $class, @args ) = @_;
+ my $self = $class->SUPER::new(@args);
- return ($this);
-}
+ $self->{'_Class'} =
+ ref($self); # Cache it since we're gonna look at it a _lot_
+ if ( $self->can('_CacheConfig') ) {
+ $self->{'_CacheConfig'} = $self->_CacheConfig();
+ }
+ else {
+ $self->{'_CacheConfig'} = __CachableDefaults::_CacheConfig();
+ }
-# Function: _RecordCache
-# Type : private instance
-# Args : none
-# Lvalue : hash: RecordCache
-# Desc : Returns a reference to the record cache hash
-
-sub _RecordCache {
- my $this = shift;
- return(\%_RECORD_CACHE);
+ return ($self);
}
-# Function: _KeyCache
-# Type : private instance
-# Args : none
-# Lvalue : hash: KeyCache
-# Desc : Returns a reference to the Key cache hash
+sub _SetupCache {
+ my $self = shift;
+ my $cache = shift;
+ $_CACHES{$cache} = Cache::Simple::TimedExpiry->new();
+ $_CACHES{$cache}->expire_after( $self->{'_CacheConfig'}{'cache_for_sec'} );
+}
sub _KeyCache {
- my $this = shift;
- return(\%_KEY_CACHE);
+ my $self = shift;
+ my $cache = $self->_Handle->DSN . "-KEYS--" . $self->{'_Class'};
+ $self->_SetupCache($cache) unless exists ($_CACHES{$cache});
+ return ( $_CACHES{ $cache});
+
}
+sub _RecordCache {
+ my $self = shift;
+ my $cache = $self->_Handle->DSN . "--" . $self->{'_Class'};
+ $self->_SetupCache($cache) unless exists ($_CACHES{$cache});
+ return ( $_CACHES{ $cache});
+}
# Function: LoadFromHash
# Type : (overloaded) public instance
@@ -62,21 +65,20 @@
# Lvalue : array(boolean, message)
sub LoadFromHash {
- my $this = shift;
- my ($rvalue, $msg) = $this->SUPER::LoadFromHash(@_);
+ my $self = shift;
- my $cache_key = $this->_gen_primary_cache_key();
+ # Blow away the primary cache key since we're loading.
+ $self->{'_SB_Record_Primary_RecordCache_key'} = undef;
+ my ( $rvalue, $msg ) = $self->SUPER::LoadFromHash(@_);
+ my $cache_key = $self->_primary_RecordCache_key();
- ## Check the return value, if its good, cache it!
+ ## Check the return value, if its good, cache it!
if ($rvalue) {
- ## Only cache the object if its okay to do so.
- if ($this->{'_CacheConfig'}{'cache_p'}) {
- $this->_store() ;
- }
+ $self->_store();
}
- return($rvalue,$msg);
+ return ( $rvalue, $msg );
}
# Function: LoadByCols
@@ -84,265 +86,207 @@
# Args : see DBIx::SearchBuilder::Record::LoadByCols
# Lvalue : array(boolean, message)
-sub LoadByCols {
- my ($this, %attr) = @_;
+sub LoadByCols {
+ my ( $self, %attr ) = @_;
- ## Generate the cache key
- my $alternate_key=$this->_gen_alternate_cache_key(%attr);
- my $cache_key = $this->_lookup_primary_cache_key($alternate_key);
-
- if ($cache_key && exists $this->_RecordCache->{$cache_key}) {
- # We should never be caching a record without storing the time
- $cache_time =( $this->_RecordCache->{$cache_key}{'time'} || 0);
-
- ## Decide if the cache object is too old
-
- if ((time() - $cache_time) <= $this->{'_CacheConfig'}{'cache_for_sec'}) {
- $this->_fetch($cache_key);
- return (1, "Fetched from cache");
+ ## Generate the cache key
+ my $alt_key = $self->_gen_alternate_RecordCache_key(%attr);
+ if ( $self->_fetch( $self->_lookup_primary_RecordCache_key($alt_key) ) ) {
+ return ( 1, "Fetched from cache" );
}
- else {
- $this->_gc_expired();
- }
- }
- ## Fetch from the DB!
- my ($rvalue, $msg) = $this->SUPER::LoadByCols(%attr);
- ## Check the return value, if its good, cache it!
- if ($rvalue) {
- ## Only cache the object if its okay to do so.
- $this->_store() if ($this->{'_CacheConfig'}{'cache_p'});
+ # Blow away the primary cache key since we're loading.
+ $self->{'_SB_Record_Primary_RecordCache_key'} = undef;
+
+ ## Fetch from the DB!
+ my ( $rvalue, $msg ) = $self->SUPER::LoadByCols(%attr);
+ ## Check the return value, if its good, cache it!
+ if ($rvalue) {
+ ## Only cache the object if its okay to do so.
+ $self->_store();
+ $self->_KeyCache->set( $alt_key, $self->_primary_RecordCache_key);
- my $new_cache_key = $this->_gen_primary_cache_key();
- $this->_KeyCache->{$alternate_key} = $new_cache_key;
- $this->_KeyCache->{$alternate_key}{'time'} = time();
- }
- return ($rvalue, $msg);
+ }
+ return ( $rvalue, $msg );
}
-
-# Function: _Set
+# Function: __Set
# Type : (overloaded) public instance
# Args : see DBIx::SearchBuilder::Record::_Set
# Lvalue : ?
-sub __Set () {
- my ($this, %attr) = @_;
+sub __Set () {
+ my ( $self, %attr ) = @_;
- $this->_expire( $this->_gen_primary_cache_key());
-
- return $this->SUPER::__Set(%attr);
+ $self->_expire();
+ return $self->SUPER::__Set(%attr);
}
-
# Function: Delete
# Type : (overloaded) public instance
# Args : nil
# Lvalue : ?
-sub Delete () {
- my ($this) = @_;
- my $cache_key = $this->_gen_primary_cache_key();
-
- $this->_expire($cache_key);
-
- return $this->SUPER::Delete();
-
-}
-
-
+sub __Delete () {
+ my ($self) = @_;
+ $self->_expire();
+ return $self->SUPER::__Delete();
-# Function: _gc_expired
-# Type : private instance
-# Args : nil
-# Lvalue : 1
-# Desc : Looks at all cached objects and expires if needed.
-
-sub _gc_expired () {
- my ($this) = @_;
-
-
- my $time = time();
-
- # XXX TODO: do we want to sort the keys beforehand, so we can get out of the loop earlier?
- foreach my $cache_key (keys %{$this->_KeyCache}, keys %{$this->_RecordCache}) {
- my $cache_time = $this->_RecordCache->{$cache_key}{'time'} || 0 ;
- $this->_expire($cache_key)
- if (($time - $cache_time) > $this->{'_CacheConfig'}{'cache_for_sec'});
- }
}
-
-
-
# Function: _expire
# Type : private instance
# Args : string(cache_key)
# Lvalue : 1
-# Desc : Removes this object from the cache.
+# Desc : Removes this object from the cache.
sub _expire (\$) {
- my ($this, $cache_key) = @_;
- delete $this->_RecordCache->{$cache_key} if (exists $this->_RecordCache->{$cache_key});
- return (1);
+ my $self = shift;
+ $self->_RecordCache->set( $self->_primary_RecordCache_key , undef, time-1);
}
-
-
-
# Function: _fetch
# Type : private instance
# Args : string(cache_key)
# Lvalue : 1
-# Desc : Get an object from the cache, and make this object that.
+# Desc : Get an object from the cache, and make this object that.
-sub _fetch () {
- my ($this, $cache_key) = @_;
+sub _fetch () {
+ my ( $self, $cache_key ) = @_;
+ my $data = $self->_RecordCache->fetch($cache_key) or return;
+ @{$self}{keys %$data} = values %$data; # deserialize
+ return 1;
- $this->{'values'} = $this->_RecordCache->{$cache_key}{'values'};
- $this->{'fetched'} = $this->_RecordCache->{$cache_key}{'fetched'};
- return(1);
}
-sub __Value {
- my $self = shift;
- my $field = shift;
-
- $field = lc $field;
- my $cache_key = $self->_gen_primary_cache_key();
- unless ( $cache_key
- && exists $self->_RecordCache->{$cache_key}{'values'}->{"$field"} ) {
- return($self->SUPER::__Value($field));
- }
- return($self->_RecordCache->{$cache_key}{'values'}->{"$field"});
-
+sub __Value {
+ my $self = shift;
+ my $field = shift;
+ return ( $self->SUPER::__Value($field) );
}
-
-
# Function: _store
# Type : private instance
# Args : string(cache_key)
# Lvalue : 1
-# Desc : Stores this object in the cache.
+# Desc : Stores this object in the cache.
-sub _store (\$) {
- my ($this) = @_;
- my $cache_key = $this->_gen_primary_cache_key();
- $this->{'_CacheConfig'}{'cache_key'} = $cache_key;
- $this->_RecordCache->{$cache_key}{'values'} = $this->{'values'};
- $this->_RecordCache->{$cache_key}{'fetched'} = $this->{'fetched'};
- $this->_RecordCache->{$cache_key}{'time'} = time();
-
- return(1);
+sub _store (\$) {
+ my $self = shift;
+ $self->_RecordCache->set( $self->_primary_RecordCache_key, $self->_serialize);
+ return (1);
}
+sub _serialize {
+ my $self = shift;
+ return (
+ {
+ values => $self->{'values'},
+ table => $self->{'table'},
+ fetched => $self->{'fetched'}
+ }
+ );
+}
-
-
-# Function: _gen_alternate_cache_key
+# Function: _gen_alternate_RecordCache_key
# Type : private instance
# Args : hash (attr)
# Lvalue : 1
-# Desc : Takes a perl hash and generates a key from it.
+# Desc : Takes a perl hash and generates a key from it.
-sub _gen_alternate_cache_key {
- my ( $this, %attr ) = @_;
- my $cache_key = $this->Table() . ':';
+sub _gen_alternate_RecordCache_key {
+ my ( $self, %attr ) = @_;
+ my $cache_key = $self->Table() . ':';
while ( my ( $key, $value ) = each %attr ) {
- $key ||= '__undef';
+ $key ||= '__undef';
$value ||= '__undef';
- if ( ref($value) eq "HASH" ) {
- $value = ($value->{operator}||'=').$value->{value};
- } else {
- $value = "=".$value;
- }
- $cache_key .= $key.$value.',';
+ if ( ref($value) eq "HASH" ) {
+ $value = ( $value->{operator} || '=' ) . $value->{value};
+ }
+ else {
+ $value = "=" . $value;
+ }
+ $cache_key .= $key . $value . ',';
}
chop($cache_key);
return ($cache_key);
}
-
-# Function: _fetch_cache_key
+# Function: _fetch_RecordCache_key
# Type : private instance
# Args : nil
# Lvalue : 1
-sub _fetch_cache_key {
- my ($this) = @_;
- my $cache_key = $this->{'_CacheConfig'}{'cache_key'};
- return($cache_key);
+sub _fetch_RecordCache_key {
+ my ($self) = @_;
+ my $cache_key = $self->{'_CacheConfig'}{'cache_key'};
+ return ($cache_key);
}
-
-
-# Function: _gen_primary_cache_key
+# Function: _primary_RecordCache_key
# Type : private instance
# Args : none
# Lvalue: : 1
# Desc : generate a primary-key based variant of this object's cache key
-# primary keys is in the cache
+# primary keys is in the cache
-sub _gen_primary_cache_key {
- my ($this) = @_;
+sub _primary_RecordCache_key {
+ my ($self) = @_;
+ return undef unless ( $self->Id );
- return undef unless ($this->Id);
+ unless ( $self->{'_SB_Record_Primary_RecordCache_key'} ) {
- my $primary_cache_key = $this->Table() . ':';
- my @attributes;
- foreach my $key (@{$this->_PrimaryKeys}) {
- push @attributes, $key.'='. $this->SUPER::__Value($key);
- }
+ my $primary_RecordCache_key = $self->Table() . ':';
+ my @attributes;
+ foreach my $key ( @{ $self->_PrimaryKeys } ) {
+ push @attributes, $key . '=' . $self->SUPER::__Value($key);
+ }
- $primary_cache_key .= join(',', at attributes);
+ $primary_RecordCache_key .= join( ',', @attributes );
- return($primary_cache_key);
+ $self->{'_SB_Record_Primary_RecordCache_key'} = $primary_RecordCache_key;
+ }
+ return ( $self->{'_SB_Record_Primary_RecordCache_key'} );
}
-
-# Function: lookup_primary_cache_key
+# Function: lookup_primary_RecordCache_key
# Type : private class
# Args : string(alternate cache id)
# Lvalue : string(cache id)
-sub _lookup_primary_cache_key {
- my $this = shift;
- my $alternate_key = shift;
- if ( exists $this->_KeyCache->{$alternate_key} ) {
- $cache_time = $this->_KeyCache->{$alternate_key}{'time'};
-
- ## Decide if the cache object is too old
- if ( ( time() - $cache_time ) <=
- $this->{'_CacheConfig'}{'cache_for_sec'} ) {
- return $this->_KeyCache->{$alternate_key};
- }
- else {
- $this->_gc_expired();
- }
+sub _lookup_primary_RecordCache_key {
+ my $self = shift;
+ my $alternate_key = shift;
+ return undef unless ($alternate_key);
+
+ my $primary_key = $self->_KeyCache->fetch($alternate_key);
+ if ($primary_key) {
+ return ($primary_key);
}
- # If what we thought was the alternate key was actually the primary key
- if ($alternate_key && exists $this->_RecordCache->{$alternate_key}) {
- return($alternate_key);
+
+ # If the alternate key is really the primary one
+ elsif ( $self->_RecordCache->fetch($alternate_key) ) {
+ return ($alternate_key);
+ }
+ else { # empty!
+ return (undef);
}
- # not found
- return (undef);
-}
+}
-package __CachableDefaults;
+package __CachableDefaults;
-sub _CacheConfig {
- {
- 'cache_p' => 1,
- 'cache_for_sec' => 5,
- }
+sub _CacheConfig {
+ {
+ 'cache_p' => 1,
+ 'cache_for_sec' => 5,
+ };
}
1;
Modified: DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Union.pm
==============================================================================
--- DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Union.pm (original)
+++ DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Union.pm Mon Oct 4 16:09:41 2004
@@ -4,7 +4,7 @@
# WARNING --- This is still development code. It is experimental.
-our $VERSION = '$Version$';
+our $VERSION = '0';
# This could inherit from DBIx::SearchBuilder, but there are _a lot_
# of things in DBIx::SearchBuilder that we don't want, like Limit and
@@ -14,7 +14,7 @@
=head1 NAME
-DBIx::Searchbuilder::Union - Deal with multiple SearchBuilder result sets as one
+DBIx::SearchBuilder::Union - Deal with multiple SearchBuilder result sets as one
=head1 SYNOPSIS
More information about the Rt-commit
mailing list