I've been coding perl for a few years now(though only as my day job for the past few months), and about a week ago I decided to buckle down and finally learn object orientation, since that being my weak spot always hurt me when I use modules. I think understanding the theory behind how they work has helped me out a great deal.
In any case, I figured I'd put my first two classes up here for review. I've never met anyone else in person who knew how to code perl, so this is really my first time putting anything I've written that wasn't just fooling around up for review. I'm looking for constructive criticism, as long as it isn't along the lines of "stop programming perl and get a job bagging groceries." Here's the text of ExpenseReport.pm and Expense.pm:
package ExpenseReport;
sub new {
my $cargocult = shift;
my $class = ref($cargocult) || $cargocult;
my $id = shift;
my $self = {};
$self->{_ID} = $id | undef;
$self->{_FINALIZED} = 0;
$self->{_EXPENSES} = []; # Array of Expense objects
$self->{_TOTAL} = undef; # Total sum of all totals of Expense obje
+cts in _EXPENSES
$self->{_COUNT} = undef; # $#{$self->{_EXPENSES}} + 1
bless $self, $class;
}
sub get_total { #calculates total of all expenses in the report and re
+turns the result
my $self = shift;
my $total;
foreach my $exp (@{$self->{_EXPENSES}}) {
$total += $exp->amount;
}
$self->{_TOTAL} = $total;
return $total;
}
sub expenses { # returns array of expense objects in array context or
+a reference to the _EXPENSES array in scalar context
my $self = shift;
my @expenses = @{$self->{_EXPENSES}};
wantarray ? return @expenses : return $self->{_EXPENSES};
}
sub add_expense { # takes Expense object as argument and adds it to _E
+XPENSES array
my $self = shift;
my $newexp = shift;
my @expenses = @{$self->{_EXPENSES}};
$newexp->{_ID} = $#expenses + 1;
push(@expenses,$newexp);
$self->{_EXPENSES} = \@expenses;
}
sub delete_expense { # should be rewritten to use splice when I get a
+chance
my $self = shift;
my $id = shift;
delete ${$self->{_EXPENSES}}[$id];
$self->rehash;
}
sub save_file {
my $self = shift;
my $filename = shift;
my $temp = $Data::Dumper::Indent;
$Data::Dumper::Indent = 3;
open(OUT,">$filename");
print OUT Data::Dumper->Dump( [ $self ] , [ 'report' ] );
close(OUT);
$Data::Dumper::Indent = $temp;
}
sub load_file {
my $self = shift;
my $filename = shift;
my $report;
#print $filename,"\n";
{
local $/ = undef;
open(REPORT,"$filename") or &error("Couldn't load expense repo
+rt... $!");
my $file = <REPORT>;
close(REPORT);
eval($file) or print "couldnt eval -- $!";
return $report;
}
}
sub load_db {
my $self = shift;
my $id = shift;
my $dbh = DBI->connect('dbi:ODBC:expense',undef,undef, { AutoCommi
+t => 1, RaiseError => 1, LongReadLen => 500000, LongTruncOk => 1 } );
my $hashref = $dbh->selectrow_hashref("SELECT * FROM requests WHER
+E id = $id");
my $report;
eval($$hashref{object});
return $report;
}
sub rehash { # compact array, refresh total
my $self = shift;
STARTCHECK: for $i (0 .. $#{$self->{_EXPENSES}}) {
if (${$self->{_EXPENSES}}[$i] == undef) {
splice(@{$self->{_EXPENSES}},$i,1);
goto STARTCHECK;
}
}
for $i (0 .. $#{$self->{_EXPENSES}}) {
${$self->{_EXPENSES}}[$i]->id($i);
}
$self->get_total;
$self->{_COUNT} = $#{$self->{_EXPENSES}} + 1;
}
sub count {
$self = shift;
return $self->{_COUNT};
}
sub finalize {
my $self = shift;
my $id = shift;
my $dbh = DBI->connect('dbi:ODBC:expense', undef, undef, { AutoCom
+mit => 1, RaiseError => 1, LongReadLen => 5000000, LongTruncOk => 1,
+} );
$dbh->do("update requests set finalized = 1 where id = $id");
my $sql = "update requests set object = ? where id = $id";
my $sth = $dbh->prepare($sql);
$sth->bind_param(1, $sql, DBI::SQL_LONGVARCHAR);
$self->{_FINALIZED} = 1;
{
local $Data::Dumper::Indent = 0;
$sth->execute(Data::Dumper->Dump( [ $self ] , [ 'report' ] ));
}
$dbh->disconnect;
}
sub finalized {
my $self = shift;
my $hiddenkey = "_FINALIZED";
if (@_) { $self->{$hiddenkey} = shift; }
return $self->{$hiddenkey};
}
#---------------------------------
#---------------------------------
package Expense;
sub new {
my $cargocult = shift;
my $class = ref($cargocult) || $cargocult;
my $self = {};
$self->{_DESCRIPTION} = undef;
$self->{_PLACE} = undef;
$self->{_AMOUNT} = undef;
$self->{_ID} = undef;
$self->{_DETAILS} = undef;
bless $self, $class;
}
sub place {
my $self = shift;
my $hiddenkey = "_PLACE";
if (@_) { $self->{$hiddenkey} = shift; }
return $self->{$hiddenkey};
}
sub description {
my $self = shift;
my $hiddenkey = "_DESCRIPTION";
if (@_) { $self->{$hiddenkey} = shift; }
return $self->{$hiddenkey};
}
sub amount {
my $self = shift;
my $hiddenkey = "_AMOUNT";
if (@_) { $self->{$hiddenkey} = shift; }
return $self->{$hiddenkey};
}
sub id {
my $self = shift;
my $hiddenkey = "_ID";
if (@_) { $self->{$hiddenkey} = shift; }
return $self->{$hiddenkey};
}
sub details {
my $self = shift;
my $hiddenkey = "_DETAILS";
if (@_) { $self->{$hiddenkey} = shift; }
return $self->{$hiddenkey};
}
