Title

Building Complex Applications with Perl

A Practical Example

Under the previous lessons we discussed the usage of object orientation in Perl, and we

have developed a useful wrapper Class of DBI, which we called DATAHANDLER.pm.

This portion of the course is now going to be dedicated to abstracting that core and

inheriting it for usage to produce the bases of a calender.

In producing a Calender, we want to identify specific kinds of data and activities that we would need a calender to perform. In addition, we would want to produce a generalized Calender Class. This requires that be careful about not producing a module which does too much. Specifically, it is unlikely that we want to produce a Calender Class Module which does any presentation of a calender. Instead, we would want to leave such details for our higher level programming or others.

Let's look again at our DATAHANDLER.pm module.


=pod

=head1 DATAHANDLER.pm 

=head2 $Id: DATAHANDLER.pm,v 1.5 2001/02/09 02:47:16 brian Exp $

=head3 Copyright Ruben Safir 1997

=over 4

=item Overview

This class is used to hold data normally associated with DBI/SQL database retreival.  It is largly a wrapper for DBI/DBD.  The idea is to create an object which holds both the databse handle and the data retrieved.  Currently, it has fields for a fetching method, the SQL statement, a reference to records, and the name of the database to be retrieved from. It currently is statically pointed to localhost and using a default password for the database.  This might change over time. 

=item B<Creating a new database object>

The basic way to create a new DATAHANDLER object is to do the following:

$objref = DATAHANDLER-E<gt>allocate($database);

where $database name is a string that names the database you wish
to connect to.

=item B<Retrieving records>

To retrieve records, you use the following syntax:

$records_ref=$objref-E<gt>records('statement')

The fetch method is optional for retrieving records.  It defaults to storing any array reference of records in the records field of the object.  For example:

$obj=DATAHANDLER-E<gt>allocate($database);
$recsref=DATAHANDLER-E<gt>records("SELECT * from people");
for $tmp @$recref{
    @all_fields = @$tmp;

}
         
if you use both of these arguments, they must be in this order.

=item next_record

The method next_records has the same syntax as records, but next_records forces a call to the database, whereas records will only call to the database if there is no information in records aleady (i.e., if you have already made a call to records).  This behavior of next_records allows you to retrieve current information when it is possible the database has changed, you have changed your statement or fetch_method, or when you use a fetch_method that does not retrieve all of the information in one call.

All other methods in the object work in two ways.  One, assign a new value to the private fields and two, retrieving values from the private fields.  For example:

     $sqlref->database('people')

will change the database name to people.  However:

     $databasename = $sqlref->database();

will return the current database name.

This behavior is the same for the rest of the methods (i.e., fetch_method and statement). 

Sub classes may also overload the methods in DATAHANDLER, such as the method statement which is overloaded in SQLPARSE, because you should not simply assign a statement when using SQLPARSE.  You should allow SQLPARSE to parse it for you.

=item B<INSERTING RECORDS>

Inserting Records is not done through the records method. This is done by design because DATAHANDLER is mostly a CGI based tool and querrying information is far more common than inserting or updating data.  It does provide for inserting records with the insert_statement method.  But you have to fed it an entire SQL insert statement for it to work.

        For example:

my $statement = "INSERT INTO calander VALUES('$date', '$start', '$end', '$event', '$user')";
$obj->insert_statement($statement)      


=back

=cut

package DATAHANDLER; #BASE CLASS
use DBI;
@ISA = qw(DBI); #INHERITS FROM DBI



sub allocate{
        my($pkg) = shift;
        my($database) = shift;
        my $r_statement = bless {
                '_statement' => 0,
                '_records' => 0,
                '_database' => $database,
                '_dbh' => DATAHANDLER::getdbh($database), 
        }, $pkg;
        return $r_statement;
}


