Patch for proper MakeMaker-based install of DBIx modules

Jesse, do you have a CPAN ID yet? That’s where this sort of this really
belongs, especially if you’re now using general DBIx:: namespace.

proper MakeMaker-based installation for the DBIx modules

To apply this patch:

STEP 1: Chdir to the source directory.

STEP 2: Run the ‘applypatch’ program with this patch file as input.

If you do not have ‘applypatch’, it is part of the ‘makepatch’ package

that you can fetch from the Comprehensive Perl Archive Network:

http://www.perl.com/CPAN/authors/Johan_Vromans/makepatch-x.y.tar.gz

In the above URL, ‘x’ should be 2 or higher.

To apply this patch without the use of ‘applypatch’:

STEP 1: Chdir to the source directory.

If you have a decent Bourne-type shell:

STEP 2: Run the shell with this file as input.

If you don’t have such a shell, you may need to manually create/delete

the files/directories as shown below.

STEP 3: Run the ‘patch’ program with this file as input.

These are the commands needed to create/delete files/directories:

mkdir ‘lib/DBIx/DBIx-EasySearch’
chmod 0755 ‘lib/DBIx/DBIx-EasySearch’
mkdir ‘lib/DBIx/DBIx-EasySearch/blib’
chmod 0755 ‘lib/DBIx/DBIx-EasySearch/blib’
mkdir ‘lib/DBIx/DBIx-EasySearch/blib/lib’
chmod 0755 ‘lib/DBIx/DBIx-EasySearch/blib/lib’
mkdir ‘lib/DBIx/DBIx-EasySearch/blib/lib/DBIx’
chmod 0755 ‘lib/DBIx/DBIx-EasySearch/blib/lib/DBIx’
mkdir ‘lib/DBIx/DBIx-EasySearch/blib/man3’
chmod 0755 ‘lib/DBIx/DBIx-EasySearch/blib/man3’
mkdir ‘lib/DBIx/DBIx-Handle’
chmod 0755 ‘lib/DBIx/DBIx-Handle’
mkdir ‘lib/DBIx/DBIx-Handle/blib’
chmod 0755 ‘lib/DBIx/DBIx-Handle/blib’
mkdir ‘lib/DBIx/DBIx-Handle/blib/lib’
chmod 0755 ‘lib/DBIx/DBIx-Handle/blib/lib’
mkdir ‘lib/DBIx/DBIx-Handle/blib/lib/DBIx’
chmod 0755 ‘lib/DBIx/DBIx-Handle/blib/lib/DBIx’
mkdir ‘lib/DBIx/DBIx-Handle/blib/man3’
chmod 0755 ‘lib/DBIx/DBIx-Handle/blib/man3’
mkdir ‘lib/DBIx/DBIx-Record’
chmod 0755 ‘lib/DBIx/DBIx-Record’
mkdir ‘lib/DBIx/DBIx-Record/blib’
chmod 0755 ‘lib/DBIx/DBIx-Record/blib’
mkdir ‘lib/DBIx/DBIx-Record/blib/lib’
chmod 0755 ‘lib/DBIx/DBIx-Record/blib/lib’
mkdir ‘lib/DBIx/DBIx-Record/blib/lib/DBIx’
chmod 0755 ‘lib/DBIx/DBIx-Record/blib/lib/DBIx’
mkdir ‘lib/DBIx/DBIx-Record/blib/man3’
chmod 0755 ‘lib/DBIx/DBIx-Record/blib/man3’
rm -f ‘lib/DBIx/Record.pm’
rm -f ‘lib/DBIx/Handle.pm’
rm -f ‘lib/DBIx/EasySearch.pm’
touch ‘lib/DBIx/DBIx-EasySearch/Changes’
chmod 0644 ‘lib/DBIx/DBIx-EasySearch/Changes’
touch ‘lib/DBIx/DBIx-EasySearch/EasySearch.pm’
chmod 0755 ‘lib/DBIx/DBIx-EasySearch/EasySearch.pm’
touch ‘lib/DBIx/DBIx-EasySearch/MANIFEST’
chmod 0644 ‘lib/DBIx/DBIx-EasySearch/MANIFEST’
touch ‘lib/DBIx/DBIx-EasySearch/Makefile’
chmod 0644 ‘lib/DBIx/DBIx-EasySearch/Makefile’
touch ‘lib/DBIx/DBIx-EasySearch/Makefile.PL’
chmod 0644 ‘lib/DBIx/DBIx-EasySearch/Makefile.PL’
touch ‘lib/DBIx/DBIx-EasySearch/blib/lib/DBIx/EasySearch.pm’
chmod 0555 ‘lib/DBIx/DBIx-EasySearch/blib/lib/DBIx/EasySearch.pm’
touch ‘lib/DBIx/DBIx-EasySearch/blib/man3/DBIx::EasySearch.3pm’
chmod 0644 ‘lib/DBIx/DBIx-EasySearch/blib/man3/DBIx::EasySearch.3pm’
touch ‘lib/DBIx/DBIx-EasySearch/test.pl’
chmod 0644 ‘lib/DBIx/DBIx-EasySearch/test.pl’
touch ‘lib/DBIx/DBIx-Handle/Changes’
chmod 0644 ‘lib/DBIx/DBIx-Handle/Changes’
touch ‘lib/DBIx/DBIx-Handle/Handle.pm’
chmod 0755 ‘lib/DBIx/DBIx-Handle/Handle.pm’
touch ‘lib/DBIx/DBIx-Handle/MANIFEST’
chmod 0644 ‘lib/DBIx/DBIx-Handle/MANIFEST’
touch ‘lib/DBIx/DBIx-Handle/Makefile’
chmod 0644 ‘lib/DBIx/DBIx-Handle/Makefile’
touch ‘lib/DBIx/DBIx-Handle/Makefile.PL’
chmod 0644 ‘lib/DBIx/DBIx-Handle/Makefile.PL’
touch ‘lib/DBIx/DBIx-Handle/blib/lib/DBIx/Handle.pm’
chmod 0555 ‘lib/DBIx/DBIx-Handle/blib/lib/DBIx/Handle.pm’
touch ‘lib/DBIx/DBIx-Handle/blib/man3/DBIx::Handle.3pm’
chmod 0644 ‘lib/DBIx/DBIx-Handle/blib/man3/DBIx::Handle.3pm’
touch ‘lib/DBIx/DBIx-Handle/test.pl’
chmod 0644 ‘lib/DBIx/DBIx-Handle/test.pl’
touch ‘lib/DBIx/DBIx-Record/Changes’
chmod 0644 ‘lib/DBIx/DBIx-Record/Changes’
touch ‘lib/DBIx/DBIx-Record/MANIFEST’
chmod 0644 ‘lib/DBIx/DBIx-Record/MANIFEST’
touch ‘lib/DBIx/DBIx-Record/Makefile’
chmod 0644 ‘lib/DBIx/DBIx-Record/Makefile’
touch ‘lib/DBIx/DBIx-Record/Makefile.PL’
chmod 0644 ‘lib/DBIx/DBIx-Record/Makefile.PL’
touch ‘lib/DBIx/DBIx-Record/Record.pm’
chmod 0755 ‘lib/DBIx/DBIx-Record/Record.pm’
touch ‘lib/DBIx/DBIx-Record/blib/lib/DBIx/Record.pm’
chmod 0555 ‘lib/DBIx/DBIx-Record/blib/lib/DBIx/Record.pm’
touch ‘lib/DBIx/DBIx-Record/blib/man3/DBIx::Record.3pm’
chmod 0644 ‘lib/DBIx/DBIx-Record/blib/man3/DBIx::Record.3pm’
touch ‘lib/DBIx/DBIx-Record/test.pl’
chmod 0644 ‘lib/DBIx/DBIx-Record/test.pl’

This command terminates the shell and need not be executed manually.

exit

End of Preamble

Patch data follows

diff -c ‘baseline/README’ ‘work/README’
Index: ./README
*** ./README Thu Aug 10 04:41:51 2000
— ./README Fri Aug 11 23:48:22 2000
*** 92,98 ****
GENERAL INSTALLATION

! 0 Install JVDBIx

1 Unpack this distribution SOMWHERE OTHER THAN where you want to install RT

— 92,101 ----
GENERAL INSTALLATION

! 0 Install the DBIx modules
!
! cd /lib/DBIx
! for a in DBIx*; do ( cd $a; perl Makefile.PL && make install ); done

1 Unpack this distribution SOMWHERE OTHER THAN where you want to install RT

diff -c /dev/null ‘work/lib/DBIx/DBIx-EasySearch/Changes’
Index: ./lib/DBIx/DBIx-EasySearch/Changes
*** ./lib/DBIx/DBIx-EasySearch/Changes Wed Dec 31 16:00:00 1969
— ./lib/DBIx/DBIx-EasySearch/Changes Fri Aug 11 23:28:59 2000
*** 0 ****
— 1,5 ----

  • Revision history for Perl extension DBIx::EasySearch.
  • 0.01 Fri Aug 11 23:28:59 2000
    • original version; created by h2xs 1.19
      diff -c /dev/null ‘work/lib/DBIx/DBIx-EasySearch/EasySearch.pm’
      Index: ./lib/DBIx/DBIx-EasySearch/EasySearch.pm
      *** ./lib/DBIx/DBIx-EasySearch/EasySearch.pm Wed Dec 31 16:00:00 1969
      — ./lib/DBIx/DBIx-EasySearch/EasySearch.pm Fri Aug 11 23:48:52 2000
      *** 0 ****
      — 1,716 ----
  • $Header: /proj/maps/src/rt/lib/DBIx/DBIx-EasySearch/EasySearch.pm,v 1.1 2000/08/12 06:48:51 ivan Exp $

  • {{{ Version, package, new, etc

  • package DBIx::EasySearch;
  • use strict;
  • use vars qw($VERSION);
  • $VERSION = ‘0.05’;
  • {{{ sub new

  • #instantiate a new object.
  • sub new {
  • my $proto = shift;
  • my $class = ref($proto) || $proto;
  • my $self = {};
  • bless ($self, $class);
  • $self->Init(@);
  • return ($self)
  • }
  • }}}

  • }}}

  • {{{ Methods dealing with Record objects (navigation)

  • {{{ sub Next

  • sub Next {
  • my $self = shift;
  • my @row;
  • if (!$self->_isLimited) {
  • return(0);
    
  • }
  • if ($self->{‘must_redo_search’} != 0) {
  • $self->_DoSearch();
    
  • }
  • if ($self->{‘itemscount’} < $self->{‘rows’}) {
  • #increment the itemcounter.
    
  • $self->{'itemscount'}++;
    
  • #serve out that item
    
  • return ($self->{'items'}[$self->{'itemscount'}]);
    
  • }
  • else {
  • #we've gone through the whole list.
    
  • #reset the count.
    
  • $self->{'itemscount'} = 0;
    
  • return(undef);
    
  • }
  • }
  • }}}

  • {{{ sub GotoFirstItem

  • sub GotoFirstItem {
  • my $self = shift;
  • $self->GotoItem(0);
  • }
  • }}}

  • {{{ sub GotoItem

  • sub GotoItem {
  • my $self = shift;
  • my $item = shift;
  • $self->{‘itemscount’} = $item;
  • }
  • }}}

  • {{{ sub First

  • sub First {
  • my $self = shift;
  • #Reset the itemcount
  • $self->GotoFirstItem();
  • return ($self->Next);
  • }
  • }}}

  • {{{ sub NewItem

  • sub NewItem {
  • my $self = shift;
  • my $foo = (caller(1))[3];
  • die “DBIx::EasySearch needs to be subclassed. you can’t use it directly. ($foo)\n”;
  • }
  • }}}

  • }}}

  • {{{ Routines dealing with Restrictions (where subclauses) and ordering

  • {{{ sub UnLimit

  • sub UnLimit {
  • my $self=shift;
  • $self->_isLimited(-1);
  • }
  • }}}

  • {{{ sub Limit

  • This clearly needs to be documented a bit … this is how TobiX has

  • understood this:

  • TABLE can be set to something different than this table if a join is

  • wanted (that means we can’t do recursive joins as for now). Unless

  • ALIAS is set, the join criterias will be taken from EXT_LINKFIELD

  • and INT_LINKFIELD and added to the criterias. If ALIAS is set, new

  • criterias about the foreign table will be added.

  • VALUE should always be set and will always be quoted. Maybe TYPE

  • should imply that the value shouldn’t be quoted? IMO (TobiX) we

  • shouldn’t use quoted values, we should rather use placeholders and

  • pass the arguments when executing the statement. This will also

  • allow us to alter limits and reexecute the search with a low cost by

  • keeping the statement handler.

  • ENTRYAGGREGATOR might be or or and or whatever :slight_smile: TobiX hasn’t

  • understood how to recurse (like (true or (false and true) or (true

  • and true and true)))

  • OPERATOR is whatever should be putted in between the FIELD and the

  • VALUE.

  • ORDERBY is the SQL ORDERBY

  • ORDER can be ASCending or DESCending.

  • sub Limit {
  • my $self = shift;
  • my %args = (
  •     TABLE => $self->{'table'},
    
  •     FIELD => undef,
    
  •     VALUE => undef,
    
  •     ALIAS => undef,
    
  •     TYPE => undef,  #TODO: figure out why this is here
    
  •     ENTRYAGGREGATOR => 'or',
    
  •     INT_LINKFIELD => ($self->{'primary_key'} || 'id'),
    
  •     EXT_LINKFIELD => 'id',
    
  •     OPERATOR => '=',
    
  •     ORDERBY => undef,
    
  •     ORDER => undef,
    
  •     @_ # get the real argumentlist
    
  •    );
    
  • my ($Alias);
  • if ($args{‘FIELD’}) {
  • #If it's a like, we supply the %s around the search term
    
  • if ($args{'OPERATOR'} eq "LIKE") {
    
  •   $args{'VALUE'} = "%".$args{'VALUE'} ."%";
    
  • }
    
  • $args{'VALUE'} = $self->_Handle->dbh->quote($args{'VALUE'});
    
  • }
  • $Alias = $self->_GenericRestriction(%args);
  • warn “No table alias set!”
  •   unless $Alias;
    
  • {{{ Set $self->{order} - can be "ASC"ending or "DESC"ending.

  • if ($args{‘ORDER’}) {
  • $self->{'order'} = $args{'ORDER'};
    
  • }
  • }}}

  • {{{ If we’re setting an OrderBy, set $self->{‘orderby’} here

  • if ($args{‘ORDERBY’}) {
  • # 1. if an alias was passed in, use that. 
    
  • if ($args{'ALIAS'}) {
    
  •   $self->{'orderby'} = $args{'ALIAS'}.".".$args{'ORDERBY'};
    
  • }
    
  • # 2. if an alias was generated, use that.
    
  • elsif ($Alias) {
    
  •    $self->{'orderby'} = "$Alias.".$args{'ORDERBY'};
    
  •  }
    
  • # 3. use the primary
    
  • else {
    
  •   $self->{'orderby'} = "main.".$args{'ORDERBY'};
    
  • }
    
  • }
  • }}}

  • We’re now limited. people can do searches.

  • $self->_isLimited(1);
  • if (defined ($Alias)) {
  • return($Alias);
    
  • }
  • else {
  • return(0);
    
  • }
  • }
  • }}}

  • {{{ sub ShowRestrictions

  • #Show Restrictions
  • sub ShowRestrictions {
  • my $self = shift;
  • $self->_CompileGenericRestrictions();
  • $self->_CompileSubClauses();
  • return($self->{‘where_clause’});
  • }
  • }}}

  • {{{ sub ImportRestrictions

  • #import a restrictions clause
  • sub ImportRestrictions {
  • my $self = shift;
  • $self->{‘where_clause’} = shift;
  • }
  • }}}

  • {{{ sub _GenericRestriction

  • sub _GenericRestriction {
  • my $self = shift;
    
  • my %args = (
    
  •   TABLE => $self->{'table'},
    
  •   FIELD => undef,
    
  •   VALUE => undef,	#TODO: $Value should take an array of values and generate 
    
  •                   #the proper where clause.
    
  •   ALIAS => undef,	     
    
  •   ENTRYAGGREGATOR => undef,
    
  •   OPERATOR => '=',
    
  •   INT_LINKFIELD => undef,
    
  •   EXT_LINKFIELD => undef,
    
  •   RESTRICTION_TYPE => 'generic', 
    
  •   @_);
    
  • my ($QualifiedField);
    
  • #since we're changing the search criteria, we need to redo the search
    
  • $self->{'must_redo_search'}=1;
    
  • # {{{ if there's no alias set, we need to set it
    
  • if (!$args{'ALIAS'}) {
    
  • #if the table we’re looking at is the same as the main table
  • if ($args{‘TABLE’} eq $self->{‘table’}) {
  •   # main is the alias of the "primary 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'})
    
  •   or warn;
    
  •   warn "missing input parameter INT_LINKFIELD"
    
  •   unless $args{'INT_LINKFIELD'};
    
  •   warn "missing input parameter EXT_LINKFIELD"
    
  •   unless $args{'EXT_LINKFIELD'};
    
  •   # we need to build the table of links.
    
  •   $self->{'table_links'} .= "AND main.". $args{'INT_LINKFIELD'}."=".
    
  •     $args{'ALIAS'}.".".$args{'EXT_LINKFIELD'};
    
  • }
  • }}}

  • }
    
  • # }}}
    
  • # If we were just setting an alias, return
    
  • if (!$args{'FIELD'}) {
    
  • return ($args{‘ALIAS’});
  • }
    
  • #Set this to the name of the field and the alias.
    
  • $QualifiedField = $args{'ALIAS'}.".".$args{'FIELD'};
    
  • print STDERR "DBIx::EasySearch->_GenericRestriction  QualifiedField is $QualifiedField\n" 
    
  •   if ($self->DEBUG);
    
  • #If we're overwriting this sort of restriction, 
    
  • # TODO: Something seems wrong here ... I kept getting warnings until I putted in all this crap.
    
  • # Shouldn't we have a default setting somewhere? -- TobiX
    
  • if (((exists $args{'ENTRYAGGREGATOR'}) and ($args{'ENTRYAGGREGATOR'}||"") eq 'none') or 
    
  • (!$self->{‘restrictions’}{“$QualifiedField”})) {
  • $self->{‘restrictions’}{“$QualifiedField”} =
  • "($QualifiedField $args{'OPERATOR'} $args{'VALUE'})";  
    
  • }
    
  • else {
    
  • $self->{‘restrictions’}{“$QualifiedField”} .=
  • " $args{'ENTRYAGGREGATOR'} ($QualifiedField $args{'OPERATOR'} $args{'VALUE'})";
    
  • }
    
  • return ($args{'ALIAS'});
    
  • }
  • }}}

  • {{{ sub _AddRestriction

  • sub _AddSubClause {
  • my $self = shift;
    
  • my $clauseid = shift;
    
  • my $subclause = shift;
    
  • $self->{'subclauses'}{"$clauseid"} = $subclause;
    
  • }
  • }}}

  • {{{ sub _WhereClause

  • sub _WhereClause {
  • 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 EasySearch 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 ";
    
  • }
  • warn “$self $subclause doesn’t exist”
  •  if (!defined $self->{'subclauses'}{"$subclause"});
    
  • $where_clause .= $self->{‘subclauses’}{“$subclause”};
  • }
  • $where_clause = " WHERE " . $where_clause if ($where_clause ne ‘’);
  • return ($where_clause);
  • }
  • }}}

  • {{{ sub _CompileGenericRestrictions

  • #Compile the restrictions to a WHERE Clause
  • sub _CompileGenericRestrictions {
  • my $self = shift;
    
  • my ($restriction);
    
  • $self->{'subclauses'}{'generic_restrictions'} = undef;
    
  • #Go through all the restrictions of this type. Buld up the generic subclause
    
  • foreach $restriction (keys %{ $self->{'restrictions'}}) {
    
  • if (defined $self->{‘subclauses’}{‘generic_restrictions’}) {
  •   $self->{'subclauses'}{'generic_restrictions'} .= " AND ";
    
  • }
  • $self->{‘subclauses’}{‘generic_restrictions’} .=
  • "(" . $self->{'restrictions'}{"$restriction"} . ")";
    
  • }
    
  • }
  • }}}

  • {{{ sub _Order

  • This routine returns what the result set should be ordered by

  • sub _Order {
  • my $self = shift;
  • my $OrderClause;
  • if ($self->{‘orderby’}) {
  • $OrderClause = " ORDER BY ". $self->{'orderby'};
    
  • }
  • else {
  • $OrderClause = " ORDER BY main.".$self->{'primary_key'}." ";
    
  • }
  • return ($OrderClause);
  • }
  • }}}

  • {{{ sub _OrderBy

  • This routine returns whether the result set should be sorted Ascending or Descending

  • sub _OrderBy {
  • my $self = shift;
  • my $order_by;
  • if ($self->{‘order’} =~ /[1]es/) {
  • $order_by = " DESC";
    
  • }
  • else {
  • $order_by = " ASC";
    
  • }
  • return($order_by);
  • }
  • }}}

  • }}}

  • {{{ routines dealing with table aliases

  • {{{ sub NewAlias

  • sub NewAlias {
  • #TODO Stub
    
  • my $self = shift;
    
  • my $table = shift || die "Missing parameter";
    
  • my $alias=$table."_".$self->{'alias_count'};
    
  • $self->{'aliases'}[$self->{'alias_count'}]{'alias'} = $alias;
    
  • $self->{'aliases'}[$self->{'alias_count'}]{'table'} = $table;
    
  • $self->{'alias_count'}++;
    
  • return $alias;
    
  • }
  • }}}

  • {{{ sub _TableAliases

  • sub _TableAliases {
  • my $self = shift;
    
  • # Set up the first alias. for the _main_ table
    
  • my $compiled_aliases = $self->{'table'}." AS main";
    
  • # Go through all the other aliases we set up and build the compiled
    
  • # aliases string
    
  • for my $count (0..($self->{'alias_count'}-1)) {
    
  • $compiled_aliases .= ", ".
  • $self->{'aliases'}[$count]{'table'}. " as ".
    
  •   $self->{'aliases'}[$count]{'alias'};
    
  • }
    
  • return ($compiled_aliases);
    
  • }
  • }}}

  • things we’ll want to add:

  • get aliases

  • add restirction clause

  • }}}

  • {{{ private utility methods

  • {{{ sub _Init

  • #Initialize the object
  • sub _Init {
  • my $self = shift;
  • my %args = ( Handle => undef,
  •      @_
    
  •    );
    
  • $self->{‘DBIxHandle’} = $args{‘Handle’};
  • $self->{‘must_redo_search’}=1;
  • $self->{‘itemscount’}=0;
  • $self->{‘tables’} = “”;
  • $self->{‘auxillary_tables’} = “”;
  • $self->{‘where_clause’} = “”;
  • $self->{‘table_links’} = “”;
  • $self->{‘limit_clause’} = “”;
  • $self->{‘order’} = “”;
  • $self->{‘alias_count’} = 0;
  • $self->{‘first_row’} = 0;
  • #we have no limit statements. DoSearch won’t work.
  • $self->_isLimited(0);
  • }
  • }}}

  • {{{ sub _Handle

  • sub _Handle {
  • my $self = shift;
  • return ($self->{‘DBIxHandle’});
  • }
  • }}}

  • {{{ sub _DoSearch

  • sub _DoSearch {
  • my $self = shift;
    
  • my ($QueryString, $Order);
    
  • $QueryString = "SELECT distinct main.* FROM " . $self->_TableAliases;
    
  • $QueryString .= $self->_WhereClause . " ".
    
  •   $self->{'table_links'}. " " 
    
  • if ($self->_isLimited > 0);
    
  • $QueryString .=  $self->_Order . $self->_OrderBy . $self->_Limit;
    
  •   print STDERR "DBIx::EasySearch->DoSearch Query:  $QueryString\n" 
    
  • if ($self->DEBUG);
  • {{{

  • {{{ get $self->{‘records’} out of the database

  • $self->{‘records’} = $self->_Handle->dbh->prepare($QueryString);
  • if (!$self->{‘records’}) {
  • die "Error:" . $self->_Handle->dbh->errstr . "\n";
    
  • }
  • if (!$self->{‘records’}->execute) {
  • die "DBIx::EasySearch error:" . $self->{'records'}->errstr . "\n\tQuery String is $QueryString\n";
    
  • }
  • }}}

  • # populate $self->{'rows'} for $Count;
    
  • $self->{'rows'} = $self->{'records'}->rows();
    
  • my $counter = 0;
    
  • # {{{ Iterate through all the rows returned and get child objects
    
  • TODO: this could be made much more efficient

  • while (my $row = $self->{‘records’}->fetchrow_hashref()) {
  • $counter++;
    
  • $self->{'items'}[$counter] = $self->NewItem();
    
  • $self->{'items'}[$counter]->LoadFromHash($row);
    
  • print STDERR "ID is ". $self->{'items'}[$counter]->Id()."\n"
    
  • if ($self->DEBUG);
    
  • }
  • 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};
    
  • }}}

  • $self->{'must_redo_search'}=0;
    
  • return($self->Count);
    
  • }
  • }}}

  • {{{ sub _Limit

  • sub _Limit {
  • my $self = shift;
  • my $limit_clause;
  • LIMIT clauses are used for restricting ourselves to subsets of the search.

  • if ( $self->Rows) {
  • $limit_clause = " LIMIT ";
    
  • if ($self->FirstRow != 0) {
    
  •   $limit_clause .= $self->FirstRow . ", ";
    
  • }
    
  • $limit_clause .= $self->Rows;
    
  • }
  • else {
  • $limit_clause = "";
    
  • }
  • return $limit_clause;
  • }
  • }}}

  • {{{ sub _isLimited

  • sub _isLimited {
  • my $self = shift;
    
  • if (@_) {
    
  • $self->{‘is_limited’} = shift;
  • }
    
  • else {
    
  • return ($self->{‘is_limited’});
  • }
    
  • }
  • }}}

  • }}} Private utility methods

  • {{{ sub Rows

  • This restricts the # of rows returned in a result

  • sub Rows {
  • my $self = shift;
  • if (@_) {
  • $self->{'show_rows'} = shift;
    
  • }
  • return ($self->{‘show_rows’});
  • }
  • }}}

  • {{{ sub FirstRow

  • returns the first row

  • sub FirstRow {
  • my $self = shift;
  • if (@_) {
  • $self->{'first_row'} = shift;
    
  • #SQL starts counting at 0
    
  • $self->{'first_row'}--;
    
  • }
  • return ($self->{‘first_row’});
  • }
  • }}}

  • {{{ Public utility methods

  • {{{ Counter, Count and IsLast

  • sub Counter {
  • return $_[0]->{'itemscount'};
    
  • }
  • {{{ sub Count

  • sub Count {
  • my $self = shift;
    
  • if ($self->{'must_redo_search'}) {
    
  • return ($self->_DoSearch);
  • }
    
  • else {
    
  • return($self->{‘rows’});
  • }
    
  • }
  • sub IsLast {
  • return $_[0]->{'itemscount'}==$_[0]->{'rows'};
    
  • }
  • }}}

  • {{{ sub DEBUG

  • sub DEBUG {
  • my $self = shift;
    
  • if (@_) {
    
  • $self->{‘DEBUG’} = shift;
  •   }
    
  • return ($self->{'DEBUG'});
    
  • }
  • }}}

  • }}}

  • }}}

  • 1;
  • END
  • {{{ POD

  • =head1 NAME
  • DBIx::EasySearch - Perl extension for easy SQL SELECT Statement generation
  • =head1 SYNOPSIS
  • use DBIx::EasySearch;
  • then read the code. (yes, i’m being lame)
  • =head1 DESCRIPTION
  • Jesse is lame and hasn’t written docs yet
  • =head1 AUTHOR
  • Jesse Vincent, jesse@fsck.com
  • =head1 SEE ALSO
  • DBIx::Handle, DBIx::Record, perl(1).
  • =cut
  • }}}

