4406l2.txt

Listing 2: People.pm, a Perl Object Module That 
Communicates with the 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;
}


# 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;  
}

# 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 ";
    $sql .= "|| ' ' || 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;
}

# 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, ";
    $sql .= "address1, address2, "; 
    $sql .= "email, city, state, postal_code, ";
    $sql .= "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;
}

# 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;
}

# 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;                    
}

# 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;
    }
}

# Create a new person
# Takes a hash of arguments
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, ";
    $sql .= "address2, email, ";
    $sql .= " city, state, postal_code, ";
    $sql .= "country, comments) ";
    $sql .= "VALUES (?, ?, ?, ?, ?, ?, ?, ?, ";
    $sql .= "?, ?) ";

    # 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;
    }
}

# 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;
    }
}

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