In Detail

Currency Support

Here is the first of a set of simple objects I will define for this project. This page will outline the storage and interaction with this stored data for the rest of the project.

Database Table(s)

This is one table: Currency. It contains the following columns:

• ID smallint PRIMAY KEY auto_increment
• Name varchar unique - such as "US Dollars"
• Rate float - such as 0.60
• PreviousRate float - as a backup
• Symbol varchar - such as ¥
• Code varchar - such as UKP

We want to require the following:

• Every currency appears only once, based upon a unique name
• Every currency has a non-zero rate, otherwise it is unavailble
• For every currency change, the pervious value is saved for rollback (but just one rollback).
• The Code is unique and available for automatic matching
• The Symbol is HTML encoded for display
• Only updates may be made by an administrator, or automation

The Object

 package Currency;
use CGI::Carp;

# Assume a $query variable is defined for this package, a DBI query
#my $query = 

sub new {
	my $proto = shift;
	my $class = ref($proto) || $proto;
	my $self = {};
	my %args = @_;

	bless ($self, $class);

	# Were we loading from the database?
	if (grep /^id$/, (keys %args)) {
		# Yes, we have an id, so load it or fail
		if ($self->load($args{'id'})) {
			return $self;
			}
		else {
			# Fail by returning nothing...
			return;
			}
		}

	# Were we given values?
	foreach (keys %args) {
		if ($_ =~ /^rate$/) { $self->rate($args{$_}); }
			elsif ($_ =~ /^name$/) { $self->name($args{$_}); }
			elsif ($_ =~ /^symbol$/) { $self->symbol($args{$_}); }
			elsif ($_ =~ /^code$/) { $self->code($args{$_}); }
		else {
			carp("Cannot load this key: $_");
			# Fail by returning nothing...
			return;
			}
		}
	return $self;
	}

sub load {
        my $self = shift;

        if (not @_) { 
                carp ("No id supplied"); 
                return;
                }
        my $id = shift;

	# Check the ID is a numerical value
        if ($id !~ /^\d+$/) {
                carp("Not an id ($id)");
                return;
                }

        my $sql = "SELECT * FROM Currency WHERE CurrencyID = ?";
        my $sth = $dbh->prepare($sql);
        my $res = $sth->execute($id);
        if ($res != 1) {
                carp("Cannot find currency id ($id)");
                return;
                }
        my $ref = $sth->fetchrow_hashref;

	# Copy the attributes to variables in this object
        $self->_id($$ref{'CurrencyID'});
        $self->name($$ref{'Name'});
        $self->rate($$ref{'ConvRate'});
        $self->code($$ref{'Code'});
        $self->symbol($$ref{'Symbol'});

	# Free the statement handle
	$sth->finish;
        }

sub save {
        my $self = shift;

	# This roceedure should only be usable by a nominated 
	# administrator user or an automated and authoised script.
	# This also applies for erase() below.

	# If this object has no ID set, then it is new and inserted 
	# for the first time, otherwise it already exists and is updated
        my $id = $self->id();
        if (not defined $id) {
                my $sql = "INSERT INTO Currency (Name, ConvRate, Code, Symbol) V
ALUES (?,?,?,?)";
                my $sth = $dbh->prepare($sql);
                my $res = $sth->execute($self->name(), $self->rate(), $self->code(), $self->symbol());

		# Free the statement handle
                $sth->finish;
                if ($res != 1) {
                        carp("cannot save");
                        return (0==1);
                        }
                }
	else {
                my $sql = "UPDATE Currency Set Name = ?, ConvRate = ?, Code = ? Symbol = ? WHERE CurrencyID = ?";
                my $sth = $dbh->prepare($sql);
                my $res = $sth->execute($self->name(), $self->rate(), $self->code(), $self->symbol(), $id);

		# Free the statement handler
                $sth->finish;
                if ($res != 1) {
                        carp("cannot update");
                        return (0==1);
                        }
                }
        return (1==1);
        }

sub erase {
	# This roceedure should only be usable by a nominated 
	# administrator user or an automated and authoised script.
	# This also applies for save() above.

        my $self = shift;

	# Double check that this object does exist by 
	# the ID existance check...
        my $id = $self->id();
        if (not defined $id) {
                carp("cannot erase. no id");
                return (0==1);
                }

        my $sql = "DELETE FROM Currency WHERE CurrencyID = ?";
        my $sth = $dbh->prepare($sql);
        my $res = $sth->execute($id);
        $sth->finish;
        if ($res != 1) {
                carp("cannot delete");
                return (0==1);
                }
        return (1==1);
        }

sub list {
        my $self = shift;
        my $sql = "SELECT * FROM Currency";
        my $sth = $dbh->prepare($sql);
        my $res = $sth->execute();


        if ($res <= 0) {
                $sth->finish;
                return;
                }

	# With the results, create a hash (keyed on ID) with all of the 
	# attributes, which can be passed back to the caller
        my %data;
        while (my $ref = $sth->fetchrow_hashref) {
                $data{$ref->{ID}}{Name} = $ref->{Name};
                $data{$ref->{ID}}{Rate} = $ref->{Rate};
                $data{$ref->{ID}}{Symbol} = $ref->{Symbol};
                $data{$ref->{ID}}{Code} = $ref->{Code};
                }
        $sth->finish;
        return %data;
        }

sub id {
        my $self = shift;
        if (@_) { carp( "Cannot set id"); }
        return ($self->{CurrencyID});
        }

	# Private proceedure for internal consumption only
sub _id {
	my $self = shift;
	if !(@_) {
		carp ("No id given");
		}
	$self->{CurrencyID} = shift;
	}

sub name {
        my $self = shift;
        if (@_) { $self->{CurrencyName} = shift; }
        return ($self->{CurrencyName});
        }

sub rate {
        my $self = shift;
        if (@_) { $self->{CurrencyRate} = shift; }
        return ($self->{CurrencyRate});
        }

sub symbol {
        my $self = shift;
        if (@_) { $self->{CurrencySymbol} = shift; }
        return ($self->{CurrencySymbol});
        }

sub code {
        my $self = shift;
        if (@_) { $self->{CurrencyCode} = shift; }
        return ($self->{CurrencyCode});
        }

Most of the routines here look similar. For example, the symbol subroutine, which does the following on each line:

1. Get the reference to the object for setting/getting other values
2. Check the other arguments to the subroutine, and take the next one as the value to set the variable to
3. Return the current value for this attribute

Thus the subroutine is a get-able/set-able attribute, and little else.

Note that the special attribute id is protected by the spliting of the get and set subroutines. The permis is that only after a value has been written to the database does it have an ID value, an hence a private function is used for this purpose.

Typical use of this object would be:

use Currency;
use CGI::Carp;

my $c = new Currency(id => 2);

if (not defined $c) {
	carp ("Cannot create currency");
	return;
	}

print "I have " . $c->name . " (" . $c->symbol . "also known as " . $c->code . ") at a rate of " . $c->rate . ".\n";

$c = undef;
$c = new Currency(name => "Monopoly Money", Rate=> 1.2, Code => MSFT, Symbol => MSFT$);

print "I have " . $c->name . " (" . $c->symbol . "also known as " . $c->code . ") at a rate of " . $c->rate . ".\n";

Also, an object of this type can return a complete list of all of the currencies available. This will be used by a widget we will defined later to get a list of currencies and present it to the user (ie, we're going to make a SELECT box with another proceedure, drawing on this information).