diff -c /dev/null ‘work/lib/DBIx/DBIx-EasySearch/MANIFEST’
Index: ./lib/DBIx/DBIx-EasySearch/MANIFEST
*** ./lib/DBIx/DBIx-EasySearch/MANIFEST Wed Dec 31 16:00:00 1969
— ./lib/DBIx/DBIx-EasySearch/MANIFEST Fri Aug 11 23:29:00 2000
*** 0 ****
— 1,5 ----

  • Changes
  • EasySearch.pm
  • MANIFEST
  • Makefile.PL
  • test.pl
    diff -c /dev/null ‘work/lib/DBIx/DBIx-EasySearch/Makefile’
    Index: ./lib/DBIx/DBIx-EasySearch/Makefile
    *** ./lib/DBIx/DBIx-EasySearch/Makefile Wed Dec 31 16:00:00 1969
    — ./lib/DBIx/DBIx-EasySearch/Makefile Fri Aug 11 23:43:17 2000
    *** 0 ****
    — 1,654 ----
  • This Makefile is for the DBIx::EasySearch extension to perl.

  • It was generated automatically by MakeMaker version

  • 5.4302 (Revision: 1.222) from the contents of

  • Makefile.PL. Don’t edit this file, edit Makefile.PL instead.

  • ANY CHANGES MADE HERE WILL BE LOST!

  • MakeMaker ARGV: ()

  • MakeMaker Parameters:

  • NAME => q[DBIx::EasySearch]

  • VERSION_FROM => q[EasySearch.pm]

  • — MakeMaker post_initialize section:

  • — MakeMaker const_config section:

  • These definitions are from config.sh (via /usr/lib/perl5/5.005/i386-linux/Config.pm)

  • They may have been overridden via Makefile.PL or on the command line

  • AR = ar
  • CC = cc
  • CCCDLFLAGS = -fPIC
  • CCDLFLAGS = -rdynamic
  • DLEXT = so
  • DLSRC = dl_dlopen.xs
  • LD = cc
  • LDDLFLAGS = -shared -L/usr/local/lib
  • LDFLAGS = -L/usr/local/lib
  • LIBC =
  • LIB_EXT = .a
  • OBJ_EXT = .o
  • OSNAME = linux
  • OSVERS = 2.2.15pre14
  • RANLIB = :
  • SO = so
  • EXE_EXT =
  • — MakeMaker constants section:

  • AR_STATIC_ARGS = cr
  • NAME = DBIx::EasySearch
  • DISTNAME = DBIx-EasySearch
  • NAME_SYM = DBIx_EasySearch
  • VERSION = 0.05
  • VERSION_SYM = 0_05
  • XS_VERSION = 0.05
  • INST_BIN = blib/bin
  • INST_EXE = blib/script
  • INST_LIB = blib/lib
  • INST_ARCHLIB = blib/arch
  • INST_SCRIPT = blib/script
  • PREFIX = /usr
  • INSTALLDIRS = site
  • INSTALLPRIVLIB = $(PREFIX)/lib/perl5
  • INSTALLARCHLIB = $(PREFIX)/lib/perl5/5.005/i386-linux
  • INSTALLSITELIB = /usr/local/lib/site_perl
  • INSTALLSITEARCH = /usr/local/lib/site_perl/i386-linux
  • INSTALLBIN = $(PREFIX)/bin
  • INSTALLSCRIPT = $(PREFIX)/bin
  • PERL_LIB = /usr/lib/perl5/5.005
  • PERL_ARCHLIB = /usr/lib/perl5/5.005/i386-linux
  • SITELIBEXP = /usr/local/lib/site_perl
  • SITEARCHEXP = /usr/local/lib/site_perl/i386-linux
  • LIBPERL_A = libperl.a
  • FIRST_MAKEFILE = Makefile
  • MAKE_APERL_FILE = Makefile.aperl
  • PERLMAINCC = $(CC)
  • PERL_INC = /usr/lib/perl5/5.005/i386-linux/CORE
  • PERL = /usr/bin/perl
  • FULLPERL = /usr/bin/perl
  • VERSION_MACRO = VERSION
  • DEFINE_VERSION = -D$(VERSION_MACRO)="$(VERSION)"
  • XS_VERSION_MACRO = XS_VERSION
  • XS_DEFINE_VERSION = -D$(XS_VERSION_MACRO)="$(XS_VERSION)"
  • MAKEMAKER = /usr/lib/perl5/5.005/ExtUtils/MakeMaker.pm
  • MM_VERSION = 5.4302
  • FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle).

  • BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle)

  • ROOTEXT = Directory part of FULLEXT with leading slash (eg /DBD) !!! Deprecated from MM 5.32 !!!

  • PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar)

  • DLBASE = Basename part of dynamic library. May be just equal BASEEXT.

  • FULLEXT = DBIx/EasySearch
  • BASEEXT = EasySearch
  • PARENT_NAME = DBIx
  • DLBASE = $(BASEEXT)
  • VERSION_FROM = EasySearch.pm
  • OBJECT =
  • LDFROM = $(OBJECT)
  • LINKTYPE = dynamic
  • Handy lists of source code files:

  • XS_FILES=
  • C_FILES =
  • O_FILES =
  • H_FILES =
  • MAN1PODS =
  • MAN3PODS = EasySearch.pm
  • INST_MAN1DIR = blib/man1
  • INSTALLMAN1DIR = /usr/local/man/man1
  • MAN1EXT = 1p
  • INST_MAN3DIR = blib/man3
  • INSTALLMAN3DIR = /usr/local/man/man3
  • MAN3EXT = 3pm
  • PERM_RW = 644
  • PERM_RWX = 755
  • work around a famous dec-osf make(1) feature(?):

  • makemakerdflt: all
  • .SUFFIXES: .xs .c .C .cpp .cxx .cc $(OBJ_EXT)
  • Nick wanted to get rid of .PRECIOUS. I don’t remember why. I seem to recall, that

  • some make implementations will delete the Makefile when we rebuild it. Because

  • we call false(1) when we rebuild it. So make(1) is not completely wrong when it

  • does so. Our milage may vary.

  • .PRECIOUS: Makefile # seems to be not necessary anymore

  • .PHONY: all config static dynamic test linkext manifest
  • Where is the Config information that we are using/depend on

  • CONFIGDEP = $(PERL_ARCHLIB)/Config.pm $(PERL_INC)/config.h
  • Where to put things:

  • INST_LIBDIR = $(INST_LIB)/DBIx
  • INST_ARCHLIBDIR = $(INST_ARCHLIB)/DBIx
  • INST_AUTODIR = $(INST_LIB)/auto/$(FULLEXT)
  • INST_ARCHAUTODIR = $(INST_ARCHLIB)/auto/$(FULLEXT)
  • INST_STATIC =
  • INST_DYNAMIC =
  • INST_BOOT =
  • EXPORT_LIST =
  • PERL_ARCHIVE =
  • TO_INST_PM = EasySearch.pm
  • PM_TO_BLIB = EasySearch.pm \
  • $(INST_LIBDIR)/EasySearch.pm
  • — MakeMaker tool_autosplit section:

  • Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto

  • AUTOSPLITFILE = $(PERL) “-I$(PERL_ARCHLIB)” “-I$(PERL_LIB)” -e ‘use AutoSplit;autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1) ;’
  • — MakeMaker tool_xsubpp section:

  • — MakeMaker tools_other section:

  • SHELL = /bin/sh
  • CHMOD = chmod
  • CP = cp
  • LD = cc
  • MV = mv
  • NOOP = $(SHELL) -c true
  • RM_F = rm -f
  • RM_RF = rm -rf
  • TEST_F = test -f
  • TOUCH = touch
  • UMASK_NULL = umask 0
  • DEV_NULL = > /dev/null 2>&1
  • The following is a portable way to say mkdir -p

  • To see which directories are created, change the if 0 to if 1

  • MKPATH = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e mkpath
  • This helps us to minimize the effect of the .exists files A yet

  • better solution would be to have a stable file in the perl

  • distribution with a timestamp of zero. But this solution doesn’t

  • need any changes to the core distribution and works with older perls

  • EQUALIZE_TIMESTAMP = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e eqtime
  • Here we warn users that an old packlist file was found somewhere,

  • and that they should call some uninstall routine

  • WARN_IF_OLD_PACKLIST = $(PERL) -we ‘exit unless -f $$ARGV[0];’ \
  • -e ‘print “WARNING: I have found an old package in\n”;’ \
  • -e ‘print “\t$$ARGV[0].\n”;’ \
  • -e ‘print “Please make sure the two installations are not conflicting\n”;’
  • UNINST=0
  • VERBINST=1
  • MOD_INSTALL = $(PERL) -I$(INST_LIB) -I$(PERL_LIB) -MExtUtils::Install \
  • -e “install({@ARGV},‘$(VERBINST)’,0,‘$(UNINST)’);”
  • DOC_INSTALL = $(PERL) -e ‘$$=“\n\n”;’ \
  • -e ‘print "=head2 “, scalar(localtime), “: C<”, shift, “>”, " L<”, shift, “>”;’ \
  • -e ‘print “=over 4”;’ \
  • -e ‘while (defined($$key = shift) and defined($$val = shift)){print “=item *”;print “C<$$key: $$val>”;}’ \
  • -e ‘print “=back”;’
  • UNINSTALL = $(PERL) -MExtUtils::Install \
  • -e ‘uninstall($$ARGV[0],1,1); print “\nUninstall is deprecated. Please check the”;’ \
  • -e ‘print " packlist above carefully.\n There may be errors. Remove the";’ \
  • -e ‘print " appropriate files manually.\n Sorry for the inconveniences.\n"’
  • — MakeMaker dist section:

  • DISTVNAME = $(DISTNAME)-$(VERSION)
  • TAR = tar
  • TARFLAGS = cvf
  • ZIP = zip
  • ZIPFLAGS = -r
  • COMPRESS = gzip --best
  • SUFFIX = .gz
  • SHAR = shar
  • PREOP = @$(NOOP)
  • POSTOP = @$(NOOP)
  • TO_UNIX = @$(NOOP)
  • CI = ci -u
  • RCS_LABEL = rcs -Nv$(VERSION_SYM): -q
  • DIST_CP = best
  • DIST_DEFAULT = tardist
  • — MakeMaker macro section:

  • — MakeMaker depend section:

  • — MakeMaker cflags section:

  • — MakeMaker const_loadlibs section:

  • — MakeMaker const_cccmd section:

  • — MakeMaker post_constants section:

  • — MakeMaker pasthru section:

  • PASTHRU = LIB=“$(LIB)”\
  • LIBPERL_A=“$(LIBPERL_A)”\
  • LINKTYPE=“$(LINKTYPE)”\
  • PREFIX=“$(PREFIX)”\
  • OPTIMIZE=“$(OPTIMIZE)”
  • — MakeMaker c_o section:

  • — MakeMaker xs_c section:

  • — MakeMaker xs_o section:

  • — MakeMaker top_targets section:

  • #all :: config $(INST_PM) subdirs linkext manifypods
  • all :: pure_all manifypods
  • @$(NOOP)
  • pure_all :: config pm_to_blib subdirs linkext
  • @$(NOOP)
  • subdirs :: $(MYEXTLIB)
  • @$(NOOP)
  • config :: Makefile $(INST_LIBDIR)/.exists
  • @$(NOOP)
  • config :: $(INST_ARCHAUTODIR)/.exists
  • @$(NOOP)
  • config :: $(INST_AUTODIR)/.exists
  • @$(NOOP)
  • config :: Version_check
  • @$(NOOP)
  • $(INST_AUTODIR)/.exists :: /usr/lib/perl5/5.005/i386-linux/CORE/perl.h
  • @$(MKPATH) $(INST_AUTODIR)
  • @$(EQUALIZE_TIMESTAMP) /usr/lib/perl5/5.005/i386-linux/CORE/perl.h $(INST_AUTODIR)/.exists
  • -@$(CHMOD) $(PERM_RWX) $(INST_AUTODIR)
  • $(INST_LIBDIR)/.exists :: /usr/lib/perl5/5.005/i386-linux/CORE/perl.h
  • @$(MKPATH) $(INST_LIBDIR)
  • @$(EQUALIZE_TIMESTAMP) /usr/lib/perl5/5.005/i386-linux/CORE/perl.h $(INST_LIBDIR)/.exists
  • -@$(CHMOD) $(PERM_RWX) $(INST_LIBDIR)
  • $(INST_ARCHAUTODIR)/.exists :: /usr/lib/perl5/5.005/i386-linux/CORE/perl.h
  • @$(MKPATH) $(INST_ARCHAUTODIR)
  • @$(EQUALIZE_TIMESTAMP) /usr/lib/perl5/5.005/i386-linux/CORE/perl.h $(INST_ARCHAUTODIR)/.exists
  • -@$(CHMOD) $(PERM_RWX) $(INST_ARCHAUTODIR)
  • config :: $(INST_MAN3DIR)/.exists
  • @$(NOOP)
  • $(INST_MAN3DIR)/.exists :: /usr/lib/perl5/5.005/i386-linux/CORE/perl.h
  • @$(MKPATH) $(INST_MAN3DIR)
  • @$(EQUALIZE_TIMESTAMP) /usr/lib/perl5/5.005/i386-linux/CORE/perl.h $(INST_MAN3DIR)/.exists
  • -@$(CHMOD) $(PERM_RWX) $(INST_MAN3DIR)
  • help:
  • perldoc ExtUtils::MakeMaker
  • Version_check:
  • @$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) \
  •   -MExtUtils::MakeMaker=Version_check \
    
  •   -e "Version_check('$(MM_VERSION)')"
    
  • — MakeMaker linkext section:

  • linkext :: $(LINKTYPE)
  • @$(NOOP)
  • — MakeMaker dlsyms section:

  • — MakeMaker dynamic section:

  • $(INST_PM) has been moved to the all: target.

  • It remains here for awhile to allow for old usage: “make dynamic”

  • #dynamic :: Makefile $(INST_DYNAMIC) $(INST_BOOT) $(INST_PM)
  • dynamic :: Makefile $(INST_DYNAMIC) $(INST_BOOT)
  • @$(NOOP)
  • — MakeMaker dynamic_bs section:

  • BOOTSTRAP =
  • — MakeMaker dynamic_lib section:

  • — MakeMaker static section:

  • $(INST_PM) has been moved to the all: target.

  • It remains here for awhile to allow for old usage: “make static”

  • #static :: Makefile $(INST_STATIC) $(INST_PM)
  • static :: Makefile $(INST_STATIC)
  • @$(NOOP)
  • — MakeMaker static_lib section:

  • — MakeMaker manifypods section:

  • POD2MAN_EXE = /usr/bin/pod2man
  • POD2MAN = $(PERL) -we ‘%m=@ARGV;for (keys %m){’ \
  • -e ‘next if -e $$m{$$} && -M $$m{$$} < -M $$_ && -M $$m{$$_} < -M “Makefile”;’ \
  • -e ‘print “Manifying $$m{$$_}\n”;’ \
  • -e ‘system(qq[$$^X ].q[“-I$(PERL_ARCHLIB)” “-I$(PERL_LIB)” $(POD2MAN_EXE) ].qq[$$>$$m{$$}])==0 or warn “Couldn\047t install $$m{$$_}\n”;’ \
  • -e ‘chmod(oct($(PERM_RW))), $$m{$$} or warn "chmod $(PERM_RW) $$m{$$}: $$!\n";}’
  • manifypods : pure_all EasySearch.pm
  • @$(POD2MAN) \
  • EasySearch.pm \
  • $(INST_MAN3DIR)/DBIx::EasySearch.$(MAN3EXT)
  • — MakeMaker processPL section:

  • — MakeMaker installbin section:

  • — MakeMaker subdirs section:

  • none

  • — MakeMaker clean section:

  • Delete temporary files but do not touch installed files. We don’t delete

  • the Makefile here so a later make realclean still has a makefile to use.

  • clean ::
  • -rm -rf ./blib $(MAKE_APERL_FILE) $(INST_ARCHAUTODIR)/extralibs.all perlmain.c mon.out core so_locations pm_to_blib ~ /~ //~ *$(OBJ_EXT) *$(LIB_EXT) perl.exe $(BOOTSTRAP) $(BASEEXT).bso $(BASEEXT).def $(BASEEXT).exp
  • -mv Makefile Makefile.old $(DEV_NULL)
  • — MakeMaker realclean section:

  • Delete temporary files (via clean) and also delete installed files

  • realclean purge :: clean
  • rm -rf $(INST_AUTODIR) $(INST_ARCHAUTODIR)
  • rm -f $(INST_LIBDIR)/EasySearch.pm
  • rm -rf Makefile Makefile.old
  • — MakeMaker dist_basics section:

  • distclean :: realclean distcheck
  • distcheck :
  • $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=fullcheck \
  •   -e fullcheck
    
  • skipcheck :
  • $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=skipcheck \
  •   -e skipcheck
    
  • manifest :
  • $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=mkmanifest \
  •   -e mkmanifest
    
  • — MakeMaker dist_core section:

  • dist : $(DIST_DEFAULT)
  • @$(PERL) -le 'print “Warning: Makefile possibly out of date with $$vf” if ’ \
  •   -e '-e ($$vf="$(VERSION_FROM)") and -M $$vf < -M "Makefile";'
    
  • tardist : $(DISTVNAME).tar$(SUFFIX)
  • zipdist : $(DISTVNAME).zip
  • $(DISTVNAME).tar$(SUFFIX) : distdir
  • $(PREOP)
  • $(TO_UNIX)
  • $(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME)
  • $(RM_RF) $(DISTVNAME)
  • $(COMPRESS) $(DISTVNAME).tar
  • $(POSTOP)
  • $(DISTVNAME).zip : distdir
  • $(PREOP)
  • $(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME)
  • $(RM_RF) $(DISTVNAME)
  • $(POSTOP)
  • uutardist : $(DISTVNAME).tar$(SUFFIX)
  • uuencode $(DISTVNAME).tar$(SUFFIX) \
  •   $(DISTVNAME).tar$(SUFFIX) > \
    
  •   $(DISTVNAME).tar$(SUFFIX)_uu
    
  • shdist : distdir
  • $(PREOP)
  • $(SHAR) $(DISTVNAME) > $(DISTVNAME).shar
  • $(RM_RF) $(DISTVNAME)
  • $(POSTOP)
  • — MakeMaker dist_dir section:

  • distdir :
  • $(RM_RF) $(DISTVNAME)
  • $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=manicopy,maniread \
  •   -e "manicopy(maniread(),'$(DISTVNAME)', '$(DIST_CP)');"
    
  • — MakeMaker dist_test section:

  • disttest : distdir
  • cd $(DISTVNAME) && $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) Makefile.PL
  • cd $(DISTVNAME) && $(MAKE)
  • cd $(DISTVNAME) && $(MAKE) test
  • — MakeMaker dist_ci section:

  • ci :
  • $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=maniread \
  •   -e "@all = keys %{ maniread() };" \
    
  •   -e 'print("Executing $(CI) @all\n"); system("$(CI) @all");' \
    
  •   -e 'print("Executing $(RCS_LABEL) ...\n"); system("$(RCS_LABEL) @all");'
    
  • — MakeMaker install section:

  • install :: all pure_install doc_install
  • install_perl :: all pure_perl_install doc_perl_install
  • install_site :: all pure_site_install doc_site_install
  • install_ :: install_site
  • @echo INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
  • pure_install :: pure_$(INSTALLDIRS)_install
  • doc_install :: doc_$(INSTALLDIRS)_install
  • @echo Appending installation info to $(INSTALLARCHLIB)/perllocal.pod
  • pure__install : pure_site_install
  • @echo INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
  • doc__install : doc_site_install
  • @echo INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
  • pure_perl_install ::
  • @$(MOD_INSTALL) \
  •   read $(PERL_ARCHLIB)/auto/$(FULLEXT)/.packlist \
    
  •   write $(INSTALLARCHLIB)/auto/$(FULLEXT)/.packlist \
    
  •   $(INST_LIB) $(INSTALLPRIVLIB) \
    
  •   $(INST_ARCHLIB) $(INSTALLARCHLIB) \
    
  •   $(INST_BIN) $(INSTALLBIN) \
    
  •   $(INST_SCRIPT) $(INSTALLSCRIPT) \
    
  •   $(INST_MAN1DIR) $(INSTALLMAN1DIR) \
    
  •   $(INST_MAN3DIR) $(INSTALLMAN3DIR)
    
  • @$(WARN_IF_OLD_PACKLIST) \
  •   $(SITEARCHEXP)/auto/$(FULLEXT)
    
  • pure_site_install ::
  • @$(MOD_INSTALL) \
  •   read $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist \
    
  •   write $(INSTALLSITEARCH)/auto/$(FULLEXT)/.packlist \
    
  •   $(INST_LIB) $(INSTALLSITELIB) \
    
  •   $(INST_ARCHLIB) $(INSTALLSITEARCH) \
    
  •   $(INST_BIN) $(INSTALLBIN) \
    
  •   $(INST_SCRIPT) $(INSTALLSCRIPT) \
    
  •   $(INST_MAN1DIR) $(INSTALLMAN1DIR) \
    
  •   $(INST_MAN3DIR) $(INSTALLMAN3DIR)
    
  • @$(WARN_IF_OLD_PACKLIST) \
  •   $(PERL_ARCHLIB)/auto/$(FULLEXT)
    
  • doc_perl_install ::
  • -@$(DOC_INSTALL) \
  •   "Module" "$(NAME)" \
    
  •   "installed into" "$(INSTALLPRIVLIB)" \
    
  •   LINKTYPE "$(LINKTYPE)" \
    
  •   VERSION "$(VERSION)" \
    
  •   EXE_FILES "$(EXE_FILES)" \
    
  •   >> $(INSTALLARCHLIB)/perllocal.pod
    
  • doc_site_install ::
  • -@$(DOC_INSTALL) \
  •   "Module" "$(NAME)" \
    
  •   "installed into" "$(INSTALLSITELIB)" \
    
  •   LINKTYPE "$(LINKTYPE)" \
    
  •   VERSION "$(VERSION)" \
    
  •   EXE_FILES "$(EXE_FILES)" \
    
  •   >> $(INSTALLARCHLIB)/perllocal.pod
    
  • uninstall :: uninstall_from_$(INSTALLDIRS)dirs
  • uninstall_from_perldirs ::
  • @$(UNINSTALL) $(PERL_ARCHLIB)/auto/$(FULLEXT)/.packlist
  • uninstall_from_sitedirs ::
  • @$(UNINSTALL) $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist
  • — MakeMaker force section:

  • Phony target to force checking subdirectories.

  • FORCE:
  • @$(NOOP)
  • — MakeMaker perldepend section:

  • — MakeMaker makefile section:

  • We take a very conservative approach here, but it's worth it.

  • We move Makefile to Makefile.old here to avoid gnu make looping.

  • Makefile : Makefile.PL $(CONFIGDEP)
  • @echo “Makefile out-of-date with respect to $?”
  • @echo “Cleaning current config before rebuilding Makefile…”
  • -@$(RM_F) Makefile.old
  • -@$(MV) Makefile Makefile.old
  • -$(MAKE) -f Makefile.old clean $(DEV_NULL) || $(NOOP)
  • $(PERL) “-I$(PERL_ARCHLIB)” “-I$(PERL_LIB)” Makefile.PL
  • @echo “==> Your Makefile has been rebuilt. <==”
  • @echo “==> Please rerun the make command. <==”
  • false
  • To change behavior to :: would be nice, but would break Tk b9.02

  • so you find such a warning below the dist target.

  • #Makefile :: $(VERSION_FROM)
  • @echo “Warning: Makefile possibly out of date with $(VERSION_FROM)”

  • — MakeMaker staticmake section:

  • — MakeMaker makeaperl section —

  • MAP_TARGET = perl
  • FULLPERL = /usr/bin/perl
  • $(MAP_TARGET) :: static $(MAKE_APERL_FILE)
  • $(MAKE) -f $(MAKE_APERL_FILE) $@
  • $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE)
  • @echo Writing "$(MAKE_APERL_FILE)" for this $(MAP_TARGET)
  • @$(PERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) \
  •   Makefile.PL DIR= \
    
  •   MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \
    
  •   MAKEAPERL=1 NORECURS=1 CCCDLFLAGS=
    
  • — MakeMaker test section:

  • TEST_VERBOSE=0
  • TEST_TYPE=test_$(LINKTYPE)
  • TEST_FILE = test.pl
  • TEST_FILES =
  • TESTDB_SW = -d
  • testdb :: testdb_$(LINKTYPE)
  • test :: $(TEST_TYPE)
  • test_dynamic :: pure_all
  • PERL_DL_NONLAZY=1 $(FULLPERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(TEST_FILE)
  • testdb_dynamic :: pure_all
  • PERL_DL_NONLAZY=1 $(FULLPERL) $(TESTDB_SW) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(TEST_FILE)
  • test_ : test_dynamic
  • test_static :: test_dynamic
  • testdb_static :: testdb_dynamic
  • — MakeMaker ppd section:

  • Creates a PPD (Perl Package Description) for a binary distribution.

  • ppd:
  • @$(PERL) -e “print qq{<SOFTPKG NAME="DBIx-EasySearch" VERSION="0,05,0,0">\n}. qq{\tDBIx-EasySearch\n}. qq{\t\n}. qq{\t\n}. qq{\t\n}. qq{\t\t<OS NAME="$(OSNAME)" />\n}. qq{\t\t<A
    RCHITECTURE NAME="i386-linux" />\n}. qq{\t\t<CODEBASE HREF="" />\n}. qq{\t\n}. qq{\n}” > DBIx-EasySearch.ppd
  • — MakeMaker pm_to_blib section:

  • pm_to_blib: $(TO_INST_PM)
  • @$(PERL) “-I$(INST_ARCHLIB)” “-I$(INST_LIB)” \
  • “-I$(PERL_ARCHLIB)” “-I$(PERL_LIB)” -MExtUtils::Install \
  •     -e "pm_to_blib({qw{$(PM_TO_BLIB)}},'$(INST_LIB)/auto')"
    
  • @$(TOUCH) $@
  • — MakeMaker selfdocument section:

  • — MakeMaker postamble section:

  • End.

diff -c /dev/null ‘work/lib/DBIx/DBIx-EasySearch/Makefile.PL’
Index: ./lib/DBIx/DBIx-EasySearch/Makefile.PL
*** ./lib/DBIx/DBIx-EasySearch/Makefile.PL Wed Dec 31 16:00:00 1969
— ./lib/DBIx/DBIx-EasySearch/Makefile.PL Fri Aug 11 23:28:59 2000
*** 0 ****
— 1,7 ----

  • use ExtUtils::MakeMaker;
  • See lib/ExtUtils/MakeMaker.pm for details of how to influence

  • the contents of the Makefile that is written.

  • WriteMakefile(
  • 'NAME'	=> 'DBIx::EasySearch',
    
  • 'VERSION_FROM' => 'EasySearch.pm', # finds $VERSION
    
  • );
    diff -c /dev/null ‘work/lib/DBIx/DBIx-EasySearch/blib/lib/DBIx/EasySearch.pm’
    Index: ./lib/DBIx/DBIx-EasySearch/blib/lib/DBIx/EasySearch.pm
    *** ./lib/DBIx/DBIx-EasySearch/blib/lib/DBIx/EasySearch.pm Wed Dec 31 16:00:00 1969
    — ./lib/DBIx/DBIx-EasySearch/blib/lib/DBIx/EasySearch.pm Fri Aug 11 18:07:18 2000
    *** 0 ****
    — 1,716 ----
  • $Header: /cvsroot/twort/rt/lib/DBIx/EasySearch.pm,v 1.2 2000/08/03 13:15:03 tobix Exp $

  • {{{ Version, package, new, etc

  • package DBIx::EasySearch;
  • use strict;
  • use vars qw($VERSION);
  • $VERSION = ‘0.05’;
  • {{{ sub new

  • #instantiate a new object.
  • sub new {
  • my $proto = shift;
  • my $class = ref($proto) || $proto;
  • my $self = {};
  • bless ($self, $class);
  • $self->Init(@);
  • return ($self)
  • }
  • }}}

  • }}}

  • {{{ Methods dealing with Record objects (navigation)

  • {{{ sub Next

  • sub Next {
  • my $self = shift;
  • my @row;
  • if (!$self->_isLimited) {
  • return(0);
    
  • }
  • if ($self->{‘must_redo_search’} != 0) {
  • $self->_DoSearch();
    
  • }
  • if ($self->{‘itemscount’} < $self->{‘rows’}) {
  • #increment the itemcounter.
    
  • $self->{'itemscount'}++;
    
  • #serve out that item
    
  • return ($self->{'items'}[$self->{'itemscount'}]);
    
  • }
  • else {
  • #we've gone through the whole list.
    
  • #reset the count.
    
  • $self->{'itemscount'} = 0;
    
  • return(undef);
    
  • }
  • }
  • }}}

  • {{{ sub GotoFirstItem

  • sub GotoFirstItem {
  • my $self = shift;
  • $self->GotoItem(0);
  • }
  • }}}

  • {{{ sub GotoItem

  • sub GotoItem {
  • my $self = shift;
  • my $item = shift;
  • $self->{‘itemscount’} = $item;
  • }
  • }}}

  • {{{ sub First

  • sub First {
  • my $self = shift;
  • #Reset the itemcount
  • $self->GotoFirstItem();
  • return ($self->Next);
  • }
  • }}}

  • {{{ sub NewItem

  • sub NewItem {
  • my $self = shift;
  • my $foo = (caller(1))[3];
  • die “DBIx::EasySearch needs to be subclassed. you can’t use it directly. ($foo)\n”;
  • }
  • }}}

  • }}}

  • {{{ Routines dealing with Restrictions (where subclauses) and ordering

  • {{{ sub UnLimit

  • sub UnLimit {
  • my $self=shift;
  • $self->_isLimited(-1);
  • }
  • }}}

  • {{{ sub Limit

  • This clearly needs to be documented a bit … this is how TobiX has

  • understood this:

  • TABLE can be set to something different than this table if a join is

  • wanted (that means we can’t do recursive joins as for now). Unless

  • ALIAS is set, the join criterias will be taken from EXT_LINKFIELD

  • and INT_LINKFIELD and added to the criterias. If ALIAS is set, new

  • criterias about the foreign table will be added.

  • VALUE should always be set and will always be quoted. Maybe TYPE

  • should imply that the value shouldn’t be quoted? IMO (TobiX) we

  • shouldn’t use quoted values, we should rather use placeholders and

  • pass the arguments when executing the statement. This will also

  • allow us to alter limits and reexecute the search with a low cost by

  • keeping the statement handler.

  • ENTRYAGGREGATOR might be or or and or whatever :slight_smile: TobiX hasn’t

  • understood how to recurse (like (true or (false and true) or (true

  • and true and true)))

  • OPERATOR is whatever should be putted in between the FIELD and the

  • VALUE.

  • ORDERBY is the SQL ORDERBY

  • ORDER can be ASCending or DESCending.

  • sub Limit {
  • my $self = shift;
  • my %args = (
  •     TABLE => $self->{'table'},
    
  •     FIELD => undef,
    
  •     VALUE => undef,
    
  •     ALIAS => undef,
    
  •     TYPE => undef,  #TODO: figure out why this is here
    
  •     ENTRYAGGREGATOR => 'or',
    
  •     INT_LINKFIELD => ($self->{'primary_key'} || 'id'),
    
  •     EXT_LINKFIELD => 'id',
    
  •     OPERATOR => '=',
    
  •     ORDERBY => undef,
    
  •     ORDER => undef,
    
  •     @_ # get the real argumentlist
    
  •    );
    
  • my ($Alias);
  • if ($args{‘FIELD’}) {
  • #If it's a like, we supply the %s around the search term
    
  • if ($args{'OPERATOR'} eq "LIKE") {
    
  •   $args{'VALUE'} = "%".$args{'VALUE'} ."%";
    
  • }
    
  • $args{'VALUE'} = $self->_Handle->dbh->quote($args{'VALUE'});
    
  • }
  • $Alias = $self->_GenericRestriction(%args);
  • warn “No table alias set!”
  •   unless $Alias;
    
  • {{{ Set $self->{order} - can be "ASC"ending or "DESC"ending.

  • if ($args{‘ORDER’}) {
  • $self->{'order'} = $args{'ORDER'};
    
  • }
  • }}}

  • {{{ If we’re setting an OrderBy, set $self->{‘orderby’} here

  • if ($args{‘ORDERBY’}) {
  • # 1. if an alias was passed in, use that. 
    
  • if ($args{'ALIAS'}) {
    
  •   $self->{'orderby'} = $args{'ALIAS'}.".".$args{'ORDERBY'};
    
  • }
    
  • # 2. if an alias was generated, use that.
    
  • elsif ($Alias) {
    
  •    $self->{'orderby'} = "$Alias.".$args{'ORDERBY'};
    
  •  }
    
  • # 3. use the primary
    
  • else {
    
  •   $self->{'orderby'} = "main.".$args{'ORDERBY'};
    
  • }
    
  • }
  • }}}

  • We’re now limited. people can do searches.

  • $self->_isLimited(1);
  • if (defined ($Alias)) {
  • return($Alias);
    
  • }
  • else {
  • return(0);
    
  • }
  • }
  • }}}

  • {{{ sub ShowRestrictions

  • #Show Restrictions
  • sub ShowRestrictions {
  • my $self = shift;
  • $self->_CompileGenericRestrictions();
  • $self->_CompileSubClauses();
  • return($self->{‘where_clause’});
  • }
  • }}}

  • {{{ sub ImportRestrictions

  • #import a restrictions clause
  • sub ImportRestrictions {
  • my $self = shift;
  • $self->{‘where_clause’} = shift;
  • }
  • }}}

  • {{{ sub _GenericRestriction

  • sub _GenericRestriction {
  • my $self = shift;
    
  • my %args = (
    
  •   TABLE => $self->{'table'},
    
  •   FIELD => undef,
    
  •   VALUE => undef,	#TODO: $Value should take an array of values and generate 
    
  •                   #the proper where clause.
    
  •   ALIAS => undef,	     
    
  •   ENTRYAGGREGATOR => undef,
    
  •   OPERATOR => '=',
    
  •   INT_LINKFIELD => undef,
    
  •   EXT_LINKFIELD => undef,
    
  •   RESTRICTION_TYPE => 'generic', 
    
  •   @_);
    
  • my ($QualifiedField);
    
  • #since we're changing the search criteria, we need to redo the search
    
  • $self->{'must_redo_search'}=1;
    
  • # {{{ if there's no alias set, we need to set it
    
  • if (!$args{'ALIAS'}) {
    
  • #if the table we’re looking at is the same as the main table
  • if ($args{‘TABLE’} eq $self->{‘table’}) {
  •   # main is the alias of the "primary 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'})
    
  •   or warn;
    
  •   warn "missing input parameter INT_LINKFIELD"
    
  •   unless $args{'INT_LINKFIELD'};
    
  •   warn "missing input parameter EXT_LINKFIELD"
    
  •   unless $args{'EXT_LINKFIELD'};
    
  •   # we need to build the table of links.
    
  •   $self->{'table_links'} .= "AND main.". $args{'INT_LINKFIELD'}."=".
    
  •     $args{'ALIAS'}.".".$args{'EXT_LINKFIELD'};
    
  • }
  • }}}

  • }
    
  • # }}}
    
  • # If we were just setting an alias, return
    
  • if (!$args{'FIELD'}) {
    
  • return ($args{‘ALIAS’});
  • }
    
  • #Set this to the name of the field and the alias.
    
  • $QualifiedField = $args{'ALIAS'}.".".$args{'FIELD'};
    
  • print STDERR "DBIx::EasySearch->_GenericRestriction  QualifiedField is $QualifiedField\n" 
    
  •   if ($self->DEBUG);
    
  • #If we're overwriting this sort of restriction, 
    
  • # TODO: Something seems wrong here ... I kept getting warnings until I putted in all this crap.
    
  • # Shouldn't we have a default setting somewhere? -- TobiX
    
  • if (((exists $args{'ENTRYAGGREGATOR'}) and ($args{'ENTRYAGGREGATOR'}||"") eq 'none') or 
    
  • (!$self->{‘restrictions’}{“$QualifiedField”})) {
  • $self->{‘restrictions’}{“$QualifiedField”} =
  • "($QualifiedField $args{'OPERATOR'} $args{'VALUE'})";  
    
  • }
    
  • else {
    
  • $self->{‘restrictions’}{“$QualifiedField”} .=
  • " $args{'ENTRYAGGREGATOR'} ($QualifiedField $args{'OPERATOR'} $args{'VALUE'})";
    
  • }
    
  • return ($args{'ALIAS'});
    
  • }
  • }}}

  • {{{ sub _AddRestriction

  • sub _AddSubClause {
  • my $self = shift;
    
  • my $clauseid = shift;
    
  • my $subclause = shift;
    
  • $self->{'subclauses'}{"$clauseid"} = $subclause;
    
  • }
  • }}}

  • {{{ sub _WhereClause

  • sub _WhereClause {
  • 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 EasySearch 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 ";
    
  • }
  • warn “$self $subclause doesn’t exist”
  •  if (!defined $self->{'subclauses'}{"$subclause"});
    
  • $where_clause .= $self->{‘subclauses’}{“$subclause”};
  • }
  • $where_clause = " WHERE " . $where_clause if ($where_clause ne ‘’);
  • return ($where_clause);
  • }
  • }}}

  • {{{ sub _CompileGenericRestrictions

  • #Compile the restrictions to a WHERE Clause
  • sub _CompileGenericRestrictions {
  • my $self = shift;
    
  • my ($restriction);
    
  • $self->{'subclauses'}{'generic_restrictions'} = undef;
    
  • #Go through all the restrictions of this type. Buld up the generic subclause
    
  • foreach $restriction (keys %{ $self->{'restrictions'}}) {
    
  • if (defined $self->{‘subclauses’}{‘generic_restrictions’}) {
  •   $self->{'subclauses'}{'generic_restrictions'} .= " AND ";
    
  • }
  • $self->{‘subclauses’}{‘generic_restrictions’} .=
  • "(" . $self->{'restrictions'}{"$restriction"} . ")";
    
  • }
    
  • }
  • }}}

  • {{{ sub _Order

  • This routine returns what the result set should be ordered by

  • sub _Order {
  • my $self = shift;
  • my $OrderClause;
  • if ($self->{‘orderby’}) {
  • $OrderClause = " ORDER BY ". $self->{'orderby'};
    
  • }
  • else {
  • $OrderClause = " ORDER BY main.".$self->{'primary_key'}." ";
    
  • }
  • return ($OrderClause);
  • }
  • }}}

  • {{{ sub _OrderBy

  • This routine returns whether the result set should be sorted Ascending or Descending

  • sub _OrderBy {
  • my $self = shift;
  • my $order_by;
  • if ($self->{‘order’} =~ /[2]es/) {
  • $order_by = " DESC";
    
  • }
  • else {
  • $order_by = " ASC";
    
  • }
  • return($order_by);
  • }
  • }}}

  • }}}

  • {{{ routines dealing with table aliases

  • {{{ sub NewAlias

  • sub NewAlias {
  • #TODO Stub
    
  • my $self = shift;
    
  • my $table = shift || die "Missing parameter";
    
  • my $alias=$table."_".$self->{'alias_count'};
    
  • $self->{'aliases'}[$self->{'alias_count'}]{'alias'} = $alias;
    
  • $self->{'aliases'}[$self->{'alias_count'}]{'table'} = $table;
    
  • $self->{'alias_count'}++;
    
  • return $alias;
    
  • }
  • }}}

  • {{{ sub _TableAliases

  • sub _TableAliases {
  • my $self = shift;
    
  • # Set up the first alias. for the _main_ table
    
  • my $compiled_aliases = $self->{'table'}." AS main";
    
  • # Go through all the other aliases we set up and build the compiled
    
  • # aliases string
    
  • for my $count (0..($self->{'alias_count'}-1)) {
    
  • $compiled_aliases .= ", ".
  • $self->{'aliases'}[$count]{'table'}. " as ".
    
  •   $self->{'aliases'}[$count]{'alias'};
    
  • }
    
  • return ($compiled_aliases);
    
  • }
  • }}}

  • things we’ll want to add:

  • get aliases

  • add restirction clause

  • }}}

  • {{{ private utility methods

  • {{{ sub _Init

  • #Initialize the object
  • sub _Init {
  • my $self = shift;
  • my %args = ( Handle => undef,
  •      @_
    
  •    );
    
  • $self->{‘DBIxHandle’} = $args{‘Handle’};
  • $self->{‘must_redo_search’}=1;
  • $self->{‘itemscount’}=0;
  • $self->{‘tables’} = “”;
  • $self->{‘auxillary_tables’} = “”;
  • $self->{‘where_clause’} = “”;
  • $self->{‘table_links’} = “”;
  • $self->{‘limit_clause’} = “”;
  • $self->{‘order’} = “”;
  • $self->{‘alias_count’} = 0;
  • $self->{‘first_row’} = 0;
  • #we have no limit statements. DoSearch won’t work.
  • $self->_isLimited(0);
  • }
  • }}}

  • {{{ sub _Handle

  • sub _Handle {
  • my $self = shift;
  • return ($self->{‘DBIxHandle’});
  • }
  • }}}

  • {{{ sub _DoSearch

  • sub _DoSearch {
  • my $self = shift;
    
  • my ($QueryString, $Order);
    
  • $QueryString = "SELECT distinct main.* FROM " . $self->_TableAliases;
    
  • $QueryString .= $self->_WhereClause . " ".
    
  •   $self->{'table_links'}. " " 
    
  • if ($self->_isLimited > 0);
    
  • $QueryString .=  $self->_Order . $self->_OrderBy . $self->_Limit;
    
  •   print STDERR "DBIx::EasySearch->DoSearch Query:  $QueryString\n" 
    
  • if ($self->DEBUG);
  • {{{

  • {{{ get $self->{‘records’} out of the database

  • $self->{‘records’} = $self->_Handle->dbh->prepare($QueryString);
  • if (!$self->{‘records’}) {
  • die "Error:" . $self->_Handle->dbh->errstr . "\n";
    
  • }
  • if (!$self->{‘records’}->execute) {
  • die "DBIx::EasySearch error:" . $self->{'records'}->errstr . "\n\tQuery String is $QueryString\n";
    
  • }
  • }}}

  • # populate $self->{'rows'} for $Count;
    
  • $self->{'rows'} = $self->{'records'}->rows();
    
  • my $counter = 0;
    
  • # {{{ Iterate through all the rows returned and get child objects
    
  • TODO: this could be made much more efficient

  • while (my $row = $self->{‘records’}->fetchrow_hashref()) {
  • $counter++;
    
  • $self->{'items'}[$counter] = $self->NewItem();
    
  • $self->{'items'}[$counter]->LoadFromHash($row);
    
  • print STDERR "ID is ". $self->{'items'}[$counter]->Id()."\n"
    
  • if ($self->DEBUG);
    
  • }
  • 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};
    
  • }}}

  • $self->{'must_redo_search'}=0;
    
  • return($self->Count);
    
  • }
  • }}}

  • {{{ sub _Limit

  • sub _Limit {
  • my $self = shift;
  • my $limit_clause;
  • LIMIT clauses are used for restricting ourselves to subsets of the search.

  • if ( $self->Rows) {
  • $limit_clause = " LIMIT ";
    
  • if ($self->FirstRow != 0) {
    
  •   $limit_clause .= $self->FirstRow . ", ";
    
  • }
    
  • $limit_clause .= $self->Rows;
    
  • }
  • else {
  • $limit_clause = "";
    
  • }
  • return $limit_clause;
  • }
  • }}}

  • {{{ sub _isLimited

  • sub _isLimited {
  • my $self = shift;
    
  • if (@_) {
    
  • $self->{‘is_limited’} = shift;
  • }
    
  • else {
    
  • return ($self->{‘is_limited’});
  • }
    
  • }
  • }}}

  • }}} Private utility methods

  • {{{ sub Rows

  • This restricts the # of rows returned in a result

  • sub Rows {
  • my $self = shift;
  • if (@_) {
  • $self->{'show_rows'} = shift;
    
  • }
  • return ($self->{‘show_rows’});
  • }
  • }}}

  • {{{ sub FirstRow

  • returns the first row

  • sub FirstRow {
  • my $self = shift;
  • if (@_) {
  • $self->{'first_row'} = shift;
    
  • #SQL starts counting at 0
    
  • $self->{'first_row'}--;
    
  • }
  • return ($self->{‘first_row’});
  • }
  • }}}

  • {{{ Public utility methods

  • {{{ Counter, Count and IsLast

  • sub Counter {
  • return $_[0]->{'itemscount'};
    
  • }
  • {{{ sub Count

  • sub Count {
  • my $self = shift;
    
  • if ($self->{'must_redo_search'}) {
    
  • return ($self->_DoSearch);
  • }
    
  • else {
    
  • return($self->{‘rows’});
  • }
    
  • }
  • sub IsLast {
  • return $_[0]->{'itemscount'}==$_[0]->{'rows'};
    
  • }
  • }}}

  • {{{ sub DEBUG

  • sub DEBUG {
  • my $self = shift;
    
  • if (@_) {
    
  • $self->{‘DEBUG’} = shift;
  •   }
    
  • return ($self->{'DEBUG'});
    
  • }
  • }}}

  • }}}

  • }}}

  • 1;
  • END
  • {{{ POD

  • =head1 NAME
  • DBIx::EasySearch - Perl extension for easy SQL SELECT Statement generation
  • =head1 SYNOPSIS
  • use DBIx::EasySearch;
  • then read the code. (yes, i’m being lame)
  • =head1 DESCRIPTION
  • Jesse is lame and hasn’t written docs yet
  • =head1 AUTHOR
  • Jesse Vincent, jesse@fsck.com
  • =head1 SEE ALSO
  • DBIx::Handle, DBIx::Record, perl(1).
  • =cut
  • }}}

