[CDBI] Class::DBI Has Many Error
[prev] [thread] [next] [Date index for 2005/11/16]
From: Jay Hargreaves
Subject: [CDBI] Class::DBI Has Many Error
Date: 13:49 on 16 Nov 2005
Subject: [CDBI] Class::DBI Has Many Error
Date: 13:49 on 16 Nov 2005
This is a multi-part message in MIME format.
--------------070301020707050406080208
Content-Type: text/plain; charset=ISO-8859-1; format=flowed
Content-Transfer-Encoding: 7bit
Hi everyone!
So I have written a small database application using Class::DBI and I
have a table of Links and a table of LinkCategories. Each Link has a
LinkCategory and thus each LinkCategory has many Links. I have written
an admin interface so I can create new Links and LinkCategories as I
wish. All works as expected on my PC.
However, I have now uploaded the code to my laptop and it does not work
on there! My laptop is using the latest Class::DBI version available on
CPAN - my PC is using version 0.95!! If I replace the DBI.pm file on my
laptop with the one on my PC everything works fine!
So that's the background - here is the error message:
Can't use an undefined value as a HASH reference at
C:/Perl/site/lib/Class/DBI/Relationship/HasMany.pm line 51. Compilation
failed in require at c:\httpd\bowdonrufc\cgi-bin/BowdonRUFC/Admin.pm
line 104.
Anyone got an idea what could be going wrong? Please find my Link.pm,
LinkCategory.pm and Admin.pm attached if that is of any help!?
Thanks
Jay
--
bingo, bango, bosh...
--------------070301020707050406080208
Content-Type: text/plain;
name="Admin.pm"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
filename="Admin.pm"
#
# Admin.pm
# This file may not be reproduced without written permission
#
package BowdonRUFC::Admin;
use CGI::Builder
qw| CGI::Builder::Session
CGI::Builder::Auth
CGI::Builder::Magic
BowdonRUFC
|;
use strict;
use Data::Dumper;
use HTML::Entities;
sub OH_init
{ my $s = shift;
$s->require_group = [ 'ADMIN' ];
}
sub PH_index
{ my $s = shift;
$s->title = "Welcome To Bowdon R.U.F.C (Admin Interface)";
$s->content = <<_END_HTML_;
Please select from the following options:<br>
<ul>
<li><b>Pages</b>
[ <a href="/cgi-bin/admin.cgi?p=create&m=Page">Create</a> ]
[ <a href="/cgi-bin/admin.cgi?p=modify&m=Page">Modify</a> ]
[ <a href="/cgi-bin/admin.cgi?p=delete&m=Page">Delete</a> ]
</li>
<br>
<li><b>Links</b>
[ <a href="/cgi-bin/admin.cgi?p=create&m=Link">Create</a> ]
[ <a href="/cgi-bin/admin.cgi?p=modify&m=Link">Modify</a> ]
[ <a href="/cgi-bin/admin.cgi?p=delete&m=Link">Delete</a> ]
</li>
<li><b>Link Categories</b>
[ <a href="/cgi-bin/admin.cgi?p=create&m=LinkCategory">Create</a> ]
[ <a href="/cgi-bin/admin.cgi?p=modify&m=LinkCategory">Modify</a> ]
[ <a href="/cgi-bin/admin.cgi?p=delete&m=LinkCategory">Delete</a> ]
</li>
<br>
<li><b>Contacts</b>
[ <a href="/cgi-bin/admin.cgi?p=create&m=Contact">Create</a> ]
[ <a href="/cgi-bin/admin.cgi?p=modify&m=Contact">Modify</a> ]
[ <a href="/cgi-bin/admin.cgi?p=delete&m=Contact">Delete</a> ]
</li>
<br>
<li><b>News</b>
[ <a href="/cgi-bin/admin.cgi?p=create&m=News">Create</a> ]
[ <a href="/cgi-bin/admin.cgi?p=modify&m=News">Modify</a> ]
[ <a href="/cgi-bin/admin.cgi?p=delete&m=News">Delete</a> ]
</li>
<li><b>News Categories</b>
[ <a href="/cgi-bin/admin.cgi?p=create&m=NewsCategory">Create</a> ]
[ <a href="/cgi-bin/admin.cgi?p=modify&m=NewsCategory">Modify</a> ]
[ <a href="/cgi-bin/admin.cgi?p=delete&m=NewsCategory">Delete</a> ]
</li>
<br>
<li><b>Clubs</b>
[ <a href="/cgi-bin/admin.cgi?p=create&m=Club">Create</a> ]
[ <a href="/cgi-bin/admin.cgi?p=modify&m=Club">Modify</a> ]
[ <a href="/cgi-bin/admin.cgi?p=delete&m=Club">Delete</a> ]
</li>
<li><b>Teams</b>
[ <a href="/cgi-bin/admin.cgi?p=create&m=Team">Create</a> ]
[ <a href="/cgi-bin/admin.cgi?p=modify&m=Team">Modify</a> ]
[ <a href="/cgi-bin/admin.cgi?p=delete&m=Team">Delete</a> ]
</li>
<br>
<li><b>Competitions</b>
[ <a href="/cgi-bin/admin.cgi?p=create&m=Competition">Create</a> ]
[ <a href="/cgi-bin/admin.cgi?p=modify&m=Competition">Modify</a> ]
[ <a href="/cgi-bin/admin.cgi?p=delete&m=Competition">Delete</a> ]
</li>
<li><b>Fixtures</b>
[ <a href="/cgi-bin/admin.cgi?p=create&m=Fixture">Create</a> ]
[ <a href="/cgi-bin/admin.cgi?p=modify&m=Fixture">Modify</a> ]
[ <a href="/cgi-bin/admin.cgi?p=delete&m=Fixture">Delete</a> ]
</li>
</ul>
_END_HTML_
}
sub SH_create
{ my $s = shift;
return $s->switch_to('index') unless $s->cgi->param('m');
}
sub PH_create
{ my $s = shift;
my $m = $s->cgi->param('m');
$s->title = "Create A $m";
my $module = "BowdonRUFC::$m";
unless (eval { require File::Spec->catfile(split /::/, "$module.pm") })
{ $s->errstr = "The specified module ($module) does not exist.";
$s->debug .= $@;
return $s->switch_to('error');
}
my $columns = eval ( '$' . $module . '::columns' );
unless ($columns)
{ $s->errstr = "Unable to obtain column list for the specified module ($module).";
return $s->switch_to('error');
}
if (defined $s->cgi->param('do_create') and
&do_create($s, $m, $module))
{ my $url = $s->cgi->url . "?m=$m&" . $s->cgi_page_param . "=" . $s->cgi->param($s->cgi_page_param);
return $s->content = "Success! Your $m was successfully created.<p>Click <a href='$url'>here</a> to create another $m";
} else
{ return $s->content = &show_form($s, $m, $module);
}
}
sub PH_select
{ my $s = shift;
my ($m, $module) = @_;
my @options;
foreach my $mi (sort $module->retrieve_all)
{ my $id = $mi->id;
push @options, "<option value='$id'>$mi</option>";
}
unless (@options)
{ $s->errstr = "No $m available for selection";
return $s->switch_to('error');
}
my $start_form = $s->cgi->start_multipart_form();
my $end_form = $s->cgi->end_form();
my $page_param = $s->cgi->hidden($s->cgi_page_param);
my $m_param = $s->cgi->hidden('m');
my $primary_column = $module->primary_column;
$s->content .= <<_END_HTML_;
$start_form
$page_param
$m_param
<div id="form">
<div class="wrapper" style="padding: 10px;">
<h3>Select $m</h3>
<div style="padding-bottom: 30px;">
<div class="clearfix"><span class="field">$m:</span><select name="select_$primary_column" class="flat" style="float: left;">@options</select><span style="padding-left: 10px;"><b>(required)</b></span></div>
<div id="submit"><span class="field">Submit:</span><input type="submit" value="Select $m" class="button"></div>
</div>
</div>
</div>
_END_HTML_
}
sub SH_modify
{ my $s = shift;
return $s->switch_to('index') unless $s->cgi->param('m');
}
sub PH_modify
{ my $s = shift;
my $m = $s->cgi->param('m');
$s->title = "Modify An Existing $m";
my $module = "BowdonRUFC::$m";
unless (eval { require File::Spec->catfile(split /::/, "$module.pm") })
{ $s->errstr = "The specified module ($module) does not exist.";
$s->debug .= $@;
return $s->switch_to('error');
}
my $select_id = $s->cgi->param('select_' . $module->primary_column);
unless (defined $select_id)
{ return $s->switch_to('select', $m, $module);
}
my $obj = $module->retrieve($select_id);
unless (defined $obj)
{ $s->errstr = "The selected $m does not exist";
return $s->switch_to('error');
}
if (defined $s->cgi->param('do_modify') and
&do_modify($s, $m, $module, $obj))
{ my $url = $s->cgi->url . "?m=$m&" . $s->cgi_page_param . "=" . $s->cgi->param($s->cgi_page_param);
return $s->content = "Success! Your $m was successfully modified.<p>Click <a href='$url'>here</a> to modify another $m";
} else
{ return $s->content = &show_form($s, $m, $module, $obj);
}
}
sub PH_delete
{ my $s = shift;
my $m = $s->cgi->param('m');
$s->title = "Delete An Existing $m";
my $module = "BowdonRUFC::$m";
unless (eval { require File::Spec->catfile(split /::/, "$module.pm") })
{ $s->errstr = "The specified module ($module) does not exist.";
$s->debug .= $@;
return $s->switch_to('error');
}
my $select_id = $s->cgi->param('select_' . $module->primary_column);
unless (defined $select_id)
{ return $s->switch_to('select', $m, $module);
}
my $obj = $module->retrieve($select_id);
unless (defined $obj)
{ $s->errstr = "The selected $m does not exist";
return $s->switch_to('error');
}
if (defined $s->cgi->param('do_delete') and
&do_delete($s, $m, $module, $obj))
{ my $url = $s->cgi->url . "?m=$m&" . $s->cgi_page_param . "=" . $s->cgi->param($s->cgi_page_param);
return $s->content = "Success! Your $m was successfully deleted.<p>Click <a href='$url'>here</a> to delete another $m";
} else
{ return $s->content = &show_delete_form($s, $m, $module, $obj);
}
}
#
# utility functions
#
sub do_create
{ my $s = shift;
my ($m, $module) = @_;
my $columns = eval ( '$' . $module . '::columns' );
unless ($columns)
{ $s->errstr = "Unable to obtain column list for the specified module ($module).";
return $s->switch_to('error');
}
my ($require, $obj);
foreach my $c (@$columns) # check required values are provided and encode HTML where necessary
{ if ($c->{REQUIRED} and
$s->cgi->param($c->{NAME}) eq '')
{ push @$require, "Required field $c->{NAME} missing";
next;
}
$obj->{$c->{NAME}} = $c->{NOENCODE} ? $s->cgi->param($c->{NAME})
: &HTML::Entities::encode_entities($s->cgi->param($c->{NAME}));
}
if (defined $require)
{ $BowdonRUFC::errstr = &handle_error($s, $require);
return undef;
}
unless (eval { $module->create($obj) })
{ $BowdonRUFC::errstr = &handle_error($s, $@);
return undef;
}
return 1;
}
sub do_modify
{ my $s = shift;
my ($m, $module, $obj) = @_;
my $columns = eval ( '$' . $module . '::columns' );
unless ($columns)
{ $s->errstr = "Unable to obtain column list for the specified module ($module).";
return $s->switch_to('error');
}
my ($require, $new);
foreach my $c (@$columns) # check required values are provided and encode HTML where necessary
{ if ($c->{REQUIRED} and
$s->cgi->param($c->{NAME}) eq '')
{ push @$require, "Required field $c->{NAME} missing";
next;
}
$new->{$c->{NAME}} = $c->{NOENCODE} ? $s->cgi->param($c->{NAME})
: &HTML::Entities::encode_entities($s->cgi->param($c->{NAME}));
}
if (defined $require)
{ $BowdonRUFC::errstr = &handle_error($s, $require);
return undef;
}
my $command = '$obj->update';
if ($new->{$module->primary_column} ne $obj->id)
{ $command = '$module->move($obj, $new) and $obj->delete';
} else
{ foreach my $k (keys %$new)
{ unless (eval { $obj->$k($new->{$k}) })
{ $BowdonRUFC::errstr = &handle_error($s, $@);
return undef;
}
}
}
unless (eval($command))
{ $BowdonRUFC::errstr = &handle_error($s, $@);
return undef;
}
return 1;
}
sub do_delete
{ my $s = shift;
my ($m, $module, $obj) = @_;
my $columns = eval ( '$' . $module . '::columns' );
unless ($columns)
{ $s->errstr = "Unable to obtain column list for the specified module ($module).";
return $s->switch_to('error');
}
unless (eval { $obj->delete })
{ $BowdonRUFC::errstr = "An error occurred while deleting your $m";
return undef;
}
return 1;
}
sub show_form
{ my $s = shift;
my ($m, $module, $obj) = @_;
my $columns = eval ( '$' . $module . '::columns' );
unless ($columns)
{ $s->errstr = "Unable to obtain column list for the specified module ($module).";
return $s->switch_to('error');
}
my $start_form = $s->cgi->start_multipart_form();
my $end_form = $s->cgi->end_form();
my $page_param = $s->cgi->hidden($s->cgi_page_param);
my $m_param = $s->cgi->hidden('m');
my $action = $obj ? 'Modify' : 'Create';
my $do_param = $s->cgi->hidden('do_' . lc $action, 'true');
my $primary_column = $module->primary_column;
my $select_id_param = $s->cgi->hidden("select_$primary_column");
$s->content .= "<span class='error'>$BowdonRUFC::errstr</span><br><br>" if (defined $BowdonRUFC::errstr);
$s->content .= <<_END_HTML_;
$start_form
$page_param
$m_param
$do_param
$select_id_param
<div id="form">
<div class="wrapper" style="padding: 10px;">
<h3>$m Details</h3>
<div style="padding-bottom: 30px;">
_END_HTML_
my $param;
foreach my $c (@$columns)
{ my $name = $c->{NAME};
if (defined $s->cgi->param($name))
{ $param->{$name} = $s->cgi->param($name);
} elsif (defined $obj and $obj->can($name))
{ $param->{$name} = $obj->$name;
}
}
foreach my $c (@$columns)
{ next if ($c->{REQUIRE_GROUP} and
not $s->auth->require_group($c->{REQUIRE_GROUP})); # some fields are only available to priviliged users
my $name = $s->functions->format_column($c->{NAME});
my $value = $param->{$c->{NAME}};
my $required = '<b>(required)</b>' if $c->{REQUIRED};
if ($c->{TYPE} eq 'GENERATE') # generate id and pass as hidden field
{ $value = ($value or $s->functions->generate_id);
$s->content .= <<_END_HTML_;
<input type="hidden" name="$c->{NAME}" value="$value">
_END_HTML_
} elsif ($c->{TYPE} eq 'DATE') # create date field
{ $value = ($value or $s->functions->parse_date);
$s->content .= <<_END_HTML_;
<div class="clearfix"><span class="field">$name:</span><input type="TEXT" name="$c->{NAME}" value="$value" class="flat" style="float: left;"><span style="padding-left: 10px;">$required</span></div>
_END_HTML_
} elsif ($c->{TYPE} eq 'TEXT') # create simple plain text field
{ $s->content .= <<_END_HTML_;
<div class="clearfix"><span class="field">$name:</span><input type="TEXT" name="$c->{NAME}" value="$value" class="flat" style="float: left;"><span style="padding-left: 10px;">$required</span></div>
_END_HTML_
} elsif ($c->{TYPE} eq 'TEXTAREA') # create simple textarea field
{ $s->content .= <<_END_HTML_;
<div class="clearfix"><span class="field">$name:</span><textarea name="$c->{NAME}" class="flat" style="float: left">$value</textarea><span style="padding-left: 10px;">$required</span></div>
_END_HTML_
} elsif ($c->{TYPE} eq 'LIST') # load the required module and query values for dropdown list
{ unless (eval { require File::Spec->catfile(split /::/, "$c->{MODULE}.pm") })
{ $s->errstr = "The specified module ($c->{MODULE}) does not exist.";
$s->debug .= $@;
return $s->switch_to('error');
}
my $id = $obj ? $value->id : $value;
my $selected = { $id => "selected='selected'" };
my @options = ( "<option value=''>--- Select An Option ---</option>" );
foreach my $lc ($c->{MODULE}->retrieve_all)
{ my $id = $lc->id;
push @options, "<option value='$id' $selected->{$id}>$lc</option>";
}
$s->content .= <<_END_HTML_;
<div class="clearfix"><span class="field">$name:</span><select name="$c->{NAME}" class="flat" style="float: left;">@options</select><span style="padding-left: 10px;">$required</span></div>
_END_HTML_
}
}
$s->content .= <<_END_HTML_;
</div>
<h3>$action $m</h3>
<div>
<div id="submit"><span class="field">Submit:</span><input type="submit" value="$action $m" class="button"></div>
</div>
</div>
</div>
$end_form
_END_HTML_
}
sub show_delete_form
{ my $s = shift;
my ($m, $module, $obj) = @_;
my $columns = eval ( '$' . $module . '::columns' );
unless ($columns)
{ $s->errstr = "Unable to obtain column list for the specified module ($module).";
return $s->switch_to('error');
}
my $start_form = $s->cgi->start_multipart_form();
my $end_form = $s->cgi->end_form();
my $page_param = $s->cgi->hidden($s->cgi_page_param);
my $m_param = $s->cgi->hidden('m');
my $do_param = $s->cgi->hidden('do_delete', 'true');
my $primary_column = $module->primary_column;
my $select_id_param = $s->cgi->hidden("select_$primary_column");
$s->content .= "<span class='error'>$BowdonRUFC::errstr</span><br><br>" if (defined $BowdonRUFC::errstr);
$s->content .= <<_END_HTML_;
$start_form
$page_param
$m_param
$do_param
$select_id_param
<div id="form">
<div class="wrapper" style="padding: 10px;">
<h3>$m Details</h3>
<div style="padding-bottom: 30px;">
_END_HTML_
foreach my $c (@$columns)
{ next if ($c->{REQUIRE_GROUP} and
not $s->auth->require_group($c->{REQUIRE_GROUP})); # some fields are only available to priviliged users
my $name = $c->{NAME};
my $title = $s->functions->format_column($name);
my $value = $obj->$name;
$s->content .= <<_END_HTML_;
<div class="clearfix"><span class="field">$title:</span><span style="float: left; display: block;">$value</span></div>
_END_HTML_
}
$s->content .= <<_END_HTML_;
</div>
<h3>Delete $m</h3>
<div>
<div id="submit"><span class="field">Submit:</span><input type="submit" value="Delete $m" class="button"></div>
</div>
</div>
</div>
$end_form
_END_HTML_
}
#
# error handling
#
sub handle_error
{ my ($s, $e) = @_;
my $errstr = 'The following error(s) were encountered:';
if (ref $e eq 'HASH')
{ my $method = $e->{INFO}->{method};
if ($method eq 'validate_column_values')
{ my $err = $e->{INFO}->{data};
foreach my $k (keys %$err)
{ $errstr .= "<p>Invalid value provided for $k field</p>";
}
} elsif ($e->{INFO}->{err} =~ /duplicate/i)
{ $errstr .= "<p>Duplicate entry - please provide an alternative ID</p>";
}
} elsif (ref $e eq 'ARRAY')
{ $errstr .= join('<br>', @$e);
}
$s->debug .= '<pre>' . Dumper($e) . '</pre>';
return $errstr;
}
1;
--------------070301020707050406080208
Content-Type: text/plain;
name="Link.pm"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
filename="Link.pm"
#
# BowdonRUFC::Link.pm
#
package BowdonRUFC::Link;
use base BowdonRUFC::DBI;
$BowdonRUFC::Link::columns = [ { NAME => 'link_id',
REQUIRED => 1,
TYPE => 'GENERATE',
},
{ NAME => 'title',
REQUIRED => 1,
TYPE => 'TEXT',
},
{ NAME => 'description',
TYPE => 'TEXTAREA',
},
{ NAME => 'url',
REQUIRED => 1,
TYPE => 'TEXT',
},
{ NAME => 'link_category',
REQUIRED => 1,
TYPE => 'LIST',
MODULE => 'BowdonRUFC::LinkCategory',
} ];
__PACKAGE__->table("Links");
__PACKAGE__->columns(All => map { $_->{NAME} } @$BowdonRUFC::Link::columns);
__PACKAGE__->columns(Stringify => qw/title/);
__PACKAGE__->constrain_column(url => UntaintPatched => "url");
__PACKAGE__->has_a(link_category => 'BowdonRUFC::LinkCategory' );
1;
--------------070301020707050406080208
Content-Type: text/plain;
name="LinkCategory.pm"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
filename="LinkCategory.pm"
#
# BowdonRUFC::LinkCategory.pm
#
package BowdonRUFC::LinkCategory;
use base BowdonRUFC::DBI;
$BowdonRUFC::LinkCategory::columns = [ { NAME => 'link_category_id',
REQUIRED => 1,
TYPE => 'GENERATE',
},
{ NAME => 'title',
REQUIRED => 1,
TYPE => 'TEXT',
},
{ NAME => 'description',
TYPE => 'TEXTAREA',
} ];
__PACKAGE__->table("LinkCategories");
__PACKAGE__->columns(All => map { $_->{NAME} } @$BowdonRUFC::LinkCategory::columns);
__PACKAGE__->columns(Stringify => qw/title/);
__PACKAGE__->has_many(links => 'BowdonRUFC::Link');
1;
--------------070301020707050406080208
Content-Type: text/plain; charset="us-ascii"
MIME-Version: 1.0
Content-Transfer-Encoding: 7bit
Content-Disposition: inline
_______________________________________________
ClassDBI mailing list
ClassDBI@xxxxx.xxxxxxxxxxxxxxxx.xxx
http://lists.digitalcraftsmen.net/mailman/listinfo/classdbi
--------------070301020707050406080208--
 |
[CDBI] Class::DBI Has Many Error
|
|
 |
Re: [CDBI] Class::DBI Has Many Error
|
|
|
 |
Re: [CDBI] Class::DBI Has Many Error
|
|
|
|
Re: [CDBI] Class::DBI Has Many Error
|