sub records{
        
       my ($objref) = undef;
       my ($firstarg) = undef;
 
       $objref = shift;
       $input_statement = shift;
      

       #Store the Statement - and keep ojbect in sync
       if ($input_statement) {
               $objref->statement($input_statement);
       }
       my($database) = $objref->database();
       my($statement) = $objref->statement();
       my($sth) = $objref->{_dbh}->prepare($statement); 
       my($rv) = $sth->execute or die "died line 115  - STATMENT $statement $! ";  
       $objref->{'_records'} = $sth->fetchall_arrayref; 
       my $row_ref;
       return $objref->{'_records'};
}

sub statement {
     #print "i'm in statement in DATAHANDLER.pm\n";
   
     my ($objref) = shift;
     my ($input_statement) = shift;
     if ($input_statement) {
             $objref->{'_statement'} = $input_statement;
     }
     return $objref->{'_statement'};

}
sub fetch_method {
     #print "i'm in fetch_method in DATAHANDLER.pm\n";
   
     my ($objref) = shift;
     my ($input_fetch_method) = shift;
     if ($input_fetch_method) {
                     
             $objref->{'_fetch_method'} = $input_fetch_method;
     }
     return $objref->{'_fetch_method'};

}
sub database {
    #print "i'm in database in DATAHANDLER.pm\n";
   
     my ($objref) = shift;
     my ($input_database) = shift;
     if ($input_database) {
             $objref->{'_database'} = $input_database;
     }
     return $objref->{'_database'};
}

sub insert_statement{
        my $objref = shift;
        my $statement = shift;
        my $sth = $objref->{_dbh}->prepare($statement) or die "$!";
#       my $rv = $sth->execute or die "$! killed $statement\n";
        my $rv = $sth->execute or print STDERR "$! $statement\n";
        $rv = $objref->next_records("fetchall_arrayref", "SELECT LAST_INSERT_ID()");
        return $rv;
}

sub update{
        my $objref = shift;
        my $statement = shift;
        my $sth = $objref->{_dbh}->prepare($statement);
        my $rv = $sth->execute;
        return $rv;
}

sub getdbh{
       my $objref = shift;
       my $database= undef;
       if( ref($objref) ){
               return $objref->{_dbh};
       }
       $database = $objref;
       if (!$database){
               die "$! $database\n";
       }

        my $dbh = DATAHANDLER->connect("DBI:mysql:$database:localhost", 'student','let.me.in') or die "$!"; 
      return $dbh;
}

return 1;

The module itself is extendable for our use, assuming that our calender is to live in a database.We can inherit DATABASEHANDLER.pm to construct our new Calender Core. In addition, wecan leverage several CPAN modules to help us with things like date string parsing, and date calculations.

Let's first look at the data we wish each of our objects to store on their birth.This is a short list of needed data each object needs to minimumly function.

· Database Name - Which database is this calender using

· User Name - Who's calender are we looking at

· User's Password - Authenticate the Calender's owner

· Today's Date

· Lookup Date -The Date which methods uses to lookup dates

· Start Time - The start time of an event stored in the object

· End Time - The end time of an event stored in the object

· Title - Title of an event

· Description - Description of an event stored in the object

This set of data in an object would give us a minimal calender entry in each object constructed. How can be now create a constructor to reflect our stated goals?

package CALENDERCORE;

use DATAHANDLER;

use Time::CTime;

use Time::ParseDate;

use strict;

use vars qw(@ISA);

@ISA = qw(DATAHANDLER);

sub new{

my($pkg) = shift;

my($database) = shift;

die "Come on - at least give me a database!" if(!$database);

my($user) = shift;

my($password) = shift;

my $calander = $pkg->allocate($database);

$calander->{'_user'} = $calander->user($user);

$calander ->{'_password'} = $calander->password($password);

$calander ->{'_today'} = $calander->today;

$calander->{'_lookupdate'} = $calander->lookupdate;

$calander->{'_starttime'} = $calander->starttime;

$calander->{'_endtime'} = $calander->endtime;

$calander->{'_title'} = $calander->title;

$calander->{'_description'} = $calander->description;

return $calander;

}

Our Module inherits DATABASEHANDLER. SInce we have already written and debugged DATABASEHANDLER, and it's API is proven and tight, we can now safely use it as a base class of our calender module. We use strict, and we use vars to allow for the @ISA array definition. We also use two CPAN modules to help us establish our core.

