File Coverage

blib/lib/DWH_File/Tie/Scalar.pm
Criterion Covered Total %
statement 33 38 86.8
branch 2 4 50.0
condition 5 8 62.5
subroutine 11 12 91.6
pod 0 5 0.0
total 51 67 76.1


line stmt bran cond sub pod time code
1             package DWH_File::Tie::Scalar;
2              
3 9     9   51 use warnings;
  9         18  
  9         271  
4 9     9   46 use strict;
  9         15  
  9         286  
5 9     9   45 use vars qw( @ISA $VERSION );
  9         17  
  9         436  
6              
7 9     9   6879 use DWH_File::Slot;
  9         27  
  9         81  
8              
9             @ISA = qw( DWH_File::Tie DWH_File::Slot );
10             $VERSION = 0.01;
11              
12             sub TIESCALAR {
13 3     3   8 my $this = shift;
14 3         66 my $self = $this->perform_tie( @_ );
15             }
16              
17             sub STORE {
18 1     1   166 my ( $self, $value_in ) = @_;
19             $self->set_value( DWH_File::Value::Factory->from_input( $self->{ kernel },
20 1         6 $value_in ) );
21             # make lazy
22 1         4 $self->{ kernel }->save_custom_grounding( $self );
23             }
24              
25 5     5   20 sub FETCH { $_[ 0 ]->{ value }->actual_value }
26              
27             sub tie_reference {
28 3     3 0 6 my $text;
29 3   100     113 $_[ 2 ] ||= \$text;
30 3         9 my ( $this, $kernel, $ref, $blessing, $id, $tail ) = @_;
31 3   33     22 my $class = ref $this || $this;
32 3   66     16 $blessing ||= ref $ref;
33 3         19 my $instance = tie $$ref, $class, $kernel,
34             $ref, $id, $tail;
35 3 50       25 if ( $blessing ne 'SCALAR' ) { bless $ref, $blessing }
  0         0  
36 3         10 return $instance;
37             }
38              
39             sub wake_up_call {
40 2     2 0 5 my ( $self, $tail ) = @_;
41 2 50       9 unless ( defined $tail ) { die "Tail anomaly" }
  0         0  
42             $self->{ value } = DWH_File::Value::Factory->from_stored(
43             $self->{ kernel },
44 2         12 $tail );
45             }
46              
47             sub sign_in_first_time {
48 1     1 0 2 my ( $self ) = @_;
49             $self->set_value( DWH_File::Value::Factory->
50             from_input( $self->{ kernel },
51 1         2 ${ $self->{ content } } ) );
  1         5  
52             }
53              
54 2     2 0 9 sub custom_grounding { $_[ 0 ]->{ value } }
55              
56             sub vanish {
57 0     0 0   my ( $self ) = @_;
58 0           $self->release;
59 0           $self->{ kernel }->unground( $self );
60             }
61              
62             1;
63              
64             __END__