------------------------------------------------------------
Listing 5: Updated version of People.pm

package People;

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 People 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;

    # Set the current person
    $self->{current_person} = undef;

    # Turn $self into an object
      bless $self, $class;

    # Return the new instance
    return $self;
}

# ^L
# get_current_person: Returns a unique internal numeric ID for
# the current person.
sub get_current_person
{
    # Get myself
    my $self = shift;

    # Get my current person
    my $current_person = $self->{current_person};

    # Return the value
    return $current_person;
}

# ^L                    
# get_all_full_names: Returns a list of strings
# containing the first
# and last names of all people in the database
sub get_all_full_names
{
    # Get myself
    my $self = shift;

    # Get the database handle
    my $dbh = $self->{dbh};

    # Initialize the array
    my @full_names = ();

    # Set the SQL to retrieve all names
    my $sql = "SELECT first_name || ' ' || last_name ";
    $sql .= "FROM People ";
    $sql .= "ORDER BY first_name ";

    # Perform the query
    my $sth = $dbh->prepare($sql);
    $sth->execute();

    # Retrieve query results   
    while (my ($name) = $sth->fetchrow_array)
    {
        push @full_names, $name;
    }

    # Finish with this statement
    $sth->finish();

    # Return self
    return @full_names;
}

# ^L
# get_all_email_addresses: Returns a list of array references, in
# which the first element is the name and the second element is the
# e-mail address
sub get_names_and_addresses
{
    # Get myself
    my $self = shift;

    # Get the database handle 
    my $dbh = $self->{dbh};

    # Initialize the array
    my @names_and_addresses = ();

    # Set the SQL to retrieve all names
    my $sql = "SELECT first_name || ' ' || last_name, email ";
    $sql .= "FROM People ";
    $sql .= "ORDER BY last_name, first_name ";

    # Perform the query
    my $sth = $dbh->prepare($sql);
    $sth->execute();

    # Retrieve query results
    while (my ($name, $email_address) = $sth->fetchrow_array)
    {
        push @names_and_addresses, [$name, $email_address];
    }

    # Finish with this statement
    $sth->finish(); 

    # Return the e-mail addresses
    return @names_and_addresses;
}

# ^L
# get_current_info: Returns a hash reference with name-value pairs
# describing information about the current person.
sub get_current_info
{
    # Get myself
    my $self = shift;

    # Get the database handle
    my $dbh = $self->{dbh};

    # Get the current person
    my $current_person = $self->{current_person};

    # Create the empty hash reference
    my $user_info = {};

    # Make sure that we have a current person set!
    return undef unless $current_person;

    # Set the SQL to retrieve all information
    my $sql = "SELECT first_name, last_name, address1, address2, ";
    $sql .= "email, city, state, postal_code, country, comments ";
    $sql .= "FROM People ";
    $sql .= "WHERE person_id = ? ";

    # Perform the query
    my $sth = $dbh->prepare($sql);
    $sth->execute($current_person);

    # Retrieve query results, copying the returned hashref into
    # another hashref.
    while (my $person_hashref = $sth->fetchrow_hashref)
    {
        %{$user_info} = %{$person_hashref};
    }

    # Finish with this statement
    $sth->finish();
                 
    return $user_info;
}

# ^L
# Returns a list all of the e-mail addresses in the database.
sub get_email_addresses
{
    # Get myself
    my $self = shift;

    # Get the database handle
    my $dbh = $self->{dbh};

    # Get ready to store IDs
    my @email_addresses = ();

    # Set the SQL
    my $sql = "SELECT email People ";
    $sql .=   "ORDER BY email";

    # Perform the query
    my $sth = $dbh->prepare($sql);        
    $sth->execute();

    # Retrieve query results
    while (my ($address) = $sth->fetchrow_array)
    {
        push @email_addresses, $address;
    }

    # Finish with this statement
    $sth->finish();

    # Return self
    return @email_addresses;
}

# ^L
# Set the current person, based on the e-mail address
sub set_current_person_by_email
{
    # Get myself
    my $self = shift;

    # Get the e-mail address
    my $email_address = shift;

    # Get the database handle
    my $dbh = $self->{dbh};

    # Set the SQL
    my $sql = "SELECT person_id ";
    $sql .= "FROM People ";
    $sql .= "WHERE email = ? ";

    # Perform the query
    my $sth = $dbh->prepare($sql);
    $sth->execute($email_address);

    # Get the person_id
    my ($person_id) = $sth->fetchrow_array;

    # Finish with this statement
    $sth->finish();

    # Set the current person to the ID from the database
    $self->{current_person} = $person_id; 

    # Return the object
    return $self;
}