We can see that we have not blessed the returned hash reference directly, but instead,

we have allowed our Base Class, DATABASEAHANDLER, to do this for us with throught use of the 'allocate' constructor. After we retrieve the blessed object from allocate, we expand the the hash reference to our needs as a calender specific database object. This is an example of using inheritance and extending a base class.

Our next consideration, now that we have essentially defined our object, is to create the needed accessory methods for our API. Recall that accessory methods are designed to give us access or our data, and to control access. Below we have built some of the more simple ones. Others need to be more complex to deal with validaiton of dates.

sub user{

my $obj = shift;

my $id = shift;

if(!$id and !$obj->{_user}){

print STDERR "No User sent\n";

return("ERROR_nouser");

}

return $obj->{_user} if(!$id);

return $obj->{_user} = $id;

}

sub password{

my $obj = shift;

my $id = shift;

if(!$id and !$obj->{_password}){

print STDERR "No PASSWORD sent\n";

return("ERROR_nopass");

}

return $obj->{_password} if(!$id);

return $obj->{_password} = $id;

}

Our other accessory methods are more complex, and need to be thought out. The accessory method

$obj->today requires to be set to todays date. As such, we do not allow for the date to be set by the user, and instead set the date automatically. We use subroutines which are exported into our namespace by the Time modules we use. and we return back to our object a useful array which

sub today{

my $obj = shift;

my $day_of_week = strftime("%w", localtime(time));

my $month = strftime("%m", localtime(time));

my $day_of_month = strftime("%e", localtime(time));

my $fourYear = strftime("%Y", localtime(time));

my $thisday = [$day_of_week, $month, $day_of_month, $fourYear];

return $obj->{_today} = $thisday;

}

describes our date, for ease of use late by our API.

Here we use the strftime function of Time::CTime to get useful strings, and then to build an anonymous array reference for our objects. CTime leverages C's time functions. The anonymous array needs to be documented in the Classes perldoc file to prevent confusion.

Other accessory methods can be even more complex. As we have defined a date type within an anonymous array, we would likely like to keep this consistent among other functions. For example, our objects keeps tract of the day they are looking up, as well as today. We would define this accessory method as follows:

sub lookupdate{

my $obj = shift;

my $date = shift;

if(defined($date)){

$date =~ s/\s/0/g;

}

return $obj->{_lookupdate}

if (!$date and defined($obj->{_lookupdate}));

if(!$date){

my $tmpdate = $obj->today;

$tmpdate =~ s/\s/0/g;

$obj->{_lookupdate} = $tmpdate;

return $obj->{_lookupdate};

}

my $sec = parsedate("$date");

#print "$sec\n";

my $day_of_week = strftime("%w", localtime($sec));

my $month = strftime("%m", localtime($sec));

my $day_of_month = strftime("%e", localtime($sec));

my $fouryear = strftime("%Y", localtime($sec));

my $thisday = [$day_of_week, $month, $day_of_month, $fouryear];

print STDERR "Setting lookupdate to $$thisday[0] $$thisday[1] $$thisday[2] $$thisday[3]\n";

return $obj->{_lookupdate}=$thisday;

}

In this example, we are using the parsedate subroutine to create a similar anonymous array as we did with the today method. parsedate is part of the Time::ParseDate module. The function is again imported into our name space.

The methods starttime and endtime should have some data validation to prevent programmers from hurting themselves unintentionally. This sort of support by a base class to it's users gives objects the robustness which we are looking for when writing libraries which are likely to be used by a variety of programmers of different skill sets.

The dates given to these two objects should make sense. In addition, the database which is at the core of our calender should also have data constraints built in to protect data integrity.


sub starttime{
	my $obj = shift;
	my $time = shift;
	return
$obj->{_starttime} if !$time;
	die
if($time !~/(\d\d):(\d\d)/);
	die if($1
> 24 or $2 > 59);
	$time =
$time . ':00';
	return
$obj->{_starttime} = $time;
}	

