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__ |