[Maypole] Where are we up to?

Bill Moseley moseley@hank.org
Mon, 8 Mar 2004 17:55:29 -0800


On Mon, Mar 08, 2004 at 05:37:21PM -0800, Dave Ranney wrote:
> Bill,
> 
> >Postgres?
> >
> >I seem to have fixed the CDBI::Loader::Pg and CDBI::Pg modules to work
> >with 7.4.1  and now my classes are automatically created.  I spent my
> >time on that problem instead of groking the Maypole code otherwise I'd
> >likely have some comments.
> 
> What was required to fix those modules? Are there patches available?

They are hacks.  I'm not familiar enough with the Postgres metadata to
know for sure I didn't break things.  But, there were two problems that
I could see: First, DBI was returning *all* the tables, including all
the meta data tables.  So Loader::Pg was creating classes with odd names
and not just for my tables.  So what I did was filter on the "public.*"
tables as you can see in the patch.

The second thing was CDBI::Pg was expecting only single primary keys,
and I have a link table that has two keys (another issue is how to use
with Maypole) and CDBI::Pg was croaking on that.

My "patch" is below.  It would be great to see someone else look it
over.

> >Anyway, before investing more time, is there any chance that a
> >Postgresql database will work with Maypole at this time?
> 
> If your classes are being loaded successfully, you should be able to 
> get Maypole working. What exactly is going wrong? Error messages? Post 
> more info here and I'll give it a shot with Postgres.

First let me just post my setup and see if I'm doing anything stupid, ok? ;)
Then I can plug away.  But are there not issues with building form
elements with Postgresql?  I was expecting to override the form
generation with my own templates.  (I like to use HTML::FillInForm for
creating sticky forms.)

But, without a working setup it's been hard to understand what I can and
can't do.

My test application is for registering students to classes.  A class is defined
as a specific workshop, given at a location, by a teacher, on some date.

moseley@bumby:~/workshop$ cat Workshop.pm 
package Workshop;
use base 'Apache::MVC';


__PACKAGE__->setup("dbi:Pg:dbname=workshop;host=bumby", "user", "pass" );

__PACKAGE__->config->{uri_base} = "http://bumby:2345/workshop/";
__PACKAGE__->config->{rows_per_page} = 10;
__PACKAGE__->config->{display_tables} = [ qw/ workshop teacher location student class / ];

Workshop::Workshop->untaint_columns(
        printable => [ qw/ name description / ],
);

Workshop::Teacher->untaint_columns(
        printable => [ qw/ name email / ],
);

Workshop::Location->untaint_columns(
        printable => [ qw/ name address / ],
);

Workshop::Student->untaint_columns(
        printable => [ qw/ name / ],
        integer => [ qw/ age / ],
);

Workshop::Class->untaint_columns(
        date => [ 'date' ],
        integer => [ qw/ location workshop teacher / ],
);

Workshop::Class->has_a( location => "Workshop::Location" );
Workshop::Class->has_a( workshop => "Workshop::Workshop" );
Workshop::Class->has_a( teacher => "Workshop::Teacher" );


Workshop::Registration->has_a( student => "Workshop::Student" );
Workshop::Registration->has_a( class => "Workshop::Class" );

Workshop::Workshop->has_many( classes => "Workshop::Class" );

1;

moseley@bumby:~/workshop$ cat httpd.conf 
<ifModule mod_so.c>
    Include /etc/apache-perl/modules.conf
</IfModule>

LogFormat "%h %l \"%u\" %t \"%r\" %s %b \"%{Referer}i\" \"%{User-Agent}i\" %P" combined

ErrorLog /home/moseley/apache-perl/error_log
TransferLog /home/moseley/apache-perl/access_log
PidFile /home/moseley/apache-perl/httpd.pid

User nobody
Group users

Listen *:2345

<perl>
use lib '/home/moseley/workshop';
require Workshop;
</perl>

NameVirtualHost *:2345
<VirtualHost *:2345>
        DocumentRoot /home/moseley/workshop/public_html
        ServerName bumby

        <location /workshop>
                SetHandler perl-script
                PerlHandler Workshop
        </location>

        <location /perl-status>
            PerlSetVar StatusDumper On
            PerlSetVar StatusTerseSizeMainSummary On
            SetHandler  perl-script
        PerlHandler Apache::Status
     </Location>

</VirtualHost>





--- /usr/share/perl5/Class/DBI/Loader/Pg.pm     2002-08-26 01:03:40.000000000 -0700
+++ Loader::Pg.pm       2004-03-08 16:51:46.000000000 -0800
@@ -15,6 +15,14 @@
     my $self = shift;
     my $dbh = DBI->connect(@{$self->_datasource}) or _croak($DBI::errstr);
     foreach my $table($dbh->tables) {
+
+        # Check for Pg 7.4.x for these
+        ## That's just the version I'm using, so no idea if pre 7.4 needed this
+        if ( $self->pg_version( $dbh ) >= 7.4 ) {
+            next unless $table =~ /public\.(.+)$/;
+            $table = $1;
+        }
+
        my $class = $self->_table2class($table);
        no strict 'refs';
        @{"$class\::ISA"} = qw(Class::DBI::Pg);
@@ -25,6 +33,19 @@
     $dbh->disconnect;
 }

+sub pg_version {
+    my $class = shift;
+    my $dbh = shift;
+    my $sth = $dbh->prepare("SELECT version()");
+    $sth->execute;
+    my($ver_str) = $sth->fetchrow_array;
+    $sth->finish;
+    my($ver) = $ver_str =~ m/^PostgreSQL ([\d\.]{3})/;
+    return $ver;
+}
+
+
+
 1;

 __END__


moseley@bumby:~/workshop$ diff -u `perldoc -l Class::DBI::Pg` Pg.pm
--- /usr/share/perl5/Class/DBI/Pg.pm    2003-09-10 00:59:40.000000000 -0700
+++ Pg.pm       2004-03-08 16:51:07.000000000 -0800
@@ -10,6 +10,7 @@

 sub set_up_table {
     my($class, $table) = @_;
+
     my $dbh = $class->db_Main;
     my $catalog = "";
     if ($class->pg_version >= 7.3) {
@@ -23,7 +24,7 @@
 WHERE relname = ?)
 SQL
     $sth->execute($table);
-    my $prinum = $sth->fetchrow_array;
+    my %prinum = map { $_ => 1 } map { split /\s+/ } $sth->fetchrow_array;
     $sth->finish;

     # find all columns
@@ -48,19 +49,19 @@
     $sth->execute($table);
     my($nextval_str) = $sth->fetchrow_array;
     $sth->finish;
-    my($sequence) = $nextval_str =~ m/^nextval\('"?([^"']+)"?'::text\)/;
+    my($sequence) = $nextval_str =~ m/^nextval\('"?([^"']+)"?'::text\)/
+        if $nextval_str;

-    my(@cols, $primary);
+    my(@cols, @primary);
     foreach my $col(@$columns) {
        # skip dropped column.
        next if $col->[0] =~ /^\.+pg\.dropped\.\d+\.+$/;
        push @cols, $col->[0];
-       next unless $prinum && $col->[1] eq $prinum;
-       $primary = $col->[0];
+        push @primary, $col->[0] if $prinum{ $col->[1] };
     }
-    _croak("$table has no primary key") unless $primary;
+    _croak("$table has no primary key") unless @primary;
     $class->table($table);
-    $class->columns(Primary => $primary);
+    $class->columns(Primary => @primary );
     $class->columns(All => @cols);
     $class->sequence($sequence) if $sequence;
 }


-- 
Bill Moseley
moseley@hank.org