diff -c /dev/null ‘work/lib/DBIx/DBIx-EasySearch/blib/man3/DBIx::EasySearch.3pm’
Index: ./lib/DBIx/DBIx-EasySearch/blib/man3/DBIx::EasySearch.3pm
*** ./lib/DBIx/DBIx-EasySearch/blib/man3/DBIx::EasySearch.3pm Wed Dec 31 16:00:00 1969
— ./lib/DBIx/DBIx-EasySearch/blib/man3/DBIx::EasySearch.3pm Fri Aug 11 23:43:18 2000
*** 0 ****
— 1,220 ----

  • .rn ‘’ }`
  • ‘’’ $RCSfile$$Revision$$Date$
  • ‘’’
  • ‘’’ $Log$
  • ‘’’
  • .de Sh
  • .br
  • .if t .Sp
  • .ne 5
  • .PP
  • \fB\$1\fR
  • .PP
  • .de Sp
  • .if t .sp .5v
  • .if n .sp
  • .de Ip
  • .br
  • .ie \n(.$>=3 .ne \$3
  • .el .ne 3
  • .IP “\$1” \$2
  • .de Vb
  • .ft CW
  • .nf
  • .ne \$1
  • .de Ve
  • .ft R
  • .fi
  • ‘’’
  • ‘’’
  • ‘’’ Set up *(-- to give an unbreakable dash;
  • ‘’’ string Tr holds user defined translation string.
  • ‘’’ Bell System Logo is used as a dummy character.
  • ‘’’
  • .tr (*W-|(bv*(Tr
  • .ie n {\
  • .ds – (*W-
  • .ds PI pi
  • .if (\n(.H=4u)&(1m=24u) .ds – (*W\h’-12u’(*W\h’-12u’-" diablo 10 pitch
  • .if (\n(.H=4u)&(1m=20u) .ds – (*W\h’-12u’(*W\h’-8u’-" diablo 12 pitch
  • .ds L" “”
  • .ds R" “”
  • ‘’’ *(M", *(S", *(N" and *(T" are the equivalent of
  • ‘’’ *(L" and *(R", except that they are used on “.xx” lines,
  • ‘’’ such as .IP and .SH, which do another additional levels of
  • ‘’’ double-quote interpretation
  • .ds M" “”"
  • .ds S" “”"
  • .ds N" “”“”"
  • .ds T" “”“”"
  • .ds L’ ’
  • .ds R’ ’
  • .ds M’ ’
  • .ds S’ ’
  • .ds N’ ’
  • .ds T’ ’
  • 'br}
  • .el{\
  • .ds – (em|
  • .tr *(Tr
  • .ds L" ``
  • .ds R" ‘’
  • .ds M" ``
  • .ds S" ‘’
  • .ds N" ``
  • .ds T" ‘’
  • .ds L’ `
  • .ds R’ ’
  • .ds M’ `
  • .ds S’ ’
  • .ds N’ `
  • .ds T’ ’
  • .ds PI (*p
  • 'br}
  • ." If the F register is turned on, we’ll generate
  • ." index entries out stderr for the following things:
  • ." TH Title
  • ." SH Header
  • ." Sh Subsection
  • ." Ip Item
  • ." X<> Xref (embedded
  • ." Of course, you have to process the output yourself
  • ." in some meaninful fashion.
  • .if \nF {
  • .de IX
  • .tm Index:\$1\t\n%\t"\$2"
  • .nr % 0
  • .rr F
  • .}
  • .TH EasySearch 3pm “perl 5.005, patch 03” “11/Aug/2000” “User Contributed Perl Documentation”
  • .UC
  • .if n .hy 0
  • .if n .na
  • .ds C+ C\v’-.1v’\h’-1p’\s-2+\h’-1p’+\s0\v’.1v’\h’-1p’
  • .de CQ " put $1 in typewriter font
  • .ft CW
  • 'if n "\c
  • 'if t \&\$1\c
  • 'if n \&\$1\c
  • 'if n &"
  • \&\$2 \$3 \$4 \$5 \$6 \$7
  • '.ft R
  • ." @(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2
  • . " AM - accent mark definitions
  • .bd B 3
  • . " fudge factors for nroff and troff
  • .if n {\
  • . ds #H 0
  • . ds #V .8m
  • . ds #F .3m
  • . ds #[ \f1
  • . ds #] \fP
  • .}
  • .if t {\
  • . ds #H ((1u-(\\n(.fu%2u))*.13m)
  • . ds #V .6m
  • . ds #F 0
  • . ds #[ &
  • . ds #] &
  • .}
  • . " simple accents for nroff and troff
  • .if n {\
  • . ds ’ &
  • . ds ` &
  • . ds ^ &
  • . ds , &
  • . ds ~ ~
  • . ds ? ?
  • . ds ! !
  • . ds /
  • . ds q
  • .}
  • .if t {\
  • . ds ’ \k:\h’-(\n(.wu*8/10-*(#H)''\h"|\n:u"
  • . ds \\k:\h'-(\\n(.wu*8/10-\*(#H)'\\h’|\n:u’
  • . ds ^ \k:\h’-(\n(.wu*10/11-*(#H)‘^\h’|\n:u’
  • . ds , \k:\h’-(\n(.wu*8/10)‘,\h’|\n:u’
  • . ds ~ \k:\h’-(\n(.wu-*(#H-.1m)‘~\h’|\n:u’
  • . ds ? \s-2c\h’-\w’c’u7/10’\u\h’*(#H’\zi\d\s+2\h’\w’c’u8/10’
  • . ds ! \s-2(or\s+2\h’-\w’(or’u’\v’-.8m’.\v’.8m’
  • . ds / \k:\h’-(\n(.wu*8/10-*(#H)‘\z(sl\h’|\n:u’
  • . ds q o\h’-\w’o’u*8/10’\s-4\v’.4m’\z(i\v’-.4m’\s+4\h’\w’o’u8/10’
  • .}
  • . " troff and (daisy-wheel) nroff accents
  • .ds : \k:\h’-(\n(.wu*8/10-*(#H+.1m+*(#F)‘\v’-*(#V’\z.\h’.2m+*(#F’.\h’|\n:u’\v’*(#V
  • .ds 8 \h’*(#H’(*b\h’-*(#H
  • .ds v \k:\h’-(\n(.wu*9/10-*(#H)‘\v’-*(#V’*(#[\s-4v\s0\v’*(#V’\h’|\n:u’*(#]
  • .ds _ \k:\h’-(\n(.wu9/10-*(#H+(*(#F2/3))‘\v’-.4m’\z(hy\v’.4m’\h’|\n:u’
  • .ds . \k:\h’-(\n(.wu8/10)‘\v’*(#V4/10’\z.\v’-*(#V*4/10’\h’|\n:u’
  • .ds 3 *(#[\v’.2m’\s-2&3\s0\v’-.2m’*(#]
  • .ds o \k:\h’-(\n(.wu+\w’(de’u-*(#H)/2u’\v’-.3n’*(#[\z(de\v’.3n’\h’|\n:u’*(#]
  • .ds d- \h’*(#H’(pd\h’-\w’~‘u’\v’-.25m’\f2(hy\fP\v’.25m’\h’-*(#H
  • .ds D- D\k:\h’-\w’D’u’\v’-.11m’\z(hy\v’.11m’\h’|\n:u’
  • .ds th *(#[\v’.3m’\s+1I\s-1\v’-.3m’\h’-(\w’I’u*2/3)'\s-1o\s+1*(#]
  • .ds Th *(#[\s+2I\s-2\h’-\w’I’u*3/5’\v’-.3m’o\v’.3m’*(#]
  • .ds ae a\h’-(\w’a’u*4/10)'e
  • .ds Ae A\h’-(\w’A’u*4/10)'E
  • .ds oe o\h’-(\w’o’u*4/10)'e
  • .ds Oe O\h’-(\w’O’u*4/10)'E
  • . " corrections for vroff
  • .if v .ds ~ \k:\h’-(\n(.wu*9/10-*(#H)‘\s-2\u~\d\s+2\h’|\n:u’
  • .if v .ds ^ \k:\h’-(\n(.wu*10/11-*(#H)‘\v’-.4m’^\v’.4m’\h’|\n:u’
  • . " for low resolution devices (crt and lpr)
  • .if \n(.H>23 .if \n(.V>19 \
  • {\
  • . ds : e
  • . ds 8 ss
  • . ds v \h’-1’\o’(aa(ga’
  • . ds _ \h’-1’^
  • . ds . \h’-1’.
  • . ds 3 3
  • . ds o a
  • . ds d- d\h’-1’(ga
  • . ds D- D\h’-1’(hy
  • . ds th \o’bp’
  • . ds Th \o’LP’
  • . ds ae ae
  • . ds Ae AE
  • . ds oe oe
  • . ds Oe OE
  • .}
  • .rm #[ #] #H #V #F C
  • .SH “NAME”
  • DBIx::EasySearch - Perl extension for easy SQL SELECT Statement generation
  • .SH “SYNOPSIS”
  • .PP
  • .Vb 1
  • & use DBIx::EasySearch;
  • .Ve
  • .Vb 1
  • & then read the code. (yes, i’m being lame)
  • .Ve
  • .SH “DESCRIPTION”
  • Jesse is lame and hasn’t written docs yet
  • .SH “AUTHOR”
  • Jesse Vincent, jesse@fsck.com
  • .SH “SEE ALSO”
  • DBIx::Handle, DBIx::Record, \fIperl\fR|(1).
  • .rn }` ‘’
  • .IX Title “EasySearch 3pm”
  • .IX Name “DBIx::EasySearch - Perl extension for easy SQL SELECT Statement generation”
  • .IX Header “NAME”
  • .IX Header “SYNOPSIS”
  • .IX Header “DESCRIPTION”
  • .IX Header “AUTHOR”
  • .IX Header “SEE ALSO”
    diff -c /dev/null ‘work/lib/DBIx/DBIx-EasySearch/test.pl’
    Index: ./lib/DBIx/DBIx-EasySearch/test.pl
    *** ./lib/DBIx/DBIx-EasySearch/test.pl Wed Dec 31 16:00:00 1969
    — ./lib/DBIx/DBIx-EasySearch/test.pl Fri Aug 11 23:28:59 2000
    *** 0 ****
    — 1,20 ----
  • Before `make install’ is performed this script should be runnable with

  • make test'. After make install’ it should work as `perl test.pl’

  • ######################### We start with some black magic to print on failure.
  • Change 1…1 below to 1…last_test_to_print .

  • (It may become useful if the test is moved to ./t subdirectory.)

  • BEGIN { $| = 1; print “1…1\n”; }
  • END {print “not ok 1\n” unless $loaded;}
  • use DBIx::EasySearch;
  • $loaded = 1;
  • print “ok 1\n”;
  • ######################### End of black magic.
  • Insert your test code below (better if it prints “ok 13”

  • (correspondingly “not ok 13”) depending on the success of chunk 13

  • of the test code):

diff -c /dev/null ‘work/lib/DBIx/DBIx-Handle/Changes’
Index: ./lib/DBIx/DBIx-Handle/Changes
*** ./lib/DBIx/DBIx-Handle/Changes Wed Dec 31 16:00:00 1969
— ./lib/DBIx/DBIx-Handle/Changes Fri Aug 11 23:29:15 2000
*** 0 ****
— 1,5 ----

  • Revision history for Perl extension DBIx::Handle.
  • 0.01 Fri Aug 11 23:29:15 2000
    • original version; created by h2xs 1.19
      diff -c /dev/null ‘work/lib/DBIx/DBIx-Handle/Handle.pm’
      Index: ./lib/DBIx/DBIx-Handle/Handle.pm
      *** ./lib/DBIx/DBIx-Handle/Handle.pm Wed Dec 31 16:00:00 1969
      — ./lib/DBIx/DBIx-Handle/Handle.pm Fri Aug 11 23:48:52 2000
      *** 0 ****
      — 1,232 ----
  • $Header: /proj/maps/src/rt/lib/DBIx/DBIx-Handle/Handle.pm,v 1.1 2000/08/12 06:48:52 ivan Exp $

  • package DBIx::Handle;
  • use Carp;
  • use DBI;
  • use strict;
  • use vars qw($VERSION @ISA $Handle);
  • $VERSION = ‘0.02’;
  • #instantiate a new object.
  • {{{ sub new

  • sub new {
  • my $proto = shift;
  • my $class = ref($proto) || $proto;
  • my $self = {};
  • bless ($self, $class);
  • #we have no limit statements. DoSearch won’t work.
  • return ($self)
  • }
  • }}}

  • {{{ sub Connect

  • sub Connect {
  • my $self = shift;
  • my %args = ( Driver => undef,
  •      Database => undef,
    
  •      Host => 'localhost',
    
  •      User => undef,
    
  •      Password => undef,
    
  •      @_);
    
  • my $dsn;
  • $dsn = “dbi:$args{‘Driver’}:$args{‘Database’}:$args{‘Host’}”;
  • $Handle = DBI->connect_cached($dsn, $args{‘User’}, $args{‘Password’}) || croak “Connect Failed $DBI::errstr\n” ;
  • $Handle->{RaiseError}=1;
  • $Handle->{PrintError}=1;
  • return ($Handle);
  • }
  • }}}

  • {{{ sub Disconnect

  • sub Disconnect {
  • my $self = shift;
  • return ($self->dbh->disconnect());
  • }
  • {{{ sub Handle / dbh

  • sub Handle {
  • return($Handle);
  • }
  • *dbh=&Handle;
  • }}}

  • {{{ sub UpdateTableValue

  • sub UpdateTableValue {
  • my $self = shift;
  • my $Table = shift;
  • my $Col = shift;
  • my $NewValue = shift;
  • my $Record = shift;
  • my $is_sql = shift;
  • my $QueryString;
  • quote the value

  • TODO: We need some general way to escape SQL functions.

  • $NewValue=$self->safe_quote($NewValue)
  •   unless ($is_sql or
    
  •     $Col=~/^(Created|LastUpdated)$/ && $NewValue=~/^now\(\)$/i);
    
  • build the query string

  • $QueryString = “UPDATE $Table SET $Col = $NewValue WHERE id = $Record”;
  • TODO update the last edited

  • (Tobix: I think this is already taken care of by now in DBIx::Record?)

  • my $sth = $self->dbh->prepare($QueryString);
  • if (!$sth) {
  • if ($main::debug) {
    
  •   die "Error:" . $self->dbh->errstr . "\n";
    
  • }
    
  • else {
    
  •   return (0);
    
  • }
  • }
  • if (!$sth->execute) {
  • if ($self->{'debug'}) {
    
  •   die "Error:" . $sth->errstr . "\n";
    
  • }
    
  • else {
    
  •   return(0);
    
  • }
    
  • }
  • return (1); #Update Succeded
  • }
  • }}}

  • {{{ sub SimpleQuery

  • sub SimpleQuery {
  • my $self = shift;
  • my $QueryString = shift;
  • TODO update the last edited

  • my $sth = $self->dbh->prepare($QueryString);
  • if (!$sth) {
  • if ($main::debug) {
    
  •   die "Error:" . $self->dbh->errstr . "\n";
    
  • }
    
  • else {
    
  •   return (0);
    
  • }
    
  • }
  • if (!$sth->execute) {
  • if ($self->{'debug'}) {
    
  •   die "Error:" . $sth->errstr . "\n";
    
  • }
    
  • else {
    
  •   return(0);
    
  • }
    
  • }
  • return ($sth);
  • }
  • }}}

  • sub FetchResult {
  • my $self = shift;
  • my $query = shift;
  • my $sth = $self->SimpleQuery($query);
  • return ($sth->fetchrow);
  • }
  • {{{ sub safe_quote

  • sub safe_quote {
  • my $self = shift;
  • my $in_val = shift;
  • my ($out_val);
  • if (!$in_val) {
  •  return ("''");
    
  • }
  • else {
  •  $out_val = $self->dbh->quote($in_val);
    
  • }
  • return(“$out_val”);
  • }
  • }}}

  • Autoload methods go after =cut, and are processed by the autosplit program.

  • 1;
  • END
  • {{{ POD

  • =head1 NAME
  • DBIx::Handle - Perl extension which is a generic DBI handle
  • =head1 SYNOPSIS
  • use DBIx::Handle;
  • my $Handle = DBIx::Handle->new();
  • $Handle->Connect( Driver => ‘mysql’,
  •      Database => 'dbname',
    
  •      Host => 'hostname',
    
  •      User => 'dbuser',
    
  •      Password => 'dbpassword');
    
  • =head1 DESCRIPTION
  • Jesse’s a slacker.
  • Blah blah blah.
  • =head1 AUTHOR
  • Jesse Vincent, jesse@fsck.com
  • =head1 SEE ALSO
  • perl(1), DBIx::EasySearch, DBIx::Record
  • =cut
  • }}} POD

diff -c /dev/null ‘work/lib/DBIx/DBIx-Handle/MANIFEST’
Index: ./lib/DBIx/DBIx-Handle/MANIFEST
*** ./lib/DBIx/DBIx-Handle/MANIFEST Wed Dec 31 16:00:00 1969
— ./lib/DBIx/DBIx-Handle/MANIFEST Fri Aug 11 23:29:15 2000
*** 0 ****
— 1,5 ----

  • Changes
  • Handle.pm
  • MANIFEST
  • Makefile.PL
  • test.pl
    diff -c /dev/null ‘work/lib/DBIx/DBIx-Handle/Makefile’
    Index: ./lib/DBIx/DBIx-Handle/Makefile
    *** ./lib/DBIx/DBIx-Handle/Makefile Wed Dec 31 16:00:00 1969
    — ./lib/DBIx/DBIx-Handle/Makefile Fri Aug 11 23:43:18 2000
    *** 0 ****
    — 1,654 ----
  • This Makefile is for the DBIx::Handle extension to perl.

  • It was generated automatically by MakeMaker version

  • 5.4302 (Revision: 1.222) from the contents of

  • Makefile.PL. Don’t edit this file, edit Makefile.PL instead.

  • ANY CHANGES MADE HERE WILL BE LOST!

  • MakeMaker ARGV: ()

  • MakeMaker Parameters:

  • NAME => q[DBIx::Handle]

  • VERSION_FROM => q[Handle.pm]

  • — MakeMaker post_initialize section:

  • — MakeMaker const_config section:

  • These definitions are from config.sh (via /usr/lib/perl5/5.005/i386-linux/Config.pm)

  • They may have been overridden via Makefile.PL or on the command line

  • AR = ar
  • CC = cc
  • CCCDLFLAGS = -fPIC
  • CCDLFLAGS = -rdynamic
  • DLEXT = so
  • DLSRC = dl_dlopen.xs
  • LD = cc
  • LDDLFLAGS = -shared -L/usr/local/lib
  • LDFLAGS = -L/usr/local/lib
  • LIBC =
  • LIB_EXT = .a
  • OBJ_EXT = .o
  • OSNAME = linux
  • OSVERS = 2.2.15pre14
  • RANLIB = :
  • SO = so
  • EXE_EXT =
  • — MakeMaker constants section:

  • AR_STATIC_ARGS = cr
  • NAME = DBIx::Handle
  • DISTNAME = DBIx-Handle
  • NAME_SYM = DBIx_Handle
  • VERSION = 0.02
  • VERSION_SYM = 0_02
  • XS_VERSION = 0.02
  • INST_BIN = blib/bin
  • INST_EXE = blib/script
  • INST_LIB = blib/lib
  • INST_ARCHLIB = blib/arch
  • INST_SCRIPT = blib/script
  • PREFIX = /usr
  • INSTALLDIRS = site
  • INSTALLPRIVLIB = $(PREFIX)/lib/perl5
  • INSTALLARCHLIB = $(PREFIX)/lib/perl5/5.005/i386-linux
  • INSTALLSITELIB = /usr/local/lib/site_perl
  • INSTALLSITEARCH = /usr/local/lib/site_perl/i386-linux
  • INSTALLBIN = $(PREFIX)/bin
  • INSTALLSCRIPT = $(PREFIX)/bin
  • PERL_LIB = /usr/lib/perl5/5.005
  • PERL_ARCHLIB = /usr/lib/perl5/5.005/i386-linux
  • SITELIBEXP = /usr/local/lib/site_perl
  • SITEARCHEXP = /usr/local/lib/site_perl/i386-linux
  • LIBPERL_A = libperl.a
  • FIRST_MAKEFILE = Makefile
  • MAKE_APERL_FILE = Makefile.aperl
  • PERLMAINCC = $(CC)
  • PERL_INC = /usr/lib/perl5/5.005/i386-linux/CORE
  • PERL = /usr/bin/perl
  • FULLPERL = /usr/bin/perl
  • VERSION_MACRO = VERSION
  • DEFINE_VERSION = -D$(VERSION_MACRO)="$(VERSION)"
  • XS_VERSION_MACRO = XS_VERSION
  • XS_DEFINE_VERSION = -D$(XS_VERSION_MACRO)="$(XS_VERSION)"
  • MAKEMAKER = /usr/lib/perl5/5.005/ExtUtils/MakeMaker.pm
  • MM_VERSION = 5.4302
  • FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle).

  • BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle)

  • ROOTEXT = Directory part of FULLEXT with leading slash (eg /DBD) !!! Deprecated from MM 5.32 !!!

  • PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar)

  • DLBASE = Basename part of dynamic library. May be just equal BASEEXT.

  • FULLEXT = DBIx/Handle
  • BASEEXT = Handle
  • PARENT_NAME = DBIx
  • DLBASE = $(BASEEXT)
  • VERSION_FROM = Handle.pm
  • OBJECT =
  • LDFROM = $(OBJECT)
  • LINKTYPE = dynamic
  • Handy lists of source code files:

  • XS_FILES=
  • C_FILES =
  • O_FILES =
  • H_FILES =
  • MAN1PODS =
  • MAN3PODS = Handle.pm
  • INST_MAN1DIR = blib/man1
  • INSTALLMAN1DIR = /usr/local/man/man1
  • MAN1EXT = 1p
  • INST_MAN3DIR = blib/man3
  • INSTALLMAN3DIR = /usr/local/man/man3
  • MAN3EXT = 3pm
  • PERM_RW = 644
  • PERM_RWX = 755
  • work around a famous dec-osf make(1) feature(?):

  • makemakerdflt: all
  • .SUFFIXES: .xs .c .C .cpp .cxx .cc $(OBJ_EXT)
  • Nick wanted to get rid of .PRECIOUS. I don’t remember why. I seem to recall, that

  • some make implementations will delete the Makefile when we rebuild it. Because

  • we call false(1) when we rebuild it. So make(1) is not completely wrong when it

  • does so. Our milage may vary.

  • .PRECIOUS: Makefile # seems to be not necessary anymore

  • .PHONY: all config static dynamic test linkext manifest
  • Where is the Config information that we are using/depend on

  • CONFIGDEP = $(PERL_ARCHLIB)/Config.pm $(PERL_INC)/config.h
  • Where to put things:

  • INST_LIBDIR = $(INST_LIB)/DBIx
  • INST_ARCHLIBDIR = $(INST_ARCHLIB)/DBIx
  • INST_AUTODIR = $(INST_LIB)/auto/$(FULLEXT)
  • INST_ARCHAUTODIR = $(INST_ARCHLIB)/auto/$(FULLEXT)
  • INST_STATIC =
  • INST_DYNAMIC =
  • INST_BOOT =
  • EXPORT_LIST =
  • PERL_ARCHIVE =
  • TO_INST_PM = Handle.pm
  • PM_TO_BLIB = Handle.pm \
  • $(INST_LIBDIR)/Handle.pm
  • — MakeMaker tool_autosplit section:

  • Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto

  • AUTOSPLITFILE = $(PERL) “-I$(PERL_ARCHLIB)” “-I$(PERL_LIB)” -e ‘use AutoSplit;autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1) ;’
  • — MakeMaker tool_xsubpp section:

  • — MakeMaker tools_other section:

  • SHELL = /bin/sh
  • CHMOD = chmod
  • CP = cp
  • LD = cc
  • MV = mv
  • NOOP = $(SHELL) -c true
  • RM_F = rm -f
  • RM_RF = rm -rf
  • TEST_F = test -f
  • TOUCH = touch
  • UMASK_NULL = umask 0
  • DEV_NULL = > /dev/null 2>&1
  • The following is a portable way to say mkdir -p

  • To see which directories are created, change the if 0 to if 1

  • MKPATH = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e mkpath
  • This helps us to minimize the effect of the .exists files A yet

  • better solution would be to have a stable file in the perl

  • distribution with a timestamp of zero. But this solution doesn’t

  • need any changes to the core distribution and works with older perls

  • EQUALIZE_TIMESTAMP = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e eqtime
  • Here we warn users that an old packlist file was found somewhere,

  • and that they should call some uninstall routine

  • WARN_IF_OLD_PACKLIST = $(PERL) -we ‘exit unless -f $$ARGV[0];’ \
  • -e ‘print “WARNING: I have found an old package in\n”;’ \
  • -e ‘print “\t$$ARGV[0].\n”;’ \
  • -e ‘print “Please make sure the two installations are not conflicting\n”;’
  • UNINST=0
  • VERBINST=1
  • MOD_INSTALL = $(PERL) -I$(INST_LIB) -I$(PERL_LIB) -MExtUtils::Install \
  • -e “install({@ARGV},‘$(VERBINST)’,0,‘$(UNINST)’);”
  • DOC_INSTALL = $(PERL) -e ‘$$=“\n\n”;’ \
  • -e ‘print "=head2 “, scalar(localtime), “: C<”, shift, “>”, " L<”, shift, “>”;’ \
  • -e ‘print “=over 4”;’ \
  • -e ‘while (defined($$key = shift) and defined($$val = shift)){print “=item *”;print “C<$$key: $$val>”;}’ \
  • -e ‘print “=back”;’
  • UNINSTALL = $(PERL) -MExtUtils::Install \
  • -e ‘uninstall($$ARGV[0],1,1); print “\nUninstall is deprecated. Please check the”;’ \
  • -e ‘print " packlist above carefully.\n There may be errors. Remove the";’ \
  • -e ‘print " appropriate files manually.\n Sorry for the inconveniences.\n"’
  • — MakeMaker dist section:

  • DISTVNAME = $(DISTNAME)-$(VERSION)
  • TAR = tar
  • TARFLAGS = cvf
  • ZIP = zip
  • ZIPFLAGS = -r
  • COMPRESS = gzip --best
  • SUFFIX = .gz
  • SHAR = shar
  • PREOP = @$(NOOP)
  • POSTOP = @$(NOOP)
  • TO_UNIX = @$(NOOP)
  • CI = ci -u
  • RCS_LABEL = rcs -Nv$(VERSION_SYM): -q
  • DIST_CP = best
  • DIST_DEFAULT = tardist
  • — MakeMaker macro section:

  • — MakeMaker depend section:

  • — MakeMaker cflags section:

  • — MakeMaker const_loadlibs section:

  • — MakeMaker const_cccmd section:

  • — MakeMaker post_constants section:

  • — MakeMaker pasthru section:

  • PASTHRU = LIB=“$(LIB)”\
  • LIBPERL_A=“$(LIBPERL_A)”\
  • LINKTYPE=“$(LINKTYPE)”\
  • PREFIX=“$(PREFIX)”\
  • OPTIMIZE=“$(OPTIMIZE)”
  • — MakeMaker c_o section:

  • — MakeMaker xs_c section:

  • — MakeMaker xs_o section:

  • — MakeMaker top_targets section:

  • #all :: config $(INST_PM) subdirs linkext manifypods
  • all :: pure_all manifypods
  • @$(NOOP)
  • pure_all :: config pm_to_blib subdirs linkext
  • @$(NOOP)
  • subdirs :: $(MYEXTLIB)
  • @$(NOOP)
  • config :: Makefile $(INST_LIBDIR)/.exists
  • @$(NOOP)
  • config :: $(INST_ARCHAUTODIR)/.exists
  • @$(NOOP)
  • config :: $(INST_AUTODIR)/.exists
  • @$(NOOP)
  • config :: Version_check
  • @$(NOOP)
  • $(INST_AUTODIR)/.exists :: /usr/lib/perl5/5.005/i386-linux/CORE/perl.h
  • @$(MKPATH) $(INST_AUTODIR)
  • @$(EQUALIZE_TIMESTAMP) /usr/lib/perl5/5.005/i386-linux/CORE/perl.h $(INST_AUTODIR)/.exists
  • -@$(CHMOD) $(PERM_RWX) $(INST_AUTODIR)
  • $(INST_LIBDIR)/.exists :: /usr/lib/perl5/5.005/i386-linux/CORE/perl.h
  • @$(MKPATH) $(INST_LIBDIR)
  • @$(EQUALIZE_TIMESTAMP) /usr/lib/perl5/5.005/i386-linux/CORE/perl.h $(INST_LIBDIR)/.exists
  • -@$(CHMOD) $(PERM_RWX) $(INST_LIBDIR)
  • $(INST_ARCHAUTODIR)/.exists :: /usr/lib/perl5/5.005/i386-linux/CORE/perl.h
  • @$(MKPATH) $(INST_ARCHAUTODIR)
  • @$(EQUALIZE_TIMESTAMP) /usr/lib/perl5/5.005/i386-linux/CORE/perl.h $(INST_ARCHAUTODIR)/.exists
  • -@$(CHMOD) $(PERM_RWX) $(INST_ARCHAUTODIR)
  • config :: $(INST_MAN3DIR)/.exists
  • @$(NOOP)
  • $(INST_MAN3DIR)/.exists :: /usr/lib/perl5/5.005/i386-linux/CORE/perl.h
  • @$(MKPATH) $(INST_MAN3DIR)
  • @$(EQUALIZE_TIMESTAMP) /usr/lib/perl5/5.005/i386-linux/CORE/perl.h $(INST_MAN3DIR)/.exists
  • -@$(CHMOD) $(PERM_RWX) $(INST_MAN3DIR)
  • help:
  • perldoc ExtUtils::MakeMaker
  • Version_check:
  • @$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) \
  •   -MExtUtils::MakeMaker=Version_check \
    
  •   -e "Version_check('$(MM_VERSION)')"
    
  • — MakeMaker linkext section:

  • linkext :: $(LINKTYPE)
  • @$(NOOP)
  • — MakeMaker dlsyms section:

  • — MakeMaker dynamic section:

  • $(INST_PM) has been moved to the all: target.

  • It remains here for awhile to allow for old usage: “make dynamic”

  • #dynamic :: Makefile $(INST_DYNAMIC) $(INST_BOOT) $(INST_PM)
  • dynamic :: Makefile $(INST_DYNAMIC) $(INST_BOOT)
  • @$(NOOP)
  • — MakeMaker dynamic_bs section:

  • BOOTSTRAP =
  • — MakeMaker dynamic_lib section:

  • — MakeMaker static section:

  • $(INST_PM) has been moved to the all: target.

  • It remains here for awhile to allow for old usage: “make static”

  • #static :: Makefile $(INST_STATIC) $(INST_PM)
  • static :: Makefile $(INST_STATIC)
  • @$(NOOP)
  • — MakeMaker static_lib section:

  • — MakeMaker manifypods section:

  • POD2MAN_EXE = /usr/bin/pod2man
  • POD2MAN = $(PERL) -we ‘%m=@ARGV;for (keys %m){’ \
  • -e ‘next if -e $$m{$$} && -M $$m{$$} < -M $$_ && -M $$m{$$_} < -M “Makefile”;’ \
  • -e ‘print “Manifying $$m{$$_}\n”;’ \
  • -e ‘system(qq[$$^X ].q[“-I$(PERL_ARCHLIB)” “-I$(PERL_LIB)” $(POD2MAN_EXE) ].qq[$$>$$m{$$}])==0 or warn “Couldn\047t install $$m{$$_}\n”;’ \
  • -e ‘chmod(oct($(PERM_RW))), $$m{$$} or warn "chmod $(PERM_RW) $$m{$$}: $$!\n";}’
  • manifypods : pure_all Handle.pm
  • @$(POD2MAN) \
  • Handle.pm \
  • $(INST_MAN3DIR)/DBIx::Handle.$(MAN3EXT)
  • — MakeMaker processPL section:

  • — MakeMaker installbin section:

  • — MakeMaker subdirs section:

  • none

  • — MakeMaker clean section:

  • Delete temporary files but do not touch installed files. We don’t delete

  • the Makefile here so a later make realclean still has a makefile to use.

  • clean ::
  • -rm -rf ./blib $(MAKE_APERL_FILE) $(INST_ARCHAUTODIR)/extralibs.all perlmain.c mon.out core so_locations pm_to_blib ~ /~ //~ *$(OBJ_EXT) *$(LIB_EXT) perl.exe $(BOOTSTRAP) $(BASEEXT).bso $(BASEEXT).def $(BASEEXT).exp
  • -mv Makefile Makefile.old $(DEV_NULL)
  • — MakeMaker realclean section:

  • Delete temporary files (via clean) and also delete installed files

  • realclean purge :: clean
  • rm -rf $(INST_AUTODIR) $(INST_ARCHAUTODIR)
  • rm -f $(INST_LIBDIR)/Handle.pm
  • rm -rf Makefile Makefile.old
  • — MakeMaker dist_basics section:

  • distclean :: realclean distcheck
  • distcheck :
  • $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=fullcheck \
  •   -e fullcheck
    
  • skipcheck :
  • $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=skipcheck \
  •   -e skipcheck
    
  • manifest :
  • $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=mkmanifest \
  •   -e mkmanifest
    
  • — MakeMaker dist_core section:

  • dist : $(DIST_DEFAULT)
  • @$(PERL) -le 'print “Warning: Makefile possibly out of date with $$vf” if ’ \
  •   -e '-e ($$vf="$(VERSION_FROM)") and -M $$vf < -M "Makefile";'
    
  • tardist : $(DISTVNAME).tar$(SUFFIX)
  • zipdist : $(DISTVNAME).zip
  • $(DISTVNAME).tar$(SUFFIX) : distdir
  • $(PREOP)
  • $(TO_UNIX)
  • $(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME)
  • $(RM_RF) $(DISTVNAME)
  • $(COMPRESS) $(DISTVNAME).tar
  • $(POSTOP)
  • $(DISTVNAME).zip : distdir
  • $(PREOP)
  • $(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME)
  • $(RM_RF) $(DISTVNAME)
  • $(POSTOP)
  • uutardist : $(DISTVNAME).tar$(SUFFIX)
  • uuencode $(DISTVNAME).tar$(SUFFIX) \
  •   $(DISTVNAME).tar$(SUFFIX) > \
    
  •   $(DISTVNAME).tar$(SUFFIX)_uu
    
  • shdist : distdir
  • $(PREOP)
  • $(SHAR) $(DISTVNAME) > $(DISTVNAME).shar
  • $(RM_RF) $(DISTVNAME)
  • $(POSTOP)
  • — MakeMaker dist_dir section:

  • distdir :
  • $(RM_RF) $(DISTVNAME)
  • $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=manicopy,maniread \
  •   -e "manicopy(maniread(),'$(DISTVNAME)', '$(DIST_CP)');"
    
  • — MakeMaker dist_test section:

  • disttest : distdir
  • cd $(DISTVNAME) && $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) Makefile.PL
  • cd $(DISTVNAME) && $(MAKE)
  • cd $(DISTVNAME) && $(MAKE) test
  • — MakeMaker dist_ci section:

  • ci :
  • $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=maniread \
  •   -e "@all = keys %{ maniread() };" \
    
  •   -e 'print("Executing $(CI) @all\n"); system("$(CI) @all");' \
    
  •   -e 'print("Executing $(RCS_LABEL) ...\n"); system("$(RCS_LABEL) @all");'
    
  • — MakeMaker install section:

  • install :: all pure_install doc_install
  • install_perl :: all pure_perl_install doc_perl_install
  • install_site :: all pure_site_install doc_site_install
  • install_ :: install_site
  • @echo INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
  • pure_install :: pure_$(INSTALLDIRS)_install
  • doc_install :: doc_$(INSTALLDIRS)_install
  • @echo Appending installation info to $(INSTALLARCHLIB)/perllocal.pod
  • pure__install : pure_site_install
  • @echo INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
  • doc__install : doc_site_install
  • @echo INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
  • pure_perl_install ::
  • @$(MOD_INSTALL) \
  •   read $(PERL_ARCHLIB)/auto/$(FULLEXT)/.packlist \
    
  •   write $(INSTALLARCHLIB)/auto/$(FULLEXT)/.packlist \
    
  •   $(INST_LIB) $(INSTALLPRIVLIB) \
    
  •   $(INST_ARCHLIB) $(INSTALLARCHLIB) \
    
  •   $(INST_BIN) $(INSTALLBIN) \
    
  •   $(INST_SCRIPT) $(INSTALLSCRIPT) \
    
  •   $(INST_MAN1DIR) $(INSTALLMAN1DIR) \
    
  •   $(INST_MAN3DIR) $(INSTALLMAN3DIR)
    
  • @$(WARN_IF_OLD_PACKLIST) \
  •   $(SITEARCHEXP)/auto/$(FULLEXT)
    
  • pure_site_install ::
  • @$(MOD_INSTALL) \
  •   read $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist \
    
  •   write $(INSTALLSITEARCH)/auto/$(FULLEXT)/.packlist \
    
  •   $(INST_LIB) $(INSTALLSITELIB) \
    
  •   $(INST_ARCHLIB) $(INSTALLSITEARCH) \
    
  •   $(INST_BIN) $(INSTALLBIN) \
    
  •   $(INST_SCRIPT) $(INSTALLSCRIPT) \
    
  •   $(INST_MAN1DIR) $(INSTALLMAN1DIR) \
    
  •   $(INST_MAN3DIR) $(INSTALLMAN3DIR)
    
  • @$(WARN_IF_OLD_PACKLIST) \
  •   $(PERL_ARCHLIB)/auto/$(FULLEXT)
    
  • doc_perl_install ::
  • -@$(DOC_INSTALL) \
  •   "Module" "$(NAME)" \
    
  •   "installed into" "$(INSTALLPRIVLIB)" \
    
  •   LINKTYPE "$(LINKTYPE)" \
    
  •   VERSION "$(VERSION)" \
    
  •   EXE_FILES "$(EXE_FILES)" \
    
  •   >> $(INSTALLARCHLIB)/perllocal.pod
    
  • doc_site_install ::
  • -@$(DOC_INSTALL) \
  •   "Module" "$(NAME)" \
    
  •   "installed into" "$(INSTALLSITELIB)" \
    
  •   LINKTYPE "$(LINKTYPE)" \
    
  •   VERSION "$(VERSION)" \
    
  •   EXE_FILES "$(EXE_FILES)" \
    
  •   >> $(INSTALLARCHLIB)/perllocal.pod
    
  • uninstall :: uninstall_from_$(INSTALLDIRS)dirs
  • uninstall_from_perldirs ::
  • @$(UNINSTALL) $(PERL_ARCHLIB)/auto/$(FULLEXT)/.packlist
  • uninstall_from_sitedirs ::
  • @$(UNINSTALL) $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist
  • — MakeMaker force section:

  • Phony target to force checking subdirectories.

  • FORCE:
  • @$(NOOP)
  • — MakeMaker perldepend section:

  • — MakeMaker makefile section:

  • We take a very conservative approach here, but it's worth it.

  • We move Makefile to Makefile.old here to avoid gnu make looping.

  • Makefile : Makefile.PL $(CONFIGDEP)
  • @echo “Makefile out-of-date with respect to $?”
  • @echo “Cleaning current config before rebuilding Makefile…”
  • -@$(RM_F) Makefile.old
  • -@$(MV) Makefile Makefile.old
  • -$(MAKE) -f Makefile.old clean $(DEV_NULL) || $(NOOP)
  • $(PERL) “-I$(PERL_ARCHLIB)” “-I$(PERL_LIB)” Makefile.PL
  • @echo “==> Your Makefile has been rebuilt. <==”
  • @echo “==> Please rerun the make command. <==”
  • false
  • To change behavior to :: would be nice, but would break Tk b9.02

  • so you find such a warning below the dist target.

  • #Makefile :: $(VERSION_FROM)
  • @echo “Warning: Makefile possibly out of date with $(VERSION_FROM)”

  • — MakeMaker staticmake section:

  • — MakeMaker makeaperl section —

  • MAP_TARGET = perl
  • FULLPERL = /usr/bin/perl
  • $(MAP_TARGET) :: static $(MAKE_APERL_FILE)
  • $(MAKE) -f $(MAKE_APERL_FILE) $@
  • $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE)
  • @echo Writing "$(MAKE_APERL_FILE)" for this $(MAP_TARGET)
  • @$(PERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) \
  •   Makefile.PL DIR= \
    
  •   MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \
    
  •   MAKEAPERL=1 NORECURS=1 CCCDLFLAGS=
    
  • — MakeMaker test section:

  • TEST_VERBOSE=0
  • TEST_TYPE=test_$(LINKTYPE)
  • TEST_FILE = test.pl
  • TEST_FILES =
  • TESTDB_SW = -d
  • testdb :: testdb_$(LINKTYPE)
  • test :: $(TEST_TYPE)
  • test_dynamic :: pure_all
  • PERL_DL_NONLAZY=1 $(FULLPERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(TEST_FILE)
  • testdb_dynamic :: pure_all
  • PERL_DL_NONLAZY=1 $(FULLPERL) $(TESTDB_SW) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(TEST_FILE)
  • test_ : test_dynamic
  • test_static :: test_dynamic
  • testdb_static :: testdb_dynamic
  • — MakeMaker ppd section:

  • Creates a PPD (Perl Package Description) for a binary distribution.

  • ppd:
  • @$(PERL) -e “print qq{<SOFTPKG NAME="DBIx-Handle" VERSION="0,02,0,0">\n}. qq{\tDBIx-Handle\n}. qq{\t\n}. qq{\t\n}. qq{\t\n}. qq{\t\t<OS NAME="$(OSNAME)" />\n}. qq{\t\t<ARCHITECT
    URE NAME="i386-linux" />\n}. qq{\t\t<CODEBASE HREF="" />\n}. qq{\t\n}. qq{\n}” > DBIx-Handle.ppd
  • — MakeMaker pm_to_blib section:

  • pm_to_blib: $(TO_INST_PM)
  • @$(PERL) “-I$(INST_ARCHLIB)” “-I$(INST_LIB)” \
  • “-I$(PERL_ARCHLIB)” “-I$(PERL_LIB)” -MExtUtils::Install \
  •     -e "pm_to_blib({qw{$(PM_TO_BLIB)}},'$(INST_LIB)/auto')"
    
  • @$(TOUCH) $@
  • — MakeMaker selfdocument section:

  • — MakeMaker postamble section:

  • End.

diff -c /dev/null ‘work/lib/DBIx/DBIx-Handle/Makefile.PL’
Index: ./lib/DBIx/DBIx-Handle/Makefile.PL
*** ./lib/DBIx/DBIx-Handle/Makefile.PL Wed Dec 31 16:00:00 1969
— ./lib/DBIx/DBIx-Handle/Makefile.PL Fri Aug 11 23:29:15 2000
*** 0 ****
— 1,7 ----

  • use ExtUtils::MakeMaker;
  • See lib/ExtUtils/MakeMaker.pm for details of how to influence

  • the contents of the Makefile that is written.

  • WriteMakefile(
  • 'NAME'	=> 'DBIx::Handle',
    
  • 'VERSION_FROM' => 'Handle.pm', # finds $VERSION
    
  • );
    diff -c /dev/null ‘work/lib/DBIx/DBIx-Handle/blib/lib/DBIx/Handle.pm’
    Index: ./lib/DBIx/DBIx-Handle/blib/lib/DBIx/Handle.pm
    *** ./lib/DBIx/DBIx-Handle/blib/lib/DBIx/Handle.pm Wed Dec 31 16:00:00 1969
    — ./lib/DBIx/DBIx-Handle/blib/lib/DBIx/Handle.pm Fri Aug 11 18:07:18 2000
    *** 0 ****
    — 1,232 ----
  • $Header: /cvsroot/twort/rt/lib/DBIx/Handle.pm,v 1.1 2000/08/03 12:28:52 tobix Exp $

  • package DBIx::Handle;
  • use Carp;
  • use DBI;
  • use strict;
  • use vars qw($VERSION @ISA $Handle);
  • $VERSION = ‘0.02’;
  • #instantiate a new object.
  • {{{ sub new

  • sub new {
  • my $proto = shift;
  • my $class = ref($proto) || $proto;
  • my $self = {};
  • bless ($self, $class);
  • #we have no limit statements. DoSearch won’t work.
  • return ($self)
  • }
  • }}}

  • {{{ sub Connect

  • sub Connect {
  • my $self = shift;
  • my %args = ( Driver => undef,
  •      Database => undef,
    
  •      Host => 'localhost',
    
  •      User => undef,
    
  •      Password => undef,
    
  •      @_);
    
  • my $dsn;
  • $dsn = “dbi:$args{‘Driver’}:$args{‘Database’}:$args{‘Host’}”;
  • $Handle = DBI->connect_cached($dsn, $args{‘User’}, $args{‘Password’}) || croak “Connect Failed $DBI::errstr\n” ;
  • $Handle->{RaiseError}=1;
  • $Handle->{PrintError}=1;
  • return ($Handle);
  • }
  • }}}

  • {{{ sub Disconnect

  • sub Disconnect {
  • my $self = shift;
  • return ($self->dbh->disconnect());
  • }
  • {{{ sub Handle / dbh

  • sub Handle {
  • return($Handle);
  • }
  • *dbh=&Handle;
  • }}}

  • {{{ sub UpdateTableValue

  • sub UpdateTableValue {
  • my $self = shift;
  • my $Table = shift;
  • my $Col = shift;
  • my $NewValue = shift;
  • my $Record = shift;
  • my $is_sql = shift;
  • my $QueryString;
  • quote the value

  • TODO: We need some general way to escape SQL functions.

  • $NewValue=$self->safe_quote($NewValue)
  •   unless ($is_sql or
    
  •     $Col=~/^(Created|LastUpdated)$/ && $NewValue=~/^now\(\)$/i);
    
  • build the query string

  • $QueryString = “UPDATE $Table SET $Col = $NewValue WHERE id = $Record”;
  • TODO update the last edited

  • (Tobix: I think this is already taken care of by now in DBIx::Record?)

  • my $sth = $self->dbh->prepare($QueryString);
  • if (!$sth) {
  • if ($main::debug) {
    
  •   die "Error:" . $self->dbh->errstr . "\n";
    
  • }
    
  • else {
    
  •   return (0);
    
  • }
  • }
  • if (!$sth->execute) {
  • if ($self->{'debug'}) {
    
  •   die "Error:" . $sth->errstr . "\n";
    
  • }
    
  • else {
    
  •   return(0);
    
  • }
    
  • }
  • return (1); #Update Succeded
  • }
  • }}}

  • {{{ sub SimpleQuery

  • sub SimpleQuery {
  • my $self = shift;
  • my $QueryString = shift;
  • TODO update the last edited

  • my $sth = $self->dbh->prepare($QueryString);
  • if (!$sth) {
  • if ($main::debug) {
    
  •   die "Error:" . $self->dbh->errstr . "\n";
    
  • }
    
  • else {
    
  •   return (0);
    
  • }
    
  • }
  • if (!$sth->execute) {
  • if ($self->{'debug'}) {
    
  •   die "Error:" . $sth->errstr . "\n";
    
  • }
    
  • else {
    
  •   return(0);
    
  • }
    
  • }
  • return ($sth);
  • }
  • }}}

  • sub FetchResult {
  • my $self = shift;
  • my $query = shift;
  • my $sth = $self->SimpleQuery($query);
  • return ($sth->fetchrow);
  • }
  • {{{ sub safe_quote

  • sub safe_quote {
  • my $self = shift;
  • my $in_val = shift;
  • my ($out_val);
  • if (!$in_val) {
  •  return ("''");
    
  • }
  • else {
  •  $out_val = $self->dbh->quote($in_val);
    
  • }
  • return(“$out_val”);
  • }
  • }}}

  • Autoload methods go after =cut, and are processed by the autosplit program.

  • 1;
  • END
  • {{{ POD

  • =head1 NAME
  • DBIx::Handle - Perl extension which is a generic DBI handle
  • =head1 SYNOPSIS
  • use DBIx::Handle;
  • my $Handle = DBIx::Handle->new();
  • $Handle->Connect( Driver => ‘mysql’,
  •      Database => 'dbname',
    
  •      Host => 'hostname',
    
  •      User => 'dbuser',
    
  •      Password => 'dbpassword');
    
  • =head1 DESCRIPTION
  • Jesse’s a slacker.
  • Blah blah blah.
  • =head1 AUTHOR
  • Jesse Vincent, jesse@fsck.com
  • =head1 SEE ALSO
  • perl(1), DBIx::EasySearch, DBIx::Record
  • =cut
  • }}} POD

diff -c /dev/null ‘work/lib/DBIx/DBIx-Handle/blib/man3/DBIx::Handle.3pm’
Index: ./lib/DBIx/DBIx-Handle/blib/man3/DBIx::Handle.3pm
*** ./lib/DBIx/DBIx-Handle/blib/man3/DBIx::Handle.3pm Wed Dec 31 16:00:00 1969
— ./lib/DBIx/DBIx-Handle/blib/man3/DBIx::Handle.3pm Fri Aug 11 23:43:19 2000
*** 0 ****
— 1,229 ----

  • .rn ‘’ }`
  • ‘’’ $RCSfile$$Revision$$Date$
  • ‘’’
  • ‘’’ $Log$
  • ‘’’
  • .de Sh
  • .br
  • .if t .Sp
  • .ne 5
  • .PP
  • \fB\$1\fR
  • .PP
  • .de Sp
  • .if t .sp .5v
  • .if n .sp
  • .de Ip
  • .br
  • .ie \n(.$>=3 .ne \$3
  • .el .ne 3
  • .IP “\$1” \$2
  • .de Vb
  • .ft CW
  • .nf
  • .ne \$1
  • .de Ve
  • .ft R
  • .fi
  • ‘’’
  • ‘’’
  • ‘’’ Set up *(-- to give an unbreakable dash;
  • ‘’’ string Tr holds user defined translation string.
  • ‘’’ Bell System Logo is used as a dummy character.
  • ‘’’
  • .tr (*W-|(bv*(Tr
  • .ie n {\
  • .ds – (*W-
  • .ds PI pi
  • .if (\n(.H=4u)&(1m=24u) .ds – (*W\h’-12u’(*W\h’-12u’-" diablo 10 pitch
  • .if (\n(.H=4u)&(1m=20u) .ds – (*W\h’-12u’(*W\h’-8u’-" diablo 12 pitch
  • .ds L" “”
  • .ds R" “”
  • ‘’’ *(M", *(S", *(N" and *(T" are the equivalent of
  • ‘’’ *(L" and *(R", except that they are used on “.xx” lines,
  • ‘’’ such as .IP and .SH, which do another additional levels of
  • ‘’’ double-quote interpretation
  • .ds M" “”"
  • .ds S" “”"
  • .ds N" “”“”"
  • .ds T" “”“”"
  • .ds L’ ’
  • .ds R’ ’
  • .ds M’ ’
  • .ds S’ ’
  • .ds N’ ’
  • .ds T’ ’
  • 'br}
  • .el{\
  • .ds – (em|
  • .tr *(Tr
  • .ds L" ``
  • .ds R" ‘’
  • .ds M" ``
  • .ds S" ‘’
  • .ds N" ``
  • .ds T" ‘’
  • .ds L’ `
  • .ds R’ ’
  • .ds M’ `
  • .ds S’ ’
  • .ds N’ `
  • .ds T’ ’
  • .ds PI (*p
  • 'br}
  • ." If the F register is turned on, we’ll generate
  • ." index entries out stderr for the following things:
  • ." TH Title
  • ." SH Header
  • ." Sh Subsection
  • ." Ip Item
  • ." X<> Xref (embedded
  • ." Of course, you have to process the output yourself
  • ." in some meaninful fashion.
  • .if \nF {
  • .de IX
  • .tm Index:\$1\t\n%\t"\$2"
  • .nr % 0
  • .rr F
  • .}
  • .TH Handle 3pm “perl 5.005, patch 03” “11/Aug/2000” “User Contributed Perl Documentation”
  • .UC
  • .if n .hy 0
  • .if n .na
  • .ds C+ C\v’-.1v’\h’-1p’\s-2+\h’-1p’+\s0\v’.1v’\h’-1p’
  • .de CQ " put $1 in typewriter font
  • .ft CW
  • 'if n "\c
  • 'if t \&\$1\c
  • 'if n \&\$1\c
  • 'if n &"
  • \&\$2 \$3 \$4 \$5 \$6 \$7
  • '.ft R
  • ." @(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2
  • . " AM - accent mark definitions
  • .bd B 3
  • . " fudge factors for nroff and troff
  • .if n {\
  • . ds #H 0
  • . ds #V .8m
  • . ds #F .3m
  • . ds #[ \f1
  • . ds #] \fP
  • .}
  • .if t {\
  • . ds #H ((1u-(\\n(.fu%2u))*.13m)
  • . ds #V .6m
  • . ds #F 0
  • . ds #[ &
  • . ds #] &
  • .}
  • . " simple accents for nroff and troff
  • .if n {\
  • . ds ’ &
  • . ds ` &
  • . ds ^ &
  • . ds , &
  • . ds ~ ~
  • . ds ? ?
  • . ds ! !
  • . ds /
  • . ds q
  • .}
  • .if t {\
  • . ds ’ \k:\h’-(\n(.wu*8/10-*(#H)''\h"|\n:u"
  • . ds \\k:\h'-(\\n(.wu*8/10-\*(#H)'\\h’|\n:u’
  • . ds ^ \k:\h’-(\n(.wu*10/11-*(#H)‘^\h’|\n:u’
  • . ds , \k:\h’-(\n(.wu*8/10)‘,\h’|\n:u’
  • . ds ~ \k:\h’-(\n(.wu-*(#H-.1m)‘~\h’|\n:u’
  • . ds ? \s-2c\h’-\w’c’u7/10’\u\h’*(#H’\zi\d\s+2\h’\w’c’u8/10’
  • . ds ! \s-2(or\s+2\h’-\w’(or’u’\v’-.8m’.\v’.8m’
  • . ds / \k:\h’-(\n(.wu*8/10-*(#H)‘\z(sl\h’|\n:u’
  • . ds q o\h’-\w’o’u*8/10’\s-4\v’.4m’\z(i\v’-.4m’\s+4\h’\w’o’u8/10’
  • .}
  • . " troff and (daisy-wheel) nroff accents
  • .ds : \k:\h’-(\n(.wu*8/10-*(#H+.1m+*(#F)‘\v’-*(#V’\z.\h’.2m+*(#F’.\h’|\n:u’\v’*(#V
  • .ds 8 \h’*(#H’(*b\h’-*(#H
  • .ds v \k:\h’-(\n(.wu*9/10-*(#H)‘\v’-*(#V’*(#[\s-4v\s0\v’*(#V’\h’|\n:u’*(#]
  • .ds _ \k:\h’-(\n(.wu9/10-*(#H+(*(#F2/3))‘\v’-.4m’\z(hy\v’.4m’\h’|\n:u’
  • .ds . \k:\h’-(\n(.wu8/10)‘\v’*(#V4/10’\z.\v’-*(#V*4/10’\h’|\n:u’
  • .ds 3 *(#[\v’.2m’\s-2&3\s0\v’-.2m’*(#]
  • .ds o \k:\h’-(\n(.wu+\w’(de’u-*(#H)/2u’\v’-.3n’*(#[\z(de\v’.3n’\h’|\n:u’*(#]
  • .ds d- \h’*(#H’(pd\h’-\w’~‘u’\v’-.25m’\f2(hy\fP\v’.25m’\h’-*(#H
  • .ds D- D\k:\h’-\w’D’u’\v’-.11m’\z(hy\v’.11m’\h’|\n:u’
  • .ds th *(#[\v’.3m’\s+1I\s-1\v’-.3m’\h’-(\w’I’u*2/3)'\s-1o\s+1*(#]
  • .ds Th *(#[\s+2I\s-2\h’-\w’I’u*3/5’\v’-.3m’o\v’.3m’*(#]
  • .ds ae a\h’-(\w’a’u*4/10)'e
  • .ds Ae A\h’-(\w’A’u*4/10)'E
  • .ds oe o\h’-(\w’o’u*4/10)'e
  • .ds Oe O\h’-(\w’O’u*4/10)'E
  • . " corrections for vroff
  • .if v .ds ~ \k:\h’-(\n(.wu*9/10-*(#H)‘\s-2\u~\d\s+2\h’|\n:u’
  • .if v .ds ^ \k:\h’-(\n(.wu*10/11-*(#H)‘\v’-.4m’^\v’.4m’\h’|\n:u’
  • . " for low resolution devices (crt and lpr)
  • .if \n(.H>23 .if \n(.V>19 \
  • {\
  • . ds : e
  • . ds 8 ss
  • . ds v \h’-1’\o’(aa(ga’
  • . ds _ \h’-1’^
  • . ds . \h’-1’.
  • . ds 3 3
  • . ds o a
  • . ds d- d\h’-1’(ga
  • . ds D- D\h’-1’(hy
  • . ds th \o’bp’
  • . ds Th \o’LP’
  • . ds ae ae
  • . ds Ae AE
  • . ds oe oe
  • . ds Oe OE
  • .}
  • .rm #[ #] #H #V #F C
  • .SH “NAME”
  • DBIx::Handle - Perl extension which is a generic DBI handle
  • .SH “SYNOPSIS”
  • .PP
  • .Vb 1
  • & use DBIx::Handle;
  • .Ve
  • .Vb 8
  • & my $Handle = DBIx::Handle->new();
  • & $Handle->Connect( Driver => ‘mysql’,
  • & Database => ‘dbname’,
  • & Host => ‘hostname’,
  • & User => ‘dbuser’,
  • & Password => ‘dbpassword’);
  • &
  • &
  • .Ve
  • .SH “DESCRIPTION”
  • Jesse’s a slacker.
  • .PP
  • Blah blah blah.
  • .SH “AUTHOR”
  • Jesse Vincent, jesse@fsck.com
  • .SH “SEE ALSO”
  • \fIperl\fR|(1), DBIx::EasySearch, DBIx::Record
  • .rn }` ‘’
  • .IX Title “Handle 3pm”
  • .IX Name “DBIx::Handle - Perl extension which is a generic DBI handle”
  • .IX Header “NAME”
  • .IX Header “SYNOPSIS”
  • .IX Header “DESCRIPTION”
  • .IX Header “AUTHOR”
  • .IX Header “SEE ALSO”
    diff -c /dev/null ‘work/lib/DBIx/DBIx-Handle/test.pl’
    Index: ./lib/DBIx/DBIx-Handle/test.pl
    *** ./lib/DBIx/DBIx-Handle/test.pl Wed Dec 31 16:00:00 1969
    — ./lib/DBIx/DBIx-Handle/test.pl Fri Aug 11 23:29:15 2000
    *** 0 ****
    — 1,20 ----
  • Before `make install’ is performed this script should be runnable with

  • make test'. After make install’ it should work as `perl test.pl’

  • ######################### We start with some black magic to print on failure.
  • Change 1…1 below to 1…last_test_to_print .

  • (It may become useful if the test is moved to ./t subdirectory.)

  • BEGIN { $| = 1; print “1…1\n”; }
  • END {print “not ok 1\n” unless $loaded;}
  • use DBIx::Handle;
  • $loaded = 1;
  • print “ok 1\n”;
  • ######################### End of black magic.
  • Insert your test code below (better if it prints “ok 13”

  • (correspondingly “not ok 13”) depending on the success of chunk 13

  • of the test code):

diff -c /dev/null ‘work/lib/DBIx/DBIx-Record/Changes’
Index: ./lib/DBIx/DBIx-Record/Changes
*** ./lib/DBIx/DBIx-Record/Changes Wed Dec 31 16:00:00 1969
— ./lib/DBIx/DBIx-Record/Changes Fri Aug 11 23:29:19 2000
*** 0 ****
— 1,5 ----

  • Revision history for Perl extension DBIx::Record.
  • 0.01 Fri Aug 11 23:29:19 2000
    • original version; created by h2xs 1.19
      diff -c /dev/null ‘work/lib/DBIx/DBIx-Record/MANIFEST’
      Index: ./lib/DBIx/DBIx-Record/MANIFEST
      *** ./lib/DBIx/DBIx-Record/MANIFEST Wed Dec 31 16:00:00 1969
      — ./lib/DBIx/DBIx-Record/MANIFEST Fri Aug 11 23:29:19 2000
      *** 0 ****
      — 1,5 ----
  • Changes
  • MANIFEST
  • Makefile.PL
  • Record.pm
  • test.pl
    diff -c /dev/null ‘work/lib/DBIx/DBIx-Record/Makefile’
    Index: ./lib/DBIx/DBIx-Record/Makefile
    *** ./lib/DBIx/DBIx-Record/Makefile Wed Dec 31 16:00:00 1969
    — ./lib/DBIx/DBIx-Record/Makefile Fri Aug 11 23:43:20 2000
    *** 0 ****
    — 1,654 ----
  • This Makefile is for the DBIx::Record extension to perl.

  • It was generated automatically by MakeMaker version

  • 5.4302 (Revision: 1.222) from the contents of

  • Makefile.PL. Don’t edit this file, edit Makefile.PL instead.

  • ANY CHANGES MADE HERE WILL BE LOST!

  • MakeMaker ARGV: ()

  • MakeMaker Parameters:

  • NAME => q[DBIx::Record]

  • VERSION_FROM => q[Record.pm]

  • — MakeMaker post_initialize section:

  • — MakeMaker const_config section:

  • These definitions are from config.sh (via /usr/lib/perl5/5.005/i386-linux/Config.pm)

  • They may have been overridden via Makefile.PL or on the command line

  • AR = ar
  • CC = cc
  • CCCDLFLAGS = -fPIC
  • CCDLFLAGS = -rdynamic
  • DLEXT = so
  • DLSRC = dl_dlopen.xs
  • LD = cc
  • LDDLFLAGS = -shared -L/usr/local/lib
  • LDFLAGS = -L/usr/local/lib
  • LIBC =
  • LIB_EXT = .a
  • OBJ_EXT = .o
  • OSNAME = linux
  • OSVERS = 2.2.15pre14
  • RANLIB = :
  • SO = so
  • EXE_EXT =
  • — MakeMaker constants section:

  • AR_STATIC_ARGS = cr
  • NAME = DBIx::Record
  • DISTNAME = DBIx-Record
  • NAME_SYM = DBIx_Record
  • VERSION = 0.02
  • VERSION_SYM = 0_02
  • XS_VERSION = 0.02
  • INST_BIN = blib/bin
  • INST_EXE = blib/script
  • INST_LIB = blib/lib
  • INST_ARCHLIB = blib/arch
  • INST_SCRIPT = blib/script
  • PREFIX = /usr
  • INSTALLDIRS = site
  • INSTALLPRIVLIB = $(PREFIX)/lib/perl5
  • INSTALLARCHLIB = $(PREFIX)/lib/perl5/5.005/i386-linux
  • INSTALLSITELIB = /usr/local/lib/site_perl
  • INSTALLSITEARCH = /usr/local/lib/site_perl/i386-linux
  • INSTALLBIN = $(PREFIX)/bin
  • INSTALLSCRIPT = $(PREFIX)/bin
  • PERL_LIB = /usr/lib/perl5/5.005
  • PERL_ARCHLIB = /usr/lib/perl5/5.005/i386-linux
  • SITELIBEXP = /usr/local/lib/site_perl
  • SITEARCHEXP = /usr/local/lib/site_perl/i386-linux
  • LIBPERL_A = libperl.a
  • FIRST_MAKEFILE = Makefile
  • MAKE_APERL_FILE = Makefile.aperl
  • PERLMAINCC = $(CC)
  • PERL_INC = /usr/lib/perl5/5.005/i386-linux/CORE
  • PERL = /usr/bin/perl
  • FULLPERL = /usr/bin/perl
  • VERSION_MACRO = VERSION
  • DEFINE_VERSION = -D$(VERSION_MACRO)="$(VERSION)"
  • XS_VERSION_MACRO = XS_VERSION
  • XS_DEFINE_VERSION = -D$(XS_VERSION_MACRO)="$(XS_VERSION)"
  • MAKEMAKER = /usr/lib/perl5/5.005/ExtUtils/MakeMaker.pm
  • MM_VERSION = 5.4302
  • FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle).

  • BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle)

  • ROOTEXT = Directory part of FULLEXT with leading slash (eg /DBD) !!! Deprecated from MM 5.32 !!!

  • PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar)

  • DLBASE = Basename part of dynamic library. May be just equal BASEEXT.

  • FULLEXT = DBIx/Record
  • BASEEXT = Record
  • PARENT_NAME = DBIx
  • DLBASE = $(BASEEXT)
  • VERSION_FROM = Record.pm
  • OBJECT =
  • LDFROM = $(OBJECT)
  • LINKTYPE = dynamic
  • Handy lists of source code files:

  • XS_FILES=
  • C_FILES =
  • O_FILES =
  • H_FILES =
  • MAN1PODS =
  • MAN3PODS = Record.pm
  • INST_MAN1DIR = blib/man1
  • INSTALLMAN1DIR = /usr/local/man/man1
  • MAN1EXT = 1p
  • INST_MAN3DIR = blib/man3
  • INSTALLMAN3DIR = /usr/local/man/man3
  • MAN3EXT = 3pm
  • PERM_RW = 644
  • PERM_RWX = 755
  • work around a famous dec-osf make(1) feature(?):

  • makemakerdflt: all
  • .SUFFIXES: .xs .c .C .cpp .cxx .cc $(OBJ_EXT)
  • Nick wanted to get rid of .PRECIOUS. I don’t remember why. I seem to recall, that

  • some make implementations will delete the Makefile when we rebuild it. Because

  • we call false(1) when we rebuild it. So make(1) is not completely wrong when it

  • does so. Our milage may vary.

  • .PRECIOUS: Makefile # seems to be not necessary anymore

  • .PHONY: all config static dynamic test linkext manifest
  • Where is the Config information that we are using/depend on

  • CONFIGDEP = $(PERL_ARCHLIB)/Config.pm $(PERL_INC)/config.h
  • Where to put things:

  • INST_LIBDIR = $(INST_LIB)/DBIx
  • INST_ARCHLIBDIR = $(INST_ARCHLIB)/DBIx
  • INST_AUTODIR = $(INST_LIB)/auto/$(FULLEXT)
  • INST_ARCHAUTODIR = $(INST_ARCHLIB)/auto/$(FULLEXT)
  • INST_STATIC =
  • INST_DYNAMIC =
  • INST_BOOT =
  • EXPORT_LIST =
  • PERL_ARCHIVE =
  • TO_INST_PM = Record.pm
  • PM_TO_BLIB = Record.pm \
  • $(INST_LIBDIR)/Record.pm
  • — MakeMaker tool_autosplit section:

  • Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto

  • AUTOSPLITFILE = $(PERL) “-I$(PERL_ARCHLIB)” “-I$(PERL_LIB)” -e ‘use AutoSplit;autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1) ;’
  • — MakeMaker tool_xsubpp section:

  • — MakeMaker tools_other section:

  • SHELL = /bin/sh
  • CHMOD = chmod
  • CP = cp
  • LD = cc
  • MV = mv
  • NOOP = $(SHELL) -c true
  • RM_F = rm -f
  • RM_RF = rm -rf
  • TEST_F = test -f
  • TOUCH = touch
  • UMASK_NULL = umask 0
  • DEV_NULL = > /dev/null 2>&1
  • The following is a portable way to say mkdir -p

  • To see which directories are created, change the if 0 to if 1

  • MKPATH = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e mkpath
  • This helps us to minimize the effect of the .exists files A yet

  • better solution would be to have a stable file in the perl

  • distribution with a timestamp of zero. But this solution doesn’t

  • need any changes to the core distribution and works with older perls

  • EQUALIZE_TIMESTAMP = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e eqtime
  • Here we warn users that an old packlist file was found somewhere,

  • and that they should call some uninstall routine

  • WARN_IF_OLD_PACKLIST = $(PERL) -we ‘exit unless -f $$ARGV[0];’ \
  • -e ‘print “WARNING: I have found an old package in\n”;’ \
  • -e ‘print “\t$$ARGV[0].\n”;’ \
  • -e ‘print “Please make sure the two installations are not conflicting\n”;’
  • UNINST=0
  • VERBINST=1
  • MOD_INSTALL = $(PERL) -I$(INST_LIB) -I$(PERL_LIB) -MExtUtils::Install \
  • -e “install({@ARGV},‘$(VERBINST)’,0,‘$(UNINST)’);”
  • DOC_INSTALL = $(PERL) -e ‘$$=“\n\n”;’ \
  • -e ‘print "=head2 “, scalar(localtime), “: C<”, shift, “>”, " L<”, shift, “>”;’ \
  • -e ‘print “=over 4”;’ \
  • -e ‘while (defined($$key = shift) and defined($$val = shift)){print “=item *”;print “C<$$key: $$val>”;}’ \
  • -e ‘print “=back”;’
  • UNINSTALL = $(PERL) -MExtUtils::Install \
  • -e ‘uninstall($$ARGV[0],1,1); print “\nUninstall is deprecated. Please check the”;’ \
  • -e ‘print " packlist above carefully.\n There may be errors. Remove the";’ \
  • -e ‘print " appropriate files manually.\n Sorry for the inconveniences.\n"’
  • — MakeMaker dist section:

  • DISTVNAME = $(DISTNAME)-$(VERSION)
  • TAR = tar
  • TARFLAGS = cvf
  • ZIP = zip
  • ZIPFLAGS = -r
  • COMPRESS = gzip --best
  • SUFFIX = .gz
  • SHAR = shar
  • PREOP = @$(NOOP)
  • POSTOP = @$(NOOP)
  • TO_UNIX = @$(NOOP)
  • CI = ci -u
  • RCS_LABEL = rcs -Nv$(VERSION_SYM): -q
  • DIST_CP = best
  • DIST_DEFAULT = tardist
  • — MakeMaker macro section:

  • — MakeMaker depend section:

  • — MakeMaker cflags section:

  • — MakeMaker const_loadlibs section:

  • — MakeMaker const_cccmd section:

  • — MakeMaker post_constants section:

  • — MakeMaker pasthru section:

  • PASTHRU = LIB=“$(LIB)”\
  • LIBPERL_A=“$(LIBPERL_A)”\
  • LINKTYPE=“$(LINKTYPE)”\
  • PREFIX=“$(PREFIX)”\
  • OPTIMIZE=“$(OPTIMIZE)”
  • — MakeMaker c_o section:

  • — MakeMaker xs_c section:

  • — MakeMaker xs_o section:

  • — MakeMaker top_targets section:

  • #all :: config $(INST_PM) subdirs linkext manifypods
  • all :: pure_all manifypods
  • @$(NOOP)
  • pure_all :: config pm_to_blib subdirs linkext
  • @$(NOOP)
  • subdirs :: $(MYEXTLIB)
  • @$(NOOP)
  • config :: Makefile $(INST_LIBDIR)/.exists
  • @$(NOOP)
  • config :: $(INST_ARCHAUTODIR)/.exists
  • @$(NOOP)
  • config :: $(INST_AUTODIR)/.exists
  • @$(NOOP)
  • config :: Version_check
  • @$(NOOP)
  • $(INST_AUTODIR)/.exists :: /usr/lib/perl5/5.005/i386-linux/CORE/perl.h
  • @$(MKPATH) $(INST_AUTODIR)
  • @$(EQUALIZE_TIMESTAMP) /usr/lib/perl5/5.005/i386-linux/CORE/perl.h $(INST_AUTODIR)/.exists
  • -@$(CHMOD) $(PERM_RWX) $(INST_AUTODIR)
  • $(INST_LIBDIR)/.exists :: /usr/lib/perl5/5.005/i386-linux/CORE/perl.h
  • @$(MKPATH) $(INST_LIBDIR)
  • @$(EQUALIZE_TIMESTAMP) /usr/lib/perl5/5.005/i386-linux/CORE/perl.h $(INST_LIBDIR)/.exists
  • -@$(CHMOD) $(PERM_RWX) $(INST_LIBDIR)
  • $(INST_ARCHAUTODIR)/.exists :: /usr/lib/perl5/5.005/i386-linux/CORE/perl.h
  • @$(MKPATH) $(INST_ARCHAUTODIR)
  • @$(EQUALIZE_TIMESTAMP) /usr/lib/perl5/5.005/i386-linux/CORE/perl.h $(INST_ARCHAUTODIR)/.exists
  • -@$(CHMOD) $(PERM_RWX) $(INST_ARCHAUTODIR)
  • config :: $(INST_MAN3DIR)/.exists
  • @$(NOOP)
  • $(INST_MAN3DIR)/.exists :: /usr/lib/perl5/5.005/i386-linux/CORE/perl.h
  • @$(MKPATH) $(INST_MAN3DIR)
  • @$(EQUALIZE_TIMESTAMP) /usr/lib/perl5/5.005/i386-linux/CORE/perl.h $(INST_MAN3DIR)/.exists
  • -@$(CHMOD) $(PERM_RWX) $(INST_MAN3DIR)
  • help:
  • perldoc ExtUtils::MakeMaker
  • Version_check:
  • @$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) \
  •   -MExtUtils::MakeMaker=Version_check \
    
  •   -e "Version_check('$(MM_VERSION)')"
    
  • — MakeMaker linkext section:

  • linkext :: $(LINKTYPE)
  • @$(NOOP)
  • — MakeMaker dlsyms section:

  • — MakeMaker dynamic section:

  • $(INST_PM) has been moved to the all: target.

  • It remains here for awhile to allow for old usage: “make dynamic”

  • #dynamic :: Makefile $(INST_DYNAMIC) $(INST_BOOT) $(INST_PM)
  • dynamic :: Makefile $(INST_DYNAMIC) $(INST_BOOT)
  • @$(NOOP)
  • — MakeMaker dynamic_bs section:

  • BOOTSTRAP =
  • — MakeMaker dynamic_lib section:

  • — MakeMaker static section:

  • $(INST_PM) has been moved to the all: target.

  • It remains here for awhile to allow for old usage: “make static”

  • #static :: Makefile $(INST_STATIC) $(INST_PM)
  • static :: Makefile $(INST_STATIC)
  • @$(NOOP)
  • — MakeMaker static_lib section:

  • — MakeMaker manifypods section:

  • POD2MAN_EXE = /usr/bin/pod2man
  • POD2MAN = $(PERL) -we ‘%m=@ARGV;for (keys %m){’ \
  • -e ‘next if -e $$m{$$} && -M $$m{$$} < -M $$_ && -M $$m{$$_} < -M “Makefile”;’ \
  • -e ‘print “Manifying $$m{$$_}\n”;’ \
  • -e ‘system(qq[$$^X ].q[“-I$(PERL_ARCHLIB)” “-I$(PERL_LIB)” $(POD2MAN_EXE) ].qq[$$>$$m{$$}])==0 or warn “Couldn\047t install $$m{$$_}\n”;’ \
  • -e ‘chmod(oct($(PERM_RW))), $$m{$$} or warn "chmod $(PERM_RW) $$m{$$}: $$!\n";}’
  • manifypods : pure_all Record.pm
  • @$(POD2MAN) \
  • Record.pm \
  • $(INST_MAN3DIR)/DBIx::Record.$(MAN3EXT)
  • — MakeMaker processPL section:

  • — MakeMaker installbin section:

  • — MakeMaker subdirs section:

  • none

  • — MakeMaker clean section:

  • Delete temporary files but do not touch installed files. We don’t delete

  • the Makefile here so a later make realclean still has a makefile to use.

  • clean ::
  • -rm -rf ./blib $(MAKE_APERL_FILE) $(INST_ARCHAUTODIR)/extralibs.all perlmain.c mon.out core so_locations pm_to_blib ~ /~ //~ *$(OBJ_EXT) *$(LIB_EXT) perl.exe $(BOOTSTRAP) $(BASEEXT).bso $(BASEEXT).def $(BASEEXT).exp
  • -mv Makefile Makefile.old $(DEV_NULL)
  • — MakeMaker realclean section:

  • Delete temporary files (via clean) and also delete installed files

  • realclean purge :: clean
  • rm -rf $(INST_AUTODIR) $(INST_ARCHAUTODIR)
  • rm -f $(INST_LIBDIR)/Record.pm
  • rm -rf Makefile Makefile.old
  • — MakeMaker dist_basics section:

  • distclean :: realclean distcheck
  • distcheck :
  • $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=fullcheck \
  •   -e fullcheck
    
  • skipcheck :
  • $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=skipcheck \
  •   -e skipcheck
    
  • manifest :
  • $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=mkmanifest \
  •   -e mkmanifest
    
  • — MakeMaker dist_core section:

  • dist : $(DIST_DEFAULT)
  • @$(PERL) -le 'print “Warning: Makefile possibly out of date with $$vf” if ’ \
  •   -e '-e ($$vf="$(VERSION_FROM)") and -M $$vf < -M "Makefile";'
    
  • tardist : $(DISTVNAME).tar$(SUFFIX)
  • zipdist : $(DISTVNAME).zip
  • $(DISTVNAME).tar$(SUFFIX) : distdir
  • $(PREOP)
  • $(TO_UNIX)
  • $(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME)
  • $(RM_RF) $(DISTVNAME)
  • $(COMPRESS) $(DISTVNAME).tar
  • $(POSTOP)
  • $(DISTVNAME).zip : distdir
  • $(PREOP)
  • $(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME)
  • $(RM_RF) $(DISTVNAME)
  • $(POSTOP)
  • uutardist : $(DISTVNAME).tar$(SUFFIX)
  • uuencode $(DISTVNAME).tar$(SUFFIX) \
  •   $(DISTVNAME).tar$(SUFFIX) > \
    
  •   $(DISTVNAME).tar$(SUFFIX)_uu
    
  • shdist : distdir
  • $(PREOP)
  • $(SHAR) $(DISTVNAME) > $(DISTVNAME).shar
  • $(RM_RF) $(DISTVNAME)
  • $(POSTOP)
  • — MakeMaker dist_dir section:

  • distdir :
  • $(RM_RF) $(DISTVNAME)
  • $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=manicopy,maniread \
  •   -e "manicopy(maniread(),'$(DISTVNAME)', '$(DIST_CP)');"
    
  • — MakeMaker dist_test section:

  • disttest : distdir
  • cd $(DISTVNAME) && $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) Makefile.PL
  • cd $(DISTVNAME) && $(MAKE)
  • cd $(DISTVNAME) && $(MAKE) test
  • — MakeMaker dist_ci section:

  • ci :
  • $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=maniread \
  •   -e "@all = keys %{ maniread() };" \
    
  •   -e 'print("Executing $(CI) @all\n"); system("$(CI) @all");' \
    
  •   -e 'print("Executing $(RCS_LABEL) ...\n"); system("$(RCS_LABEL) @all");'
    
  • — MakeMaker install section:

  • install :: all pure_install doc_install
  • install_perl :: all pure_perl_install doc_perl_install
  • install_site :: all pure_site_install doc_site_install
  • install_ :: install_site
  • @echo INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
  • pure_install :: pure_$(INSTALLDIRS)_install
  • doc_install :: doc_$(INSTALLDIRS)_install
  • @echo Appending installation info to $(INSTALLARCHLIB)/perllocal.pod
  • pure__install : pure_site_install
  • @echo INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
  • doc__install : doc_site_install
  • @echo INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
  • pure_perl_install ::
  • @$(MOD_INSTALL) \
  •   read $(PERL_ARCHLIB)/auto/$(FULLEXT)/.packlist \
    
  •   write $(INSTALLARCHLIB)/auto/$(FULLEXT)/.packlist \
    
  •   $(INST_LIB) $(INSTALLPRIVLIB) \
    
  •   $(INST_ARCHLIB) $(INSTALLARCHLIB) \
    
  •   $(INST_BIN) $(INSTALLBIN) \
    
  •   $(INST_SCRIPT) $(INSTALLSCRIPT) \
    
  •   $(INST_MAN1DIR) $(INSTALLMAN1DIR) \
    
  •   $(INST_MAN3DIR) $(INSTALLMAN3DIR)
    
  • @$(WARN_IF_OLD_PACKLIST) \
  •   $(SITEARCHEXP)/auto/$(FULLEXT)
    
  • pure_site_install ::
  • @$(MOD_INSTALL) \
  •   read $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist \
    
  •   write $(INSTALLSITEARCH)/auto/$(FULLEXT)/.packlist \
    
  •   $(INST_LIB) $(INSTALLSITELIB) \
    
  •   $(INST_ARCHLIB) $(INSTALLSITEARCH) \
    
  •   $(INST_BIN) $(INSTALLBIN) \
    
  •   $(INST_SCRIPT) $(INSTALLSCRIPT) \
    
  •   $(INST_MAN1DIR) $(INSTALLMAN1DIR) \
    
  •   $(INST_MAN3DIR) $(INSTALLMAN3DIR)
    
  • @$(WARN_IF_OLD_PACKLIST) \
  •   $(PERL_ARCHLIB)/auto/$(FULLEXT)
    
  • doc_perl_install ::
  • -@$(DOC_INSTALL) \
  •   "Module" "$(NAME)" \
    
  •   "installed into" "$(INSTALLPRIVLIB)" \
    
  •   LINKTYPE "$(LINKTYPE)" \
    
  •   VERSION "$(VERSION)" \
    
  •   EXE_FILES "$(EXE_FILES)" \
    
  •   >> $(INSTALLARCHLIB)/perllocal.pod
    
  • doc_site_install ::
  • -@$(DOC_INSTALL) \
  •   "Module" "$(NAME)" \
    
  •   "installed into" "$(INSTALLSITELIB)" \
    
  •   LINKTYPE "$(LINKTYPE)" \
    
  •   VERSION "$(VERSION)" \
    
  •   EXE_FILES "$(EXE_FILES)" \
    
  •   >> $(INSTALLARCHLIB)/perllocal.pod
    
  • uninstall :: uninstall_from_$(INSTALLDIRS)dirs
  • uninstall_from_perldirs ::
  • @$(UNINSTALL) $(PERL_ARCHLIB)/auto/$(FULLEXT)/.packlist
  • uninstall_from_sitedirs ::
  • @$(UNINSTALL) $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist
  • — MakeMaker force section:

  • Phony target to force checking subdirectories.

  • FORCE:
  • @$(NOOP)
  • — MakeMaker perldepend section:

  • — MakeMaker makefile section:

  • We take a very conservative approach here, but it's worth it.

  • We move Makefile to Makefile.old here to avoid gnu make looping.

  • Makefile : Makefile.PL $(CONFIGDEP)
  • @echo “Makefile out-of-date with respect to $?”
  • @echo “Cleaning current config before rebuilding Makefile…”
  • -@$(RM_F) Makefile.old
  • -@$(MV) Makefile Makefile.old
  • -$(MAKE) -f Makefile.old clean $(DEV_NULL) || $(NOOP)
  • $(PERL) “-I$(PERL_ARCHLIB)” “-I$(PERL_LIB)” Makefile.PL
  • @echo “==> Your Makefile has been rebuilt. <==”
  • @echo “==> Please rerun the make command. <==”
  • false
  • To change behavior to :: would be nice, but would break Tk b9.02

  • so you find such a warning below the dist target.

  • #Makefile :: $(VERSION_FROM)
  • @echo “Warning: Makefile possibly out of date with $(VERSION_FROM)”

  • — MakeMaker staticmake section:

  • — MakeMaker makeaperl section —

  • MAP_TARGET = perl
  • FULLPERL = /usr/bin/perl
  • $(MAP_TARGET) :: static $(MAKE_APERL_FILE)
  • $(MAKE) -f $(MAKE_APERL_FILE) $@
  • $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE)
  • @echo Writing "$(MAKE_APERL_FILE)" for this $(MAP_TARGET)
  • @$(PERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) \
  •   Makefile.PL DIR= \
    
  •   MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \
    
  •   MAKEAPERL=1 NORECURS=1 CCCDLFLAGS=
    
  • — MakeMaker test section:

  • TEST_VERBOSE=0
  • TEST_TYPE=test_$(LINKTYPE)
  • TEST_FILE = test.pl
  • TEST_FILES =
  • TESTDB_SW = -d
  • testdb :: testdb_$(LINKTYPE)
  • test :: $(TEST_TYPE)
  • test_dynamic :: pure_all
  • PERL_DL_NONLAZY=1 $(FULLPERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(TEST_FILE)
  • testdb_dynamic :: pure_all
  • PERL_DL_NONLAZY=1 $(FULLPERL) $(TESTDB_SW) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(TEST_FILE)
  • test_ : test_dynamic
  • test_static :: test_dynamic
  • testdb_static :: testdb_dynamic
  • — MakeMaker ppd section:

  • Creates a PPD (Perl Package Description) for a binary distribution.

  • ppd:
  • @$(PERL) -e “print qq{<SOFTPKG NAME="DBIx-Record" VERSION="0,02,0,0">\n}. qq{\tDBIx-Record\n}. qq{\t\n}. qq{\t\n}. qq{\t\n}. qq{\t\t<OS NAME="$(OSNAME)" />\n}. qq{\t\t<ARCHITECT
    URE NAME="i386-linux" />\n}. qq{\t\t<CODEBASE HREF="" />\n}. qq{\t\n}. qq{\n}” > DBIx-Record.ppd
  • — MakeMaker pm_to_blib section:

  • pm_to_blib: $(TO_INST_PM)
  • @$(PERL) “-I$(INST_ARCHLIB)” “-I$(INST_LIB)” \
  • “-I$(PERL_ARCHLIB)” “-I$(PERL_LIB)” -MExtUtils::Install \
  •     -e "pm_to_blib({qw{$(PM_TO_BLIB)}},'$(INST_LIB)/auto')"
    
  • @$(TOUCH) $@
  • — MakeMaker selfdocument section:

  • — MakeMaker postamble section:

  • End.

diff -c /dev/null ‘work/lib/DBIx/DBIx-Record/Makefile.PL’
Index: ./lib/DBIx/DBIx-Record/Makefile.PL
*** ./lib/DBIx/DBIx-Record/Makefile.PL Wed Dec 31 16:00:00 1969
— ./lib/DBIx/DBIx-Record/Makefile.PL Fri Aug 11 23:29:19 2000
*** 0 ****
— 1,7 ----

  • use ExtUtils::MakeMaker;
  • See lib/ExtUtils/MakeMaker.pm for details of how to influence

  • the contents of the Makefile that is written.

  • WriteMakefile(
  • 'NAME'	=> 'DBIx::Record',
    
  • 'VERSION_FROM' => 'Record.pm', # finds $VERSION
    
  • );
    diff -c /dev/null ‘work/lib/DBIx/DBIx-Record/Record.pm’
    Index: ./lib/DBIx/DBIx-Record/Record.pm
    *** ./lib/DBIx/DBIx-Record/Record.pm Wed Dec 31 16:00:00 1969
    — ./lib/DBIx/DBIx-Record/Record.pm Fri Aug 11 23:48:53 2000
    *** 0 ****
    — 1,452 ----
  • #$Header: /proj/maps/src/rt/lib/DBIx/DBIx-Record/Record.pm,v 1.1 2000/08/12 06:48:53 ivan Exp $
  • package DBIx::Record;
  • use strict;
  • use vars qw($VERSION @ISA $AUTOLOAD);
  • require Date::Kronos;
  • $VERSION = ‘0.02’;
  • Preloaded methods go here.

  • {{{ sub new

  • #instantiate a new record object.
  • sub new {
  • my $proto = shift;
    
  • my $class = ref($proto) || $proto;
    
  • my $self  = {};
    
  • bless ($self, $class);
    
  • return $self;
    
  • }
  • }}}

  • {{{ sub Id and id

  • sub Id {
  • my $self = shift;
    
  • return ($self->{'values'}->{'id'});
    
  • }
  • sub id {
  • my $self = shift;
    
  • return ($self->Id);
    
  • }
  • }}}

  • {{{ Datehandling

  • There is room for optimizations in most of those subs:

  • {{{ LastUpdatedObj

  • sub LastUpdatedObj {
  • my $self=shift;
    
  • my $obj=Date::Kronos->new();
    
  • $obj->sql_timestamp($self->LastUpdated);
    
  • return $obj;
    
  • }
  • }}}

  • {{{ CreatedObj

  • sub CreatedObj {
  • my $self=shift;
    
  • my $obj=Date::Kronos->new();
    
  • $obj->sql_timestamp($self->Created);
    
  • return $obj;
    
  • }
  • }}}

  • {{{ AgeAsString

  • sub AgeAsString {
  • my $self=shift;
    
  • my $now=Date::Kronos->new(cal_type=>'Unix');
    
  • my $age=$now-$self->CreatedObj;
    
  • return "$age ago";
    
  • }
  • }}}

  • {{{ LastUpdatedAsString

  • sub LastUpdatedAsString {
  • my $self=shift;
    
  • if ($self->LastUpdated) {
    
  • return $self->LastUpdatedObj->Gregorian->sql_timestamp;
  • } else {
    
  • return “never”;
  • }
    
  • }
  • }}}

  • {{{ CreatedAsString

  • sub CreatedAsString {
  • return CreatedObj(@_)->Gregorian->stringify;
    
  • }
  • }}}

  • {{{ LongSinceUpdateAsString

  • sub LongSinceUpdateAsString {
  • my $self=shift;
    
  • if ($self->LastUpdated && $self->LastUpdated ne '0000-00-00 00:00:00') {
    
  • my $now=Date::Kronos->new(cal_type=>‘Unix’);
  • my $age=$now-$self->LastUpdatedObj;
  • my $agestring=$age->Unix->stringify;
  • return “$agestring ago”;
  • } else {
    
  • return “never”;
  • }
    
  • }
  • }}}

  • }}} Datehandling

  • {{{ Routines dealing with getting and setting row data

  • {{{ sub DESTROY

  • sub DESTROY {
  • return 1;
    
  • }
  • }}}

  • {{{ sub AUTOLOAD

  • sub AUTOLOAD {
  • my $self = shift;
  • no strict ‘refs’;
  • if ($AUTOLOAD =~ /.*::(\w+)/ && $self->_Accessible($1,‘read’)) {
  • my $Attrib = $1;
    
  • *{$AUTOLOAD} = sub { return ($_[0]->_Value($Attrib))};
    
  • return($self->_Value($Attrib));
    
  • }
  • elsif ($AUTOLOAD =~ /.*::Set(\w+)/ && $self->_Accessible($1,‘write’)) {
  • my $Attrib = $1;
    
  • *{$AUTOLOAD} = sub {  return ($_[0]->_Set($Attrib, $_[1]))};
    
  • my $Value = shift @_;
    
  • return($self->_Set($Attrib, $Value));
    
  • }
    
  • #Previously, I checked for writability here. but I’m not sure that’s the
  • #right idea. it breaks the ability to do ValidateQueue for a ticket
  • #on creation.
  • elsif ($AUTOLOAD =~ /.*::Validate(\w+)/ ) {
  • my $Attrib = $1;
    
  • *{$AUTOLOAD} = sub {  return ($_[0]->_Validate($Attrib, $_[1]))};
    
  • my $Value = shift @_;
    
  • return($self->_Validate($Attrib, $Value));
    
  • }
    
  • TODO: if autoload = 0 or 1 _ then a combination of lowercase and _ chars,

  • turn them into studlycapped phrases

  • else {
  • my ($package, $filename, $line);
    
  • ($package, $filename, $line) = caller;
    
  • die "$AUTOLOAD Unimplemented in $package. ($filename line $line) \n";
    
  • }
  • }
  • }}}

  • {{{ sub _Accessible

  • sub _Accessible {
  • my $self = shift;
  • my $attrib = shift;
  • my $mode = shift;
  • my %cols = @_;
  • #return 0 if it’s not a valid attribute;
  • return undef unless ($cols{“$attrib”});
  • return true if we can $mode $Attrib;

  • $cols{$attrib} =~ /$mode/;
  • }
  • }}}

  • {{{ sub _Value

  • sub _Value {
  • my $self = shift;
  • my $field = shift;
  • return($self->{‘values’}->{“$field”});
  • }
  • }}}

  • {{{ sub _Set

  • sub _Set {
  • my $self = shift;
  • my $field = shift;
  • my $value = shift;
  • my $is_sql = shift;
  • my ($error_condition);
  • defined $field && !defined($value) && return (0,“No value sent to _Set!\n”);
  • if (defined $field) {
  • if ((defined $self->_Value($field))  && ($value eq $self->_Value($field))) {
    
  •   return (0, "That is already the current value");
    
  • } 
    
  • else {
    
  •   #TODO $self->_Validate($field, $value);
    
  •   $error_condition = $self->_Handle->UpdateTableValue($self->{'table'}, $field,$value,$self->id, $is_sql);
    
  •   # TODO: Deal better with error handling?
    
  •   return (0, "Some error has occurred")
    
  • unless ($error_condition);
    
  •   $self->{'values'}->{"$field"} = $value;
    
  • }
    
  • }
  • $error_condition = $self->_Handle->UpdateTableValue($self->{‘table’}, ‘LastUpdated’,‘now()’,$self->id)
  • if ($self->_Accessible('LastUpdated','auto'));
    
  • return (0, “Some error has occurred”)
  •   unless ($error_condition);
    
  • return (1, “The new value has been set.”);
  • }
  • }}}

  • {{{ sub _Validate

  • #TODO: Implement _Validate.
  • sub _Validate {
  • my $self = shift;
    
  • my $field = shift;
    
  • my $value = shift;
    
  • #Check type of input
    
  • #If it's null, are nulls permitted?
    
  • #If it's an int, check the # of bits
    
  • #If it's a string, 
    
  • #check length
    
  • #check for nonprintables
    
  • #If it's a blob, check for length
    
  • #In an ideal world, if this is a link to another table, check the dependency.
    
  • }
  • }}}

  • }}}

  • {{{ routines dealing with loading records

  • {{{ sub Load

  • load should do a bit of overloading

  • if we call it with only one argument, we’re trying to load by reference.

  • if we call it with a passel of arguments, we’re trying to load by value

  • The latter is primarily important when we’ve got a whole set of record that we’re

  • reading in with a recordset class and want to instantiate objefcts for each record.

  • *load =&Load;
  • sub Load {
  • my $self = shift;
    
  • my ($package, $filename, $line) = caller;
    
  • return $self->LoadById(@_);
    
  • }
  • }}}

  • {{{ sub LoadByCol

  • sub LoadByCol {
  • my $self = shift;
    
  • my $col = shift;
    
  • my $val = shift;
    
  • $val = $self->_Handle->safe_quote($val);
    
  • my $QueryString = "SELECT  * FROM ".$self->{'table'}." WHERE $col = $val";
    
  • return ($self->_LoadFromSQL($QueryString));
    
  • }
  • }}}

  • {{{ sub LoadById

  • sub LoadById {
  • my $self = shift;
    
  • my $id = shift;
    
  • $id = 0 if (!defined($id));
    
  • return ($self->LoadByCol('id',$id));
    
  • }
  • }}}

  • {{{ sub LoadFromHash

  • sub LoadFromHash {
  • my $self = shift;
  • my $hashref = shift;
  • $self->{‘values’} = $hashref;
  • return ($self->{‘values’}{‘id’});
  • }
  • }}}

  • {{{ sub _LoadFromSQL

  • sub _LoadFromSQL {
  • my $self = shift;
    
  • my $QueryString = shift;
    
  • my $sth = $self->_Handle->SimpleQuery($QueryString);
    
  • #TODO: COMPATIBILITY PROBLEM with fetchrow_hashref!
    
  • #Some DBMS'es returns uppercase, some returns lowercase,
    
  • #and mysql return mixedcase!
    
  • #TODO this only gets the first row. we should check if there are more.
    
  • $self->{'values'} = $sth->fetchrow_hashref;
    
  • unless ($self->{'values'}) {
    
  • warn “something might be wrong here; row not found. SQL: $QueryString”;

  • return undef;
  • }
    
  • unless ($self->{'values'}{'id'}) {
    
  • warn “something wrong here”;
  • }
    
  • return ($self->{'values'}{'id'});
    
  • }
  • }}}

  • }}}

  • {{{ Routines dealing with creating or deleting rows in the DB

  • {{{ sub Create

  • sub Create {
  • my $self = shift;
    
  • my @keyvalpairs = (@_);
    
  • my ($cols, $vals);
    
  • push @keyvalpairs, 'Created', 'now()'
    
  •   if $self->_Accessible('Created', 'auto');
    
  • while (my $key = shift @keyvalpairs) {
    
  •   my $value = shift @keyvalpairs;
    
  •   $cols .= $key . ", ";
    
  •   if (defined ($value)) {
    
  • $value = $self->_Handle->safe_quote($value)
    
  •     unless ($key=~/^(Created|LastUpdated)$/ && $value=~/^now\(\)$/i);
    
  • $vals .= "$value, ";
    
  •   }
    
  •   else {
    
  • $vals .= "NULL, ";
  •   }
    
  • }	
    
  • $cols =~ s/, $//;
    
  • $vals =~ s/, $//;
    
  • #TODO Check to make sure the key's not already listed.
    
  • #TODO update internal data structure
    
  • my $QueryString = "INSERT INTO ".$self->{'table'}." ($cols) VALUES ($vals)";
    
  • my $sth = $self->_Handle->SimpleQuery($QueryString);
    
  • if (!$sth) {
    
  •    if ($main::debug) {
    
  • die “Error with $QueryString”;
  •   }
    
  •    else {
    
  • return (0);
  •    }
    
  •  }
    
  • #Todo degeneralize this
    
  • $self->{'id'}=$sth->{'mysql_insertid'};
    
  • return( $self->{'id'}); #Add Succeded. return the id
    
  • }
  • }}}

  • {{{ sub Delete

  • sub Delete {
  • my $self = shift;
    
  • #TODO Check to make sure the key's not already listed.
    
  • #TODO Update internal data structure
    
  • my $QueryString = "DELETE FROM ".$self->{'table'} . " WHERE id  = ". $self->id();
    
  • ## TODO: This seems broken to me:
    
  • return($self->_Handle->FetchResult($QueryString));

  • return($self->_Handle->SimpleQuery($QueryString));
    
  • }
  • }}}

  • }}}

  • {{{ Routines dealing with database handles

  • TODO: Combine into _Handle this will involve modifying subclasses.

  • {{{ sub _Handle

  • sub _Handle {
  • my $self = shift;
    
  • if (@_) {
    
  •   $self->{'DBIxHandle'} = shift;
    
  • }
    
  • return ($self->{'DBIxHandle'});
    
  • }
  • }}}

  • }}}

  • 1;
  • END
  • {{{ POD

  • =head1 NAME
  • DBIx::Record - Perl extension for subclassing, so you can deal with a Record
  • =head1 SYNOPSIS
  • use DBIx::Record;
  • =head1 DESCRIPTION
  • DBIX::Record is designed to work with DBIx::EasySearch. Users should almost
  • never create DBIx::Record objects themselves.
  • Docs are forthcoming. If you pester jesse@fsck.com he’ll put them together.
  • Check out Request Tracker at http://www.fsck.com/projects/rt/ for examples of usage.
  • =head1 AUTHOR
  • Jesse Vincent, jesse@fsck.com
  • =head1 SEE ALSO
  • perl(1).
  • =cut
  • }}}

diff -c /dev/null ‘work/lib/DBIx/DBIx-Record/blib/lib/DBIx/Record.pm’
Index: ./lib/DBIx/DBIx-Record/blib/lib/DBIx/Record.pm
*** ./lib/DBIx/DBIx-Record/blib/lib/DBIx/Record.pm Wed Dec 31 16:00:00 1969
— ./lib/DBIx/DBIx-Record/blib/lib/DBIx/Record.pm Fri Aug 11 18:07:19 2000
*** 0 ****
— 1,452 ----

  • #$Header: /cvsroot/twort/rt/lib/DBIx/Record.pm,v 1.1 2000/08/03 12:28:52 tobix Exp $
  • package DBIx::Record;
  • use strict;
  • use vars qw($VERSION @ISA $AUTOLOAD);
  • require Date::Kronos;
  • $VERSION = ‘0.02’;
  • Preloaded methods go here.

  • {{{ sub new

  • #instantiate a new record object.
  • sub new {
  • my $proto = shift;
    
  • my $class = ref($proto) || $proto;
    
  • my $self  = {};
    
  • bless ($self, $class);
    
  • return $self;
    
  • }
  • }}}

  • {{{ sub Id and id

  • sub Id {
  • my $self = shift;
    
  • return ($self->{'values'}->{'id'});
    
  • }
  • sub id {
  • my $self = shift;
    
  • return ($self->Id);
    
  • }
  • }}}

  • {{{ Datehandling

  • There is room for optimizations in most of those subs:

  • {{{ LastUpdatedObj

  • sub LastUpdatedObj {
  • my $self=shift;
    
  • my $obj=Date::Kronos->new();
    
  • $obj->sql_timestamp($self->LastUpdated);
    
  • return $obj;
    
  • }
  • }}}

  • {{{ CreatedObj

  • sub CreatedObj {
  • my $self=shift;
    
  • my $obj=Date::Kronos->new();
    
  • $obj->sql_timestamp($self->Created);
    
  • return $obj;
    
  • }
  • }}}

  • {{{ AgeAsString

  • sub AgeAsString {
  • my $self=shift;
    
  • my $now=Date::Kronos->new(cal_type=>'Unix');
    
  • my $age=$now-$self->CreatedObj;
    
  • return "$age ago";
    
  • }
  • }}}

  • {{{ LastUpdatedAsString

  • sub LastUpdatedAsString {
  • my $self=shift;
    
  • if ($self->LastUpdated) {
    
  • return $self->LastUpdatedObj->Gregorian->sql_timestamp;
  • } else {
    
  • return “never”;
  • }
    
  • }
  • }}}

  • {{{ CreatedAsString

  • sub CreatedAsString {
  • return CreatedObj(@_)->Gregorian->stringify;
    
  • }
  • }}}

  • {{{ LongSinceUpdateAsString

  • sub LongSinceUpdateAsString {
  • my $self=shift;
    
  • if ($self->LastUpdated && $self->LastUpdated ne '0000-00-00 00:00:00') {
    
  • my $now=Date::Kronos->new(cal_type=>‘Unix’);
  • my $age=$now-$self->LastUpdatedObj;
  • my $agestring=$age->Unix->stringify;
  • return “$agestring ago”;
  • } else {
    
  • return “never”;
  • }
    
  • }
  • }}}

  • }}} Datehandling

  • {{{ Routines dealing with getting and setting row data

  • {{{ sub DESTROY

  • sub DESTROY {
  • return 1;
    
  • }
  • }}}

  • {{{ sub AUTOLOAD

  • sub AUTOLOAD {
  • my $self = shift;
  • no strict ‘refs’;
  • if ($AUTOLOAD =~ /.*::(\w+)/ && $self->_Accessible($1,‘read’)) {
  • my $Attrib = $1;
    
  • *{$AUTOLOAD} = sub { return ($_[0]->_Value($Attrib))};
    
  • return($self->_Value($Attrib));
    
  • }
  • elsif ($AUTOLOAD =~ /.*::Set(\w+)/ && $self->_Accessible($1,‘write’)) {
  • my $Attrib = $1;
    
  • *{$AUTOLOAD} = sub {  return ($_[0]->_Set($Attrib, $_[1]))};
    
  • my $Value = shift @_;
    
  • return($self->_Set($Attrib, $Value));
    
  • }
    
  • #Previously, I checked for writability here. but I’m not sure that’s the
  • #right idea. it breaks the ability to do ValidateQueue for a ticket
  • #on creation.
  • elsif ($AUTOLOAD =~ /.*::Validate(\w+)/ ) {
  • my $Attrib = $1;
    
  • *{$AUTOLOAD} = sub {  return ($_[0]->_Validate($Attrib, $_[1]))};
    
  • my $Value = shift @_;
    
  • return($self->_Validate($Attrib, $Value));
    
  • }
    
  • TODO: if autoload = 0 or 1 _ then a combination of lowercase and _ chars,

  • turn them into studlycapped phrases

  • else {
  • my ($package, $filename, $line);
    
  • ($package, $filename, $line) = caller;
    
  • die "$AUTOLOAD Unimplemented in $package. ($filename line $line) \n";
    
  • }
  • }
  • }}}

  • {{{ sub _Accessible

  • sub _Accessible {
  • my $self = shift;
  • my $attrib = shift;
  • my $mode = shift;
  • my %cols = @_;
  • #return 0 if it’s not a valid attribute;
  • return undef unless ($cols{“$attrib”});
  • return true if we can $mode $Attrib;

  • $cols{$attrib} =~ /$mode/;
  • }
  • }}}

  • {{{ sub _Value

  • sub _Value {
  • my $self = shift;
  • my $field = shift;
  • return($self->{‘values’}->{“$field”});
  • }
  • }}}

  • {{{ sub _Set

  • sub _Set {
  • my $self = shift;
  • my $field = shift;
  • my $value = shift;
  • my $is_sql = shift;
  • my ($error_condition);
  • defined $field && !defined($value) && return (0,“No value sent to _Set!\n”);
  • if (defined $field) {
  • if ((defined $self->_Value($field))  && ($value eq $self->_Value($field))) {
    
  •   return (0, "That is already the current value");
    
  • } 
    
  • else {
    
  •   #TODO $self->_Validate($field, $value);
    
  •   $error_condition = $self->_Handle->UpdateTableValue($self->{'table'}, $field,$value,$self->id, $is_sql);
    
  •   # TODO: Deal better with error handling?
    
  •   return (0, "Some error has occurred")
    
  • unless ($error_condition);
    
  •   $self->{'values'}->{"$field"} = $value;
    
  • }
    
  • }
  • $error_condition = $self->_Handle->UpdateTableValue($self->{‘table’}, ‘LastUpdated’,‘now()’,$self->id)
  • if ($self->_Accessible('LastUpdated','auto'));
    
  • return (0, “Some error has occurred”)
  •   unless ($error_condition);
    
  • return (1, “The new value has been set.”);
  • }
  • }}}

  • {{{ sub _Validate

  • #TODO: Implement _Validate.
  • sub _Validate {
  • my $self = shift;
    
  • my $field = shift;
    
  • my $value = shift;
    
  • #Check type of input
    
  • #If it's null, are nulls permitted?
    
  • #If it's an int, check the # of bits
    
  • #If it's a string, 
    
  • #check length
    
  • #check for nonprintables
    
  • #If it's a blob, check for length
    
  • #In an ideal world, if this is a link to another table, check the dependency.
    
  • }
  • }}}

  • }}}

  • {{{ routines dealing with loading records

  • {{{ sub Load

  • load should do a bit of overloading

  • if we call it with only one argument, we’re trying to load by reference.

  • if we call it with a passel of arguments, we’re trying to load by value

  • The latter is primarily important when we’ve got a whole set of record that we’re

  • reading in with a recordset class and want to instantiate objefcts for each record.

  • *load =&Load;
  • sub Load {
  • my $self = shift;
    
  • my ($package, $filename, $line) = caller;
    
  • return $self->LoadById(@_);
    
  • }
  • }}}

  • {{{ sub LoadByCol

  • sub LoadByCol {
  • my $self = shift;
    
  • my $col = shift;
    
  • my $val = shift;
    
  • $val = $self->_Handle->safe_quote($val);
    
  • my $QueryString = "SELECT  * FROM ".$self->{'table'}." WHERE $col = $val";
    
  • return ($self->_LoadFromSQL($QueryString));
    
  • }
  • }}}

  • {{{ sub LoadById

  • sub LoadById {
  • my $self = shift;
    
  • my $id = shift;
    
  • $id = 0 if (!defined($id));
    
  • return ($self->LoadByCol('id',$id));
    
  • }
  • }}}

  • {{{ sub LoadFromHash

  • sub LoadFromHash {
  • my $self = shift;
  • my $hashref = shift;
  • $self->{‘values’} = $hashref;
  • return ($self->{‘values’}{‘id’});
  • }
  • }}}

  • {{{ sub _LoadFromSQL

  • sub _LoadFromSQL {
  • my $self = shift;
    
  • my $QueryString = shift;
    
  • my $sth = $self->_Handle->SimpleQuery($QueryString);
    
  • #TODO: COMPATIBILITY PROBLEM with fetchrow_hashref!
    
  • #Some DBMS'es returns uppercase, some returns lowercase,
    
  • #and mysql return mixedcase!
    
  • #TODO this only gets the first row. we should check if there are more.
    
  • $self->{'values'} = $sth->fetchrow_hashref;
    
  • unless ($self->{'values'}) {
    
  • warn “something might be wrong here; row not found. SQL: $QueryString”;

  • return undef;
  • }
    
  • unless ($self->{'values'}{'id'}) {
    
  • warn “something wrong here”;
  • }
    
  • return ($self->{'values'}{'id'});
    
  • }
  • }}}

  • }}}

  • {{{ Routines dealing with creating or deleting rows in the DB

  • {{{ sub Create

  • sub Create {
  • my $self = shift;
    
  • my @keyvalpairs = (@_);
    
  • my ($cols, $vals);
    
  • push @keyvalpairs, 'Created', 'now()'
    
  •   if $self->_Accessible('Created', 'auto');
    
  • while (my $key = shift @keyvalpairs) {
    
  •   my $value = shift @keyvalpairs;
    
  •   $cols .= $key . ", ";
    
  •   if (defined ($value)) {
    
  • $value = $self->_Handle->safe_quote($value)
    
  •     unless ($key=~/^(Created|LastUpdated)$/ && $value=~/^now\(\)$/i);
    
  • $vals .= "$value, ";
    
  •   }
    
  •   else {
    
  • $vals .= "NULL, ";
  •   }
    
  • }	
    
  • $cols =~ s/, $//;
    
  • $vals =~ s/, $//;
    
  • #TODO Check to make sure the key's not already listed.
    
  • #TODO update internal data structure
    
  • my $QueryString = "INSERT INTO ".$self->{'table'}." ($cols) VALUES ($vals)";
    
  • my $sth = $self->_Handle->SimpleQuery($QueryString);
    
  • if (!$sth) {
    
  •    if ($main::debug) {
    
  • die “Error with $QueryString”;
  •   }
    
  •    else {
    
  • return (0);
  •    }
    
  •  }
    
  • #Todo degeneralize this
    
  • $self->{'id'}=$sth->{'mysql_insertid'};
    
  • return( $self->{'id'}); #Add Succeded. return the id
    
  • }
  • }}}

  • {{{ sub Delete

  • sub Delete {
  • my $self = shift;
    
  • #TODO Check to make sure the key's not already listed.
    
  • #TODO Update internal data structure
    
  • my $QueryString = "DELETE FROM ".$self->{'table'} . " WHERE id  = ". $self->id();
    
  • ## TODO: This seems broken to me:
    
  • return($self->_Handle->FetchResult($QueryString));

  • return($self->_Handle->SimpleQuery($QueryString));
    
  • }
  • }}}

  • }}}

  • {{{ Routines dealing with database handles

  • TODO: Combine into _Handle this will involve modifying subclasses.

  • {{{ sub _Handle

  • sub _Handle {
  • my $self = shift;
    
  • if (@_) {
    
  •   $self->{'DBIxHandle'} = shift;
    
  • }
    
  • return ($self->{'DBIxHandle'});
    
  • }
  • }}}

  • }}}

  • 1;
  • END
  • {{{ POD

  • =head1 NAME
  • DBIx::Record - Perl extension for subclassing, so you can deal with a Record
  • =head1 SYNOPSIS
  • use DBIx::Record;
  • =head1 DESCRIPTION
  • DBIX::Record is designed to work with DBIx::EasySearch. Users should almost
  • never create DBIx::Record objects themselves.
  • Docs are forthcoming. If you pester jesse@fsck.com he’ll put them together.
  • Check out Request Tracker at http://www.fsck.com/projects/rt/ for examples of usage.
  • =head1 AUTHOR
  • Jesse Vincent, jesse@fsck.com
  • =head1 SEE ALSO
  • perl(1).
  • =cut
  • }}}

diff -c /dev/null ‘work/lib/DBIx/DBIx-Record/blib/man3/DBIx::Record.3pm’
Index: ./lib/DBIx/DBIx-Record/blib/man3/DBIx::Record.3pm
*** ./lib/DBIx/DBIx-Record/blib/man3/DBIx::Record.3pm Wed Dec 31 16:00:00 1969
— ./lib/DBIx/DBIx-Record/blib/man3/DBIx::Record.3pm Fri Aug 11 23:43:20 2000
*** 0 ****
— 1,219 ----

  • .rn ‘’ }`
  • ‘’’ $RCSfile$$Revision$$Date$
  • ‘’’
  • ‘’’ $Log$
  • ‘’’
  • .de Sh
  • .br
  • .if t .Sp
  • .ne 5
  • .PP
  • \fB\$1\fR
  • .PP
  • .de Sp
  • .if t .sp .5v
  • .if n .sp
  • .de Ip
  • .br
  • .ie \n(.$>=3 .ne \$3
  • .el .ne 3
  • .IP “\$1” \$2
  • .de Vb
  • .ft CW
  • .nf
  • .ne \$1
  • .de Ve
  • .ft R
  • .fi
  • ‘’’
  • ‘’’
  • ‘’’ Set up *(-- to give an unbreakable dash;
  • ‘’’ string Tr holds user defined translation string.
  • ‘’’ Bell System Logo is used as a dummy character.
  • ‘’’
  • .tr (*W-|(bv*(Tr
  • .ie n {\
  • .ds – (*W-
  • .ds PI pi
  • .if (\n(.H=4u)&(1m=24u) .ds – (*W\h’-12u’(*W\h’-12u’-" diablo 10 pitch
  • .if (\n(.H=4u)&(1m=20u) .ds – (*W\h’-12u’(*W\h’-8u’-" diablo 12 pitch
  • .ds L" “”
  • .ds R" “”
  • ‘’’ *(M", *(S", *(N" and *(T" are the equivalent of
  • ‘’’ *(L" and *(R", except that they are used on “.xx” lines,
  • ‘’’ such as .IP and .SH, which do another additional levels of
  • ‘’’ double-quote interpretation
  • .ds M" “”"
  • .ds S" “”"
  • .ds N" “”“”"
  • .ds T" “”“”"
  • .ds L’ ’
  • .ds R’ ’
  • .ds M’ ’
  • .ds S’ ’
  • .ds N’ ’
  • .ds T’ ’
  • 'br}
  • .el{\
  • .ds – (em|
  • .tr *(Tr
  • .ds L" ``
  • .ds R" ‘’
  • .ds M" ``
  • .ds S" ‘’
  • .ds N" ``
  • .ds T" ‘’
  • .ds L’ `
  • .ds R’ ’
  • .ds M’ `
  • .ds S’ ’
  • .ds N’ `
  • .ds T’ ’
  • .ds PI (*p
  • 'br}
  • ." If the F register is turned on, we’ll generate
  • ." index entries out stderr for the following things:
  • ." TH Title
  • ." SH Header
  • ." Sh Subsection
  • ." Ip Item
  • ." X<> Xref (embedded
  • ." Of course, you have to process the output yourself
  • ." in some meaninful fashion.
  • .if \nF {
  • .de IX
  • .tm Index:\$1\t\n%\t"\$2"
  • .nr % 0
  • .rr F
  • .}
  • .TH Record 3pm “perl 5.005, patch 03” “11/Aug/2000” “User Contributed Perl Documentation”
  • .UC
  • .if n .hy 0
  • .if n .na
  • .ds C+ C\v’-.1v’\h’-1p’\s-2+\h’-1p’+\s0\v’.1v’\h’-1p’
  • .de CQ " put $1 in typewriter font
  • .ft CW
  • 'if n "\c
  • 'if t \&\$1\c
  • 'if n \&\$1\c
  • 'if n &"
  • \&\$2 \$3 \$4 \$5 \$6 \$7
  • '.ft R
  • ." @(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2
  • . " AM - accent mark definitions
  • .bd B 3
  • . " fudge factors for nroff and troff
  • .if n {\
  • . ds #H 0
  • . ds #V .8m
  • . ds #F .3m
  • . ds #[ \f1
  • . ds #] \fP
  • .}
  • .if t {\
  • . ds #H ((1u-(\\n(.fu%2u))*.13m)
  • . ds #V .6m
  • . ds #F 0
  • . ds #[ &
  • . ds #] &
  • .}
  • . " simple accents for nroff and troff
  • .if n {\
  • . ds ’ &
  • . ds ` &
  • . ds ^ &
  • . ds , &
  • . ds ~ ~
  • . ds ? ?
  • . ds ! !
  • . ds /
  • . ds q
  • .}
  • .if t {\
  • . ds ’ \k:\h’-(\n(.wu*8/10-*(#H)''\h"|\n:u"
  • . ds \\k:\h'-(\\n(.wu*8/10-\*(#H)'\\h’|\n:u’
  • . ds ^ \k:\h’-(\n(.wu*10/11-*(#H)‘^\h’|\n:u’
  • . ds , \k:\h’-(\n(.wu*8/10)‘,\h’|\n:u’
  • . ds ~ \k:\h’-(\n(.wu-*(#H-.1m)‘~\h’|\n:u’
  • . ds ? \s-2c\h’-\w’c’u7/10’\u\h’*(#H’\zi\d\s+2\h’\w’c’u8/10’
  • . ds ! \s-2(or\s+2\h’-\w’(or’u’\v’-.8m’.\v’.8m’
  • . ds / \k:\h’-(\n(.wu*8/10-*(#H)‘\z(sl\h’|\n:u’
  • . ds q o\h’-\w’o’u*8/10’\s-4\v’.4m’\z(i\v’-.4m’\s+4\h’\w’o’u8/10’
  • .}
  • . " troff and (daisy-wheel) nroff accents
  • .ds : \k:\h’-(\n(.wu*8/10-*(#H+.1m+*(#F)‘\v’-*(#V’\z.\h’.2m+*(#F’.\h’|\n:u’\v’*(#V
  • .ds 8 \h’*(#H’(*b\h’-*(#H
  • .ds v \k:\h’-(\n(.wu*9/10-*(#H)‘\v’-*(#V’*(#[\s-4v\s0\v’*(#V’\h’|\n:u’*(#]
  • .ds _ \k:\h’-(\n(.wu9/10-*(#H+(*(#F2/3))‘\v’-.4m’\z(hy\v’.4m’\h’|\n:u’
  • .ds . \k:\h’-(\n(.wu8/10)‘\v’*(#V4/10’\z.\v’-*(#V*4/10’\h’|\n:u’
  • .ds 3 *(#[\v’.2m’\s-2&3\s0\v’-.2m’*(#]
  • .ds o \k:\h’-(\n(.wu+\w’(de’u-*(#H)/2u’\v’-.3n’*(#[\z(de\v’.3n’\h’|\n:u’*(#]
  • .ds d- \h’*(#H’(pd\h’-\w’~‘u’\v’-.25m’\f2(hy\fP\v’.25m’\h’-*(#H
  • .ds D- D\k:\h’-\w’D’u’\v’-.11m’\z(hy\v’.11m’\h’|\n:u’
  • .ds th *(#[\v’.3m’\s+1I\s-1\v’-.3m’\h’-(\w’I’u*2/3)'\s-1o\s+1*(#]
  • .ds Th *(#[\s+2I\s-2\h’-\w’I’u*3/5’\v’-.3m’o\v’.3m’*(#]
  • .ds ae a\h’-(\w’a’u*4/10)'e
  • .ds Ae A\h’-(\w’A’u*4/10)'E
  • .ds oe o\h’-(\w’o’u*4/10)'e
  • .ds Oe O\h’-(\w’O’u*4/10)'E
  • . " corrections for vroff
  • .if v .ds ~ \k:\h’-(\n(.wu*9/10-*(#H)‘\s-2\u~\d\s+2\h’|\n:u’
  • .if v .ds ^ \k:\h’-(\n(.wu*10/11-*(#H)‘\v’-.4m’^\v’.4m’\h’|\n:u’
  • . " for low resolution devices (crt and lpr)
  • .if \n(.H>23 .if \n(.V>19 \
  • {\
  • . ds : e
  • . ds 8 ss
  • . ds v \h’-1’\o’(aa(ga’
  • . ds _ \h’-1’^
  • . ds . \h’-1’.
  • . ds 3 3
  • . ds o a
  • . ds d- d\h’-1’(ga
  • . ds D- D\h’-1’(hy
  • . ds th \o’bp’
  • . ds Th \o’LP’
  • . ds ae ae
  • . ds Ae AE
  • . ds oe oe
  • . ds Oe OE
  • .}
  • .rm #[ #] #H #V #F C
  • .SH “NAME”
  • DBIx::Record - Perl extension for subclassing, so you can deal with a Record
  • .SH “SYNOPSIS”
  • .PP
  • .Vb 1
  • & use DBIx::Record;
  • .Ve
  • .SH “DESCRIPTION DBIX::Record is designed to work with DBIx::EasySearch. Users should almost never create DBIx::Record objects themselves.”
  • Docs are forthcoming. If you pester jesse@fsck.com he’ll put them together.
  • .PP
  • Check out Request Tracker at http://www.fsck.com/projects/rt/ for examples of usage.
  • .SH “AUTHOR”
  • Jesse Vincent, jesse@fsck.com
  • .SH “SEE ALSO”
  • \fIperl\fR|(1).
  • .rn }` ‘’
  • .IX Title “Record 3pm”
  • .IX Name “DBIx::Record - Perl extension for subclassing, so you can deal with a Record”
  • .IX Header “NAME”
  • .IX Header “SYNOPSIS”
  • .IX Header “DESCRIPTION DBIX::Record is designed to work with DBIx::EasySearch. Users should almost never create DBIx::Record objects themselves.”
  • .IX Header “AUTHOR”
  • .IX Header “SEE ALSO”
    diff -c /dev/null ‘work/lib/DBIx/DBIx-Record/test.pl’
    Index: ./lib/DBIx/DBIx-Record/test.pl
    *** ./lib/DBIx/DBIx-Record/test.pl Wed Dec 31 16:00:00 1969
    — ./lib/DBIx/DBIx-Record/test.pl Fri Aug 11 23:29:19 2000
    *** 0 ****
    — 1,20 ----
  • Before `make install’ is performed this script should be runnable with

  • make test'. After make install’ it should work as `perl test.pl’

  • ######################### We start with some black magic to print on failure.
  • Change 1…1 below to 1…last_test_to_print .

  • (It may become useful if the test is moved to ./t subdirectory.)

  • BEGIN { $| = 1; print “1…1\n”; }
  • END {print “not ok 1\n” unless $loaded;}
  • use DBIx::Record;
  • $loaded = 1;
  • print “ok 1\n”;
  • ######################### End of black magic.
  • Insert your test code below (better if it prints “ok 13”

  • (correspondingly “not ok 13”) depending on the success of chunk 13

  • of the test code):

End of Patch data

ApplyPatch data follows

Data version : 1.0

Date generated : Sat Aug 12 01:41:14 2000

Generated by : makepatch 2.00

Recurse directories : Yes

Excluded files : (\A|./)CVS(/.|\Z)

(\A|./)RCS(/.|\Z)

,v\Z

(\A|./)SCCS(/.|\Z)

(\A|.*/)[sp]..+\Z

r ‘lib/DBIx/Record.pm’ 9371 0

r ‘lib/DBIx/Handle.pm’ 3575 0

r ‘lib/DBIx/EasySearch.pm’ 15056 0

p ‘README’ 10536 966062902 0100755

c ‘lib/DBIx/DBIx-EasySearch/Changes’ 0 966061739 0100644

c ‘lib/DBIx/DBIx-EasySearch/EasySearch.pm’ 0 966062932 0100755

c ‘lib/DBIx/DBIx-EasySearch/MANIFEST’ 0 966061740 0100644

c ‘lib/DBIx/DBIx-EasySearch/Makefile’ 0 966062597 0100644

c ‘lib/DBIx/DBIx-EasySearch/Makefile.PL’ 0 966061739 0100644

c ‘lib/DBIx/DBIx-EasySearch/blib/lib/DBIx/EasySearch.pm’ 0 966042438 0100555

c ‘lib/DBIx/DBIx-EasySearch/blib/man3/DBIx::EasySearch.3pm’ 0 966062598 0100644

c ‘lib/DBIx/DBIx-EasySearch/test.pl’ 0 966061739 0100644

c ‘lib/DBIx/DBIx-Handle/Changes’ 0 966061755 0100644

c ‘lib/DBIx/DBIx-Handle/Handle.pm’ 0 966062932 0100755

c ‘lib/DBIx/DBIx-Handle/MANIFEST’ 0 966061755 0100644

c ‘lib/DBIx/DBIx-Handle/Makefile’ 0 966062598 0100644

c ‘lib/DBIx/DBIx-Handle/Makefile.PL’ 0 966061755 0100644

c ‘lib/DBIx/DBIx-Handle/blib/lib/DBIx/Handle.pm’ 0 966042438 0100555

c ‘lib/DBIx/DBIx-Handle/blib/man3/DBIx::Handle.3pm’ 0 966062599 0100644

c ‘lib/DBIx/DBIx-Handle/test.pl’ 0 966061755 0100644

c ‘lib/DBIx/DBIx-Record/Changes’ 0 966061759 0100644

c ‘lib/DBIx/DBIx-Record/MANIFEST’ 0 966061759 0100644

c ‘lib/DBIx/DBIx-Record/Makefile’ 0 966062600 0100644

c ‘lib/DBIx/DBIx-Record/Makefile.PL’ 0 966061759 0100644

c ‘lib/DBIx/DBIx-Record/Record.pm’ 0 966062933 0100755

c ‘lib/DBIx/DBIx-Record/blib/lib/DBIx/Record.pm’ 0 966042439 0100555

c ‘lib/DBIx/DBIx-Record/blib/man3/DBIx::Record.3pm’ 0 966062600 0100644

c ‘lib/DBIx/DBIx-Record/test.pl’ 0 966061759 0100644

C ‘lib/DBIx/DBIx-EasySearch’ 0 966062932 042755

C ‘lib/DBIx/DBIx-EasySearch/blib’ 0 966062583 042755

C ‘lib/DBIx/DBIx-EasySearch/blib/lib’ 0 966062583 042755

C ‘lib/DBIx/DBIx-EasySearch/blib/lib/DBIx’ 0 966062583 040755

C ‘lib/DBIx/DBIx-EasySearch/blib/man3’ 0 966062583 040755

C ‘lib/DBIx/DBIx-Handle’ 0 966062932 042755

C ‘lib/DBIx/DBIx-Handle/blib’ 0 966062585 042755

C ‘lib/DBIx/DBIx-Handle/blib/lib’ 0 966062585 042755

C ‘lib/DBIx/DBIx-Handle/blib/lib/DBIx’ 0 966062586 040755

C ‘lib/DBIx/DBIx-Handle/blib/man3’ 0 966062586 040755

C ‘lib/DBIx/DBIx-Record’ 0 966062933 042755

C ‘lib/DBIx/DBIx-Record/blib’ 0 966062588 042755

C ‘lib/DBIx/DBIx-Record/blib/lib’ 0 966062587 042755

C ‘lib/DBIx/DBIx-Record/blib/lib/DBIx’ 0 966062588 040755

C ‘lib/DBIx/DBIx-Record/blib/man3’ 0 966062588 040755

End of ApplyPatch data

End of Patch kit [created: Sat Aug 12 01:41:14 2000]

Checksum: 5900 151587 23682

meow
_ivan


  1. dD ↩︎

  2. dD ↩︎