sub endtime{
	my $obj = shift;
	my $time = shift;
	return
$obj->{_endtime} if !$time;
	die
if($time !~/(\d\d):(\d\d)/);
	die if($1
> 24 or $2 > 59);
	$time =
$time . ':00';
	return
$obj->{_endtime} = $time;
}	

sub title{
	 my $obj = shift;
	 my $event
= shift;
	 return
$obj->{_title} if !$event;
	 $event =~
s/\W\./ /g;
	 $event =~ s/^\.(\w)/$1/g;
	 $event =~ s/([{}\\"'])/\\$1/g;
	 $event =~
s/(^-)|(\s-)|\W(-)[A-Za-z]/ /g;
	 return
$obj->{_title} = $event;
}

In the title method, a little bit of security is built into the method, to hamper hacking of our programs. I leave it to the student to analyze the regexes in the method and determine the reasons for their inclusion.

The last accessory method to write is the one for the description, I leave this also for the sudent to write, although it is similar to the title in most regards.

Functional Methods

Bringing Life to our Class

The next stage in writing our calender base class is to give the calender it needed functionality. All calenders need to minimally display events for a certain time period, and to enter individual events into its schedule. Since our calender is stored in a database, these functions will use the power of DATAHANDELER and DBI to obtain their goals. As we build up, are simplifying levels of complexity behind our API.

Continuing on, we will create 2 functions to help get things in and out of our calender. We will ignore for the moment the hook for user specifics in our calender, and just focus on getting events into and out of our program.

sub addapointment{

print STDERR "HELLLOOOOOOOOOO\n";

my $obj = shift;

my $date_ref = $obj->lookupdate;

my $start = $obj->starttime;

my $end = $obj->endtime;

my $title = $obj->title;

my $event = $obj->description;

my $user = $obj->user;

my $date = join "-", $$date_ref[3], $$date_ref[1], $$date_ref[2];

$date =~ s/\s/0/g;

my $statement = "INSERT INTO calander VALUES(\'$date\', \'$start\', \'$end\', \'$title\', \'$event\', \'$user\')";

print STDERR "Date is $date\n$statement \n";

$obj->insert_statement($statement);

}

Here we see how we leverage our previous work to make more advanced programs. Notice how we do no use any of the hash elemets directly to achieve our goals. After setting our object, we need only call $obj->addapointment install an appointment into our calender!

We leave querying for a date entry to the student. But be aware that this might be left to higher level classes and programs to handle, especially if user level access is to be built in. However, moving from month to month, or week to week should be built into the core.

sub backmonth{

my $obj = shift;

my $date_ref = $obj->lookupdate;

my $month = $$date_ref[1];

my $day = $$date_ref[2];

$day =~ s/\D//g;

my $fouryear = $$date_ref[3];

my $date = join "-", $fouryear, $month, $day;

my $sec = parsedate($date);

my $past = parsedate( "-1 month", NOW => $sec);

my $month2 = strftime("%m", localtime($past));

my $day_of_month = strftime("%e", localtime($past));

my $fourYear = strftime("%Y", localtime($past));

my $thisday = join "-", $fourYear, $month2, $day_of_month;

$obj->lookupdate($thisday);

return $thisday;

}

sub frontmonth{

my $obj = shift;

my $date_ref = $obj->lookupdate;

my $month = $$date_ref[1];

my $day = $$date_ref[2];

# print STDERR "\nINSIDE FRONT - $day\n";

$day =~ s/\D//g;

my $fouryear = $$date_ref[3];

my $date = join "-", $fouryear, $month, $day;

# print STDERR "\nINSIDE FRONT - $date\n";

my $sec = parsedate($date);

my $future = parsedate( "+1 month", NOW => $sec);

my $month2 = strftime("%m", localtime($future));

my $day_of_month = strftime("%e", localtime($future));

my $fourYear = strftime("%Y", localtime($future));

my $thisday = join "-", $fourYear, $month2, $day_of_month;

print STDERR "\nINSIDE FRONT NEW DATE - $thisday\n";

$obj->lookupdate($thisday);

return $thisday;

}

1