Listing 4: Appointments.p
  
package Appointments;
use strict;
use DBI;
# Declare global variables
use vars qw($dbhost $dbuser $dbpassword $dsn @ISA);
my $dbhost = 'localhost';
my $dbuser = 'reuven';
my $dbpassword = '';
my $dsn = "DBI:Pg:dbname=atf;host=$dbhost;";
# We don't inherit from anyone
@ISA = ();
# Constructor: Takes a class as an argument, and
# connects to the database. Returns a new
# Appointments object, or undef if there was
# an error.
sub new
{
   # Get our class
   my $class = shift;
   # Create our instance
   my $self = {};
   # Connect to the database.  Set RaiseError, but
   # not PrintError, since objects should not
   # display errors when they occur.
   my $dbh = DBI->connect($dsn, $dbuser, $dbpassword,
                 {RaiseError => 1, AutoCommit => 1});
    # If we could not connect, return undef
    return undef unless (defined $dbh);
    # Store the database handle as an instance
    # variable
    $self->{dbh} = $dbh;
    # Turn $self into an object
  bless $self, $class;
    # Return the new instance
    return $self;
}
# add_appointment
sub add_appointment
{
    # Get myself
    my $self = shift;
    # Get the parameters
    my ($people, $start_time, $end_time, $notes) = @_;***
    # Get the database handle
    my $dbh = $self->{dbh};
    # Make sure that we have everything we need
    return undef unless ($people and $start_time and $end_time);***
    # Create the appropriate SQL
    my $sql = "INSERT INTO Appointments ";
    $sql .= " (person_id, start_time, end_time, notes) ";***
    $sql .= " VALUES (?, ?, ?, ?) ";
    # Execute the query
    my $rows_affected =
        $dbh->do($sql, undef, $people->get_current_person(),***
$start_time,
                 $end_time, $notes);
    if ($rows_affected)
    {
        return $self;
    }
    else
    {
        return undef;
    }
}
# get_today
sub get_today
{
  # Get myself
    my $self = shift;
    # Get the database handle
    my $dbh = $self->{dbh};
    # Create SQL for today's appointments
    my $sql = "SELECT P.first_name, P.last_name, A.start_time, ";***
    $sql .= "A.end_time, A.notes ";
    $sql .= "FROM People P, Appointments A ";
    $sql .= "WHERE P.person_id = A.person_id ";
    $sql .= "  AND A.start_time > CURRENT_DATE ";
    $sql .= "  AND A.end_time < (CURRENT_DATE + 1) ";***
    # Prepare and execute the query
    my $sth = $dbh->prepare($sql);
    $sth->execute();
    # Initialize an array of appointments
    my @appointments = ();
    # Retrieve the results, putting them into an array of hash references
  while (my $hashref = $sth->fetchrow_hashref())
    {
        my %appointment = %{$hashref};
        push @appointments, \%appointment;
    }
    # We're done with this statement
    $sth->finish;
    return @appointments;
}
# get_today_with_person
sub get_today_with_person
{
    # Get myself
    my $self = shift;
    # Get the People object
    my $people = shift;
    # Get the database handle               my $dbh =
    # $self->{dbh};
    # Create SQL for today's appointments
    my $sql = "SELECT P.first_name, P.last_name, A.start_time, ";***
    $sql .= "A.end_time, A.notes ";
    $sql .= "FROM People P, Appointments A ";
    $sql .= "WHERE P.person_id = ? ";
    $sql .= "  AND P.person_id = A.person_id ";
    $sql .= "  AND A.start_time > CURRENT_DATE ";
    $sql .= "  AND A.end_time < (CURRENT_DATE + 1) ";***
    # Prepare and execute the query
    my $sth = $dbh->prepare($sql);
    $sth->execute($people->get_current_person());
    # Initialize an array of appointments
    my @appointments = ();
    # Retrieve the results, putting them into an
    # array of hash references
    while (my $hashref = $sth->fetchrow_hashref())
    {
        my %appointment = %{$hashref};
        push @appointments, \%appointment;
    }
    # We're done with this statement
    $sth->finish;
    return @appointments;
}
# Destructor: Called automatically by Perl. We use
# this to close the database handle. This isn't
# really necessary if we are running
# under Apache::DBI.
sub DESTROY
{
    # Get myself
    my $self = shift;
    # Get the database handle
    my $dbh = $self->{dbh};
    # Close the database handle
    $dbh->disconnect;
    return;
}
# Always return a true value from a module
1;
  
  
  
  
  
  
  
  
  
    Copyright © 1994 - 2018 Linux Journal.  All rights reserved.