|
<![CDATA[
#!C:/perl/bin/perl -w
use WidgetView;
my $webapp = WidgetView->new();
$webapp->run();
=======================================================================================
package WidgetView;
use base 'CGI::Application';
use strict;
# Needed for our database connection
use CGI::Application::Plugin::DBH (qw/dbh_config dbh/);
sub setup {
my $self = shift;
$self->start_mode('mode1');
$self->run_modes(
'mode1' => 'showform',
'mode2' => 'showlist',
'mode3' => 'showdetail'
);
# Connect to DBI database, with the same args as DBI->connect();
$self->dbh_config("DBI:mysql:host=localhost;database=cookbook","cbuser","cbpass");
# $self->dbh_config($data_source, $username, $auth, \%attr);
# $self = "DBI:mysql:host=localhost;database=cookbook";
}
sub teardown {
my $self = shift;
# Disconnect when we're done, (Although DBI usually does this automatically)
$self->dbh->disconnect();
}
sub showform {
my $self = shift;
# Get CGI query object
my $q = $self->query();
my $output = '';
$output .= $q->start_html(-title => 'Widget Search Form');
$output .= $q->start_form();
$output .= $q->textfield(-name => 'widgetcode');
$output .= $q->hidden(-name => 'rm', -value => 'mode2');
$output .= $q->submit();
$output .= $q->end_form();
$output .= $q->end_html();
return $output;
}
sub showlist {
my $self = shift;
# Get our database connection
# my $dbh = $self->dbh();
# my $date = $self->dbh->selectrow_array("SELECT CURRENT_DATE");
# my $dbh = DBI->connect($self,"cbuser","cbpass") or die "Can't connect to server\n";
# Get CGI query object
my $q = $self->query();
my $widgetcode = $q->param("widgetcode");
my $output = '';
$output .= $q->start_html(-title => 'List of Matching Widgets');
## Do a bunch of stuff to select "widgets" from a DBI-connected
## database which match the user-supplied value of "widgetcode"
## which has been supplied from the previous HTML form via a
## CGI.pm query object.
##
## Each row will contain a link to a "Widget Detail" which
## provides an anchor tag, as follows:
##
## "widgetview.cgi?rm=mode3&widgetid=XXX"
##
## ...Where "XXX" is a unique value referencing the ID of
## the particular "widget" upon which the user has clicked.
my $date = $self->dbh->selectrow_array("SELECT CURRENT_DATE");
$output .= '<h2>';
$output .= $date;
$output .= '</h2>';
my $now = $self->dbh->selectrow_array("SELECT NOW()");
$output .= '<h2>';
$output .= $now;
$output .= '</h2>';
$output .= $q->end_html();
return $output;
}
sub showdetail {
my $self = shift;
# Get our database connection
my $dbh = $self->dbh();
# Get CGI query object
my $q = $self->query();
my $widgetid = $q->param("widgetid");
my $output = '';
$output .= $q->start_html(-title => 'Widget Detail');
## Do a bunch of things to select all the properties of
## the particular "widget" upon which the user has
## clicked. The key id value of this widget is provided
## via the "widgetid" property, accessed via the CGI.pm
## query object.
$output .= $q->end_html();
return $output;
}
1; # Perl requires this at the end of all modules
=======================================================================================
[Sat Aug 04 11:44:25 2007] [error] [client 127.0.0.1] Can't locate object method "dbh_config" via package "WidgetView" at WidgetView.pm line 18.\r
Internal Server Error
The server encountered an internal error or misconfiguration and was unable to complete your request.
[Sat Aug 04 11:39:51 2007] [error] [client 127.0.0.1] Can't locate WidgetView.pm in @INC (@INC contains: C:/Perl/lib C:/Perl/site/lib .) at C:/www/cgi-bin/view.pl line 2.\r
c:\database\perl>ppm install CGI-Application
====================
Install 'CGI-Application' version 4.06 in ActivePerl 5.8.4.810.
====================
Installing C:\Perl\html\site\lib\CGI\Application.html
Installing C:\Perl\html\site\lib\CGI\Application\Mailform.html
Installing C:\Perl\site\lib\CGI\Application.pm
Installing C:\Perl\site\lib\CGI\Application\Mailform.pm
Successfully installed CGI-Application version 4.06 in ActivePerl 5.8.4.810.
ppm> install CGI-Application-Plugin-DBH
====================
Install 'DBD-Mock' version 1.34 in ActivePerl 5.8.4.810.
====================
Downloaded 32650 bytes.
Extracting 10/10: blib/arch/auto/DBD/Mock/.exists
Installing C:\Perl\html\site\lib\DBD\Mock.html
Installing C:\Perl\site\lib\DBD\Mock.pm
Successfully installed DBD-Mock version 1.34 in ActivePerl 5.8.4.810.
====================
Install 'CGI-Application-Plugin-DBH' version 4.00 in ActivePerl 5.8.4.810.
====================
Downloaded 4778 bytes.
Extracting 5/5: blib/arch/auto/CGI/Application/Plugin/DBH/.exists
Installing C:\Perl\html\site\lib\CGI\Application\Plugin\DBH.html
Installing C:\Perl\site\lib\CGI\Application\Plugin\DBH.pm
Successfully installed CGI-Application-Plugin-DBH version 4.00 in ActivePerl 5.8
.4.810.
]]>
|