File Coverage

blib/lib/Trinket/DataType/object.pm
Criterion Covered Total %
statement 20 45 44.4
branch 0 12 0.0
condition 0 15 0.0
subroutine 7 9 77.7
pod 0 2 0.0
total 27 83 32.5


line stmt bran cond sub pod time code
1             ###########################################################################
2             ### Trinket::DataType::object
3             ###
4             ### Object datatype handler
5             ###
6             ### $Id: Object.pm,v 1.3 2001/02/19 20:01:53 deus_x Exp $
7             ###
8             ### TODO:
9             ###
10             ###
11             ###########################################################################
12              
13             package Trinket::DataType::object;
14              
15             BEGIN {
16 3     3   9 our $VERSION = "0.0";
17 3         117 our @ISA = qw( Trinket::DataType );
18             }
19              
20 3     3   16 use strict;
  3         5  
  3         90  
21 3     3   14 use Trinket::Object;
  3         5  
  3         696  
22 3     3   16 use Trinket::DataType;
  3         6  
  3         168  
23 3     3   16 use Carp qw( confess cluck );
  3         3  
  3         193  
24              
25 3     3   14 use constant TYPE_OBJECT_REF => 0;
  3         6  
  3         188  
26 3     3   18 use constant TYPE_OBJECT_ID => 1;
  3         6  
  3         1884  
27              
28             sub set {
29 0     0 0   my ($pkg, $self, $name, $obj_val, $params) = @_;
30            
31             ### If this property isn't dirty already, save the clean value and
32             ### then flag it as dirty.
33 0 0         if (! $self->[OBJ_PROPS]->{$name}->[PROP_DIRTY]) {
34 0           $self->[OBJ_PROPS]->{$name}->[PROP_CLEAN_VALUE] =
35             $self->[OBJ_PROPS]->{$name}->[PROP_VALUE];
36 0           $self->[OBJ_PROPS]->{$name}->[PROP_DIRTY] = 1;
37             }
38              
39 0           my $dir = $self->get_directory();
40              
41 0 0         if (!ref($obj_val)) {
42 0 0         if (!defined $dir) {
43 0           confess("No directory for $self, trying to set $name to $obj_val");
44             }
45 0           $obj_val = $dir->retrieve($obj_val);
46             }
47            
48 0 0 0       if ( (defined $dir) && (defined $obj_val) && ($obj_val->get_directory() eq $dir) ) {
      0        
49 0           $self->[OBJ_PROPS]->{$name}->[PROP_VALUE]->[TYPE_OBJECT_ID] =
50             $obj_val->get_id();
51 0           $self->[OBJ_PROPS]->{$name}->[PROP_VALUE]->[TYPE_OBJECT_REF] =
52             undef;
53             } else {
54 0           $self->[OBJ_PROPS]->{$name}->[PROP_VALUE]->[TYPE_OBJECT_ID] =
55             undef;
56 0           $self->[OBJ_PROPS]->{$name}->[PROP_VALUE]->[TYPE_OBJECT_REF] =
57             $obj_val;
58             }
59            
60 0           return $obj_val;
61             }
62              
63             sub get {
64 0     0 0   my ($pkg, $self, $name, $params) = @_;
65            
66 0           my $dir = $self->get_directory();
67 0           my $id = $self->[OBJ_PROPS]->{$name}->[PROP_VALUE]->[TYPE_OBJECT_ID];
68            
69 0 0 0       if ((defined $id) && (defined $dir)) {
70 0           return $dir->retrieve($id);
71             } else {
72 0           my $obj_val =
73             $self->[OBJ_PROPS]->{$name}->[PROP_VALUE]->[TYPE_OBJECT_REF];
74              
75 0 0 0       if ( (defined $obj_val) && (defined $dir) && ($obj_val->get_directory() eq $dir) ) {
      0        
76 0           $self->[OBJ_PROPS]->{$name}->[PROP_VALUE]->[TYPE_OBJECT_ID] =
77             $obj_val->get_id();
78 0           $self->[OBJ_PROPS]->{$name}->[PROP_VALUE]->[TYPE_OBJECT_REF] =
79             undef;
80             }
81 0           return $obj_val;
82             }
83             }
84              
85             1;
86              
87             __END__