view release on metacpan or  search on metacpan

t/5a.t  view on Meta::CPAN

#!perl -w

use strict;

use Test::More tests => 1;

# test an Object 3 levels deep (Patient->Visit->Test)

use Array::To::Moose qw (:ALL);

eval 'use VarianReportsMoose qw(print_obj)';

use Data::Dumper;

use Carp;

#------------
package Test;
use Moose;
use MooseX::StrictConstructor;
use namespace::autoclean;

has 'name'        => (is => 'rw', isa => 'Str');
has 'result'      => (is => 'rw', isa => 'Num');

#------------
package Visit;
use Moose;
use MooseX::StrictConstructor;
use namespace::autoclean;

has 'date'     => (is => 'rw', isa => 'Str'            );
has 'md'       => (is => 'rw', isa => 'Str'            );
has 'Tests'    => (is => 'rw', isa => 'ArrayRef[Test]' );

#------------
package Patient;
use Moose;
use MooseX::StrictConstructor;
use namespace::autoclean;

has 'last'        => (is => 'rw', isa => 'Str'            );
has 'first'       => (is => 'rw', isa => 'Str'            );
has 'Visits'      => (is => 'rw', isa => 'ArrayRef[Visit]' );

Test   ->meta->make_immutable;
Visit  ->meta->make_immutable;
Patient->meta->make_immutable;

package main;

#   patient  |    visit    |   test
# last  first|visit_date md|name result
# 0     1     2          3  4    5    <- column index

package main;

sub Npat { Patient->new(last => $_[0], first => $_[1], Visits => $_[2] ) }
sub Nvis {   Visit->new(date => $_[0], md    => $_[1], Tests => $_[2]  ) }
sub Ntst {    Test->new(name => $_[0], result => $_[1]                 ) }

# patients
my @p1 = ( "Smith", "John"  );
my @p2 = ( "Smith", "Alex"  );
my @p3 = ( "Green", "Helen" );

#visits
my @v1 = ( "03/10/2008", "F Jones, M.D." );
my @v2 = ( "08/17/2008", "F Jones, M.D." );

my @v3 = ( "11/28/2008", "L Ho, D.D.S"   );

my @v4 = ( "07/18/2010", "A. Black M.D." );
my @v5 = ( "12/12/2010", "A. Black M.D." );
my @v6 = ( "02/14/2011", "L Ho, D.D.S."  );

#tests
my @t1 = ( "test1", 1.1 );
my @t2 = ( "test2", 2.1 );
my @t3 = ( "test3", 3.1 );
my @t4 = ( "test4", 4.1 );
my @t5 = ( "test5", 5.1 );
my @t6 = ( "test6", 6.1 );
my @t7 = ( "test7", 7.1 );
my @t8 = ( "test8", 8.1 );
my @t9 = ( "test9", 9.1 );

my $data = [
              # p1
              [ @p1, @v1, @t1 ],
              [ @p1, @v1, @t2 ],
              [ @p1, @v1, @t3 ],

              [ @p1, @v2, @t4 ],
              [ @p1, @v2, @t5 ],

              # p2
              [ @p2, @v3, @t5 ],
              [ @p2, @v3, @t6 ],
              [ @p2, @v3, @t7 ],