Hello I have got something working at the moment, but I have been racking my brain for a better way to do it. I was wondering if people could tell me if I have made this problem too complicated or whether this is a correct way to go about it.

(btw - my programming style is deliberately verbose. It's not the style but the method I need help with :-)

Basically I have a sample that can contain multiple tests. Each test does its own thing and every now and again its progress status is updated. A test's status can go up and down, but the sample's status is always the highest status that any of the tests has reached.

I need each test to be able to determine its own status and for the sample to determine the sample's own status and a procedural history of all the status changes. The method I have used uses of references to other objects. Is this the right way to do it?

Thanks for your help and suggestions.

below are 3 packages and one script that gives the output 


Sample History (organite)
first   new     1292414994      me
first   stage one       1292414994      me
second  new     1292414994      me
second  stage one       1292414994      me
second  stage four      1292414994      me
first   stage two       1292414994      me


test1 is currently at: stage two

sample is currently at: stage four

[download]


samtes.pl 
#!/usr/bin/perl -w

use strict;
use Data::Dumper;

use sam;
use tes;

# Create a sample
my $sample = new sam();
$sample->sample_id("organite");

# Create a new test, name it, add it to the sample and increase it's s
+tatus a couple of times
my $test1 = new tes();
$test1->test_id("first");
$sample->add_test($test1);
$test1->status("new", "me");
$test1->status("stage one", "me");

# Create ANOTHER new test, name it, add it to the sample and increase 
+it's status a couple of times
my $test2 = new tes();
$test2->test_id("second");
$sample->add_test($test2);
$test2->status("new", "me");
$test2->status("stage one", "me");

# change test2 status
$test2->status("stage four", "me");

# change test1 status, but not as high as test2
$test1->status("stage two", "me");

printf("\nSample History (%s)\n%s\n", $sample->sample_id(), $sample->s
+tatus_history());
printf("\ntest1 is currently at: %s\n",$test1->current_status());
printf("\ntest2 is currently at: %s\n",$test2->current_status());
printf("\nsample is currently at: %s\n\n",$sample->current_status());

[download]


sam.pm 

package sam;

use strict;
use Data::Dumper;
use status;

sub new{
    my($class) = @_;
    
    my $this = {
            'sample_id'=>undef,
            'test_list'=>[],
            'status'=>[],
        } ;
        
    bless($this, $class);

    return $this;
}
sub sample_id{
    if(defined $_[1]){$_[0]->{'sample_id'}=$_[1];}
    else{return $_[0]->{'sample_id'}}
}
sub add_test{
    my($this, $test) = @_;

    # Add test to sample
    push @{$this->{'test_list'}}, $test;

    $test->add_to_sample($this);
}
sub add_status{
    my($this, $test) = @_;
    my $h = {};
    $h->{'ref'} = ${$test->{'status'}}[(scalar(@{$test->{'status'}}) -
+ 1)];
    $h->{'src'} = $test;
    push @{$this->{'status'}}, $h;
}
sub status_history{
    my($this) = @_;
    
    my $history = "";
    foreach my $entry(@{$this->{'status'}}){
        $history .= sprintf("%s\t%s\t%s\t%s\n", $entry->{src}->test_id
+(), $entry->{'ref'}->status(), $entry->{'ref'}->time(), $entry->{'ref
+'}->owner());
    }
    
    return $history;
}
sub current_status{
    my($this) = @_;
    
    my $top;
    foreach my $entry(@{$this->{'status'}}){
        $top = $entry if(! defined $top || $entry->{'ref'}->status_cod
+e() > $top->{'ref'}->status_code());
    }
    
    return $top->{'ref'}->status;
}
1;

[download]


tes.pm 

package tes;

use strict;
use Data::Dumper;
use status;

sub new{
    my($class, $data) = @_;
    
    my $this = {
            'sample'=>undef,
            'test_id'=>undef,
            'status'=>[],
        } ;
        
    bless($this, $class);

    return $this;
}

sub add_to_sample{
    my($this, $sample) = @_;
    
    $this->{'sample'} = $sample;
}
sub test_id{
    my($this, $test_id) = @_;
    
    if(defined $test_id){
        $this->{'test_id'}=$test_id;
    }
    else{
        return $this->{'test_id'}
    }
}
sub status{
    my($this, $status, $owner) = @_;

    if(! defined $status){
        return pop @{$this->{'status'}};
    }
    else{
        my $stat = new status();
        $stat->initiate($status, $owner);
        push @{$this->{'status'}}, $stat;
        $this->{'sample'}->add_status($this);
    }
    
    return 1;
}
sub current_status{
    my($this) = @_;
    
    my $status = $this->status();
    return $status->status();
}

1;

[download]


status.pm 

package status;

use strict;
use Data::Dumper;

my $order = {"new"=>1,"stage one"=>2,"stage two"=>3,"stage four"=>4,"e
+nd"=>5};

sub new{
    my($class) = @_;
    
    my $this = {    'status'=>undef,
            'time'=>undef,
            'owner'=>undef};
    
    bless($this, $class);

    return $this;
}

sub initiate{
    my($this, $status, $owner) = @_;
    
    $this->status($status);
    $this->time(time());
    $this->owner($owner);
}
sub status{
    my($this, $status) = @_;
    
    if(defined $status){
        $this->{'status'} = $status;
    }
    else{
        return $this->{'status'};
    }
}
sub status_code{
    my($this, $status) = @_;
    
    if(defined $this->{'status'}){
        return $order->{$this->{'status'}};
    }
    else{
        return undef;
    }
}    
sub time{
    my($this, $time) = @_;
    
    if(defined $time){
        $this->{'time'} = $time;
    }
    else{
        return $this->{'time'};
    }
}    
sub owner{
    my($this, $owner) = @_;
    
    if(defined $owner){
        $this->{'owner'} = $owner;
    }
    else{
        return $this->{'owner'};
    }
}    

1;

[download]

In reply to Is there a better way to do this? by markdibley

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.