# ^L
# Set the current person, based on the first and last names
sub set_current_person_by_name
{
    # Get myself
    my $self = shift;

    # Get the names
    my $first_name = shift;
    my $last_name = shift;

    # Get the database handle
    my $dbh = $self->{dbh};

    # Set the SQL
    my $sql = "SELECT person_id ";
    $sql .= "FROM People ";
    $sql .= "WHERE first_name = ? ";
    $sql .= "  AND last_name = ? ";

    # Perform the query
    my $sth = $dbh->prepare($sql);
    $sth->execute($first_name, $last_name);

    # Get the person_id
    my ($person_id) = $sth->fetchrow_array;

    # Finish with this statement
    $sth->finish();

    # If we got a user ID, set it and return the object
    if ($person_id)
    {
        # Set the current person to the ID from the database
        $self->{current_person} = $person_id;

        # Return the object
        return $self;
    }
    else                       
    {
        return undef;
    }
}

# ^L
# Create a new person
# Takes a hash of arguments, and uses it to insert a new row into People
sub new_person
{
    # Get myself
    my $self = shift;

    # Use the rest of the arguments as a hash
    my %args = @_;

    # Get the database handle
    my $dbh = $self->{dbh};

    # Make sure we have at least the items we need
    return undef unless ($args{first_name} and $args{last_name} and
                         $args{email} and $args{country});
    
    # Start a transaction, so that we can be sure everything is done
    # together
    $dbh->{AutoCommit} = 0;

    # Does a person with this e-mail address (a UNIQUE key)
    # already exist:
    my $sql = "SELECT person_id ";
    $sql .=   "FROM People ";
    $sql .=   "WHERE email = ? ";

    # Look for such a primary key
    my $sth = $dbh->prepare($sql);
    $sth->execute($args{email});

    # Get a primary key, if one exists
    my ($person_id) = $sth->fetchrow_array;

    # If we got an ID, then the user exists: rollback, and return undef
    if ($person_id)
    {
        $dbh->rollback();
        $dbh->{AutoCommit} = 1;
                                          
        return undef;
    }

    # Create the SQL to insert a new row
    $sql = "INSERT INTO People ";
    $sql .= "(first_name, last_name, address1, address2, email, ";
    $sql .= " city, state, postal_code, country, comments) ";
    $sql .= "VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?) ";

    # Insert the row
    my $affected_rows =
        $dbh->do($sql, undef, $args{first_name}, $args{last_name},
                 $args{address1}, $args{address2}, $args{email},
                 $args{city}, $args{state}, $args{postal_code},
                 $args{country}, $args{comments});

    # If the INSERT was successful, set the current person
    # to be the newly inserted primary key
    if ($affected_rows)
    {
        # Get the inserted primary key
        my $sql = "SELECT currval(?)";

        # Prepare and execute the SELECT
        my $sth = $dbh->prepare($sql);
        $sth->execute('people_person_id_seq');

        # Retrieve the primary key
        my ($person_id) = $sth->fetchrow_array;

        # We're finished with this statement handle
        $sth->finish;

        # Get the latest
        $self->{current_person} = $person_id;

        # Commit the transaction
        $dbh->commit();
        $dbh->{AutoCommit} = 1;

        return $self;
    }

    # If the INSERT was unsuccessful, return undef
    else
    {
        # Commit the transaction
        $dbh->rollback();
        $dbh->{AutoCommit} = 1;

        return undef;
    }
}

# ^L
# Takes one argument (in addition to the object instance), a new first
# name.  The new name is updated in the database.  Returns the object
# upon success, and undef upon failure.
sub update_first_name
{
    # Get myself
    my $self = shift;

    # Get the new first name
    my $new_first_name = shift;

    # Get the database handle 
    my $dbh = $self->{dbh};

    # Set the SQL
    my $sql = "UPDATE People ";
    $sql .= "SET first_name = ? ";
    $sql .= "WHERE person_id = ? ";

    # Perform the UPDATE
    my $modified_rows =
        $dbh->do($sql, undef, $new_first_name, $self->{current_person});

    # We succeeded; return the object
    if ($modified_rows)
    {
        return $self;
    }

    # We failed; return undef
    else
    {
        return undef;
    }
}
   
# ^L
# 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;
1;