#!/usr/bin/perl -w

use strict;
use Data::Dumper;

use sam;
use tes;

# Create a sample
my $sample = new sam("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("first", $sample);
$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("second", $sample);
$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]

Package sam

package sam;

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

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

    return $this;
}

sub sample_id{
    return $_[0]->{'sample_id'}
}

sub add_test{
    my($this, $test) = @_;

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

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]

Package tes

package tes;

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

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

sub test_id{
    my($this) = @_;
    return $this->{'test_id'}
}

sub status{
    my($this, $status, $owner) = @_;

    if(! defined $status){
        return pop @{$this->{'status'}};
    }
    else{
        my $stat = new status($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]

Package status

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, $status, $owner) = @_;
    
    my $this = {    'status'=>$status,
            'time'=>time(),
            'owner'=>$owner};
    
    bless($this, $class);

    return $this;
}

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

sub status_code{
    my($this, $status) = @_;

    if (exists $order->{$this->{status}}) {
        return $order->{$this->{'status'}};
    }
    else{
        return undef;
    }
}    

sub time{
    my($this) = @_;
    return $this->{'time'};
}    

sub owner{
    my($this) = @_;
    return $this->{'owner'};
}    

1;
[download]