Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling

Re: Newbie question under time constraint

by 1nickt (Abbot)
on Aug 04, 2019 at 22:56 UTC ( #11103897=note: print w/replies, xml ) Need Help??

in reply to Newbie question under time constraint

Hi, welcome to Perl, the One True Religion.

Couple of etiquette notes: Asking for people to help you urgently because you are under a deadline usually has the opposite effect. Offering to pay for code here will usually get you sent to But, effort is encouraged and you've shown plenty, good job getting as far as you have.

Couple of general programming / asking for technical help notes:

  • When you don't know what is happening or why something isn't behaving as you expect, throw in a debug statement. It can be as simple as warn "foo $foo", or you can use a debugging module (the new Endoscope is very cool), or you can build for the future and set your app up from the start with logging built in by using a simple framework like Log::Any.

  • Add tests from the start as well. As you write your code, write a test suite that proves that when you feed the app some data, you'll get the expected result. Keep adding tests as you add features. Then when some new code breaks some old code, a test will tell you.

  • When you ask for help, it's most effective if you post sample data, expected output, and the error message encountered. Least effective are reports like "is not remotely working, the main program isn't even functional yet,". See many links in the documentation of the Monastery describing how best to ask a question. I had to guess what your data is like because you provided none.

Regarding your program my advice is to use one of the many object frameworks Perl already has. Not only because the features that a good framework has that you are replicating by hand, are stable, tested, efficient, but also because a good OOP framework will allow you to expand your app into new levels of complexity as it grows while hiding the majority of the dirty work. Personally I never write anything OOP without Moo.

Here's something like what you described. (Note only one file.)

$ cat
package Employee { use Moo; # loads strict and warnings and provides new() has name => (is => 'ro'); has [qw/wage hours/] => (is => 'rw'); }; package Employees { use Employee; use Moo; use namespace::clean; has _db => ( # code can be swapped later when there is a real DB is => 'rwp', default => sub { +{} }, ); sub add { my $self = shift; my $args = shift; # argument validation needed here $self->_db->{ $args->{name} } = $args; } sub find { my $self = shift; my $name = shift; # argument validation needed here my $record = $self->_db->{ $name } or die "$name not found"; return Employee->new( name => $name, wage => $record->{wage}, hours => $record->{hours}, ); } sub avg_hourly_wage { my $self = shift; my ($total_hours, $total_wages); for my $name (keys %{ $self->_db }) { $total_hours += $self->_db->{ $name }{hours}; $total_wages += $self->_db->{ $name }{wage} * $self->_db-> +{ $name }{hours}; } return sprintf('%d.2', $total_wages / $total_hours); } sub pay_change_for { my $self = shift; my $employee = shift; my $new_wage = shift; $employee->wage($new_wage); $self->_db->{ $employee->name }->{wage} = $new_wage; } }; #------------------------------------# use strict; use warnings; use feature 'say'; use Employee; use Employees; my $employees = Employees->new; for my $line (<DATA>) { chomp $line; my ($name, $wage, $hours) = split /,/, $line; $employees->add({ name => $name, wage => $wage, hours => $hours, }); } say 'Query for an employee: '; chomp( my $name = <STDIN> ); my $employee = $employees->find($name); say sprintf('%s earns %s for %s hours', map { $employee->$_ } qw/name +wage hours/); say 'The average hourly wage overall is ' . $employees->avg_hourly_wag +e; say "Give $name a raise? Enter new wage or 'No'"; chomp( my $answer = <STDIN> ); if ($answer =~ /^\d+$/) { $employees->pay_change_for($employee, $answer); } else { say 'No change'; } say 'The average hourly wage overall is now ' . $employees->avg_hourly +_wage; __DATA__ Fred Flinstone,10,40 Barney Rubble,8,40 Dino Flintstone,15,40 Bam-Bam Rubble,5,12 Mr. Slate,65,32


$ perl
Query for an employee: Barney Rubble Barney Rubble earns 8 for 40 hours The average hourly wage overall is 21.2 Give Barney Rubble a raise? Enter new wage or 'No' 20 The average hourly wage overall is now 24.2

Hope this helps!

Update: added some more methods for fun

The way forward always starts with a minimal test.

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://11103897]
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (3)
As of 2020-10-24 20:45 GMT
Find Nodes?
    Voting Booth?
    My favourite web site is:

    Results (247 votes). Check out past polls.