File Coverage

blib/lib/DBIx/Array/Session/Action.pm
Criterion Covered Total %
statement 9 21 42.8
branch 0 10 0.0
condition n/a
subroutine 3 6 50.0
pod 1 1 100.0
total 13 38 34.2


line stmt bran cond sub pod time code
1             package DBIx::Array::Session::Action;
2 13     13   105 use strict;
  13         30  
  13         406  
3 13     13   71 use warnings;
  13         23  
  13         3109  
4              
5             our $VERSION='0.64';
6              
7             =head1 NAME
8              
9             DBIx::Array::Session::Action - Ties DBIx::Array->{"action"} to the database
10              
11             =head1 SYNOPSIS
12              
13             use DBIx::Array;
14             my $dbx=DBIx::Array->new;
15             $dbx->connect($connection, $user, $pass, \%opt); #passed to DBI
16             $dbx->{"action"}="Main";
17             while ($this or $that) {
18             local $dbx->{"action"}="This or That Loop";
19             }
20              
21             =head1 DESCRIPTION
22              
23             This package ties the $dbx->{"action"} scalar to the database so that a local assignment to $dbx->{"action"} will set action twice. Once at the beginning and once at the end of the local variable scope.
24              
25             =head1 USAGE
26              
27             $dbx->action("Default");
28             { #any block
29             local $dbx->{"action"}="block action";
30             #action is now "block action".
31             }
32             #action is now "Default" again.
33              
34             foreach my $i (1 .. 5) {
35             local $dbx->{"action"}="Loop $i";
36             #action is now "Loop X".
37             }
38             #action is now "Default" again.
39              
40             =head2 TIESCALAR
41              
42             =cut
43              
44             sub TIESCALAR {
45 5     5   19 my $class = shift;
46 5         20 my %self = @_;
47 5         35 return bless \%self, $class;
48             }
49              
50             =head2 FETCH
51              
52             Gets action from database
53              
54             =cut
55              
56             sub FETCH {
57 0     0     my $self=shift;
58 0           return $self->parent->action;
59             }
60              
61             =head2 STORE
62              
63             Sets Action in database
64              
65             =cut
66              
67             sub STORE {
68 0     0     my $self=shift;
69 0           my $value=shift;
70 0 0         return unless defined $value; #Note local calls STORE first time with undef then with real value. no need to hit database twice
71 0 0         return unless defined $self->parent; #DESTROYED
72 0 0         return unless exists $self->parent->{"action"}; #untied
73 0 0         return unless defined $self->parent->dbh; #DESTROYED
74 0 0         return unless $self->parent->dbh->{"Active"}; #Disconnected
75 0           $self->parent->action($value); #void context for performance
76 0           return;
77             }
78              
79             =head1 PROPERTIES
80              
81             =head2 parent
82              
83             my $parent=$self->parent; #isa L
84              
85             =cut
86              
87 0     0 1   sub parent {shift->{"parent"}};
88              
89             =head1 BUGS
90              
91             Send email to author and log on RT.
92              
93             =head1 SUPPORT
94              
95             DavisNetworks.com supports all Perl applications big or small.
96              
97             =head1 AUTHOR
98              
99             Michael R. Davis
100             CPAN ID: MRDVT
101             STOP, LLC
102             domain=>stopllc,tld=>com,account=>mdavis
103             http://www.stopllc.com/
104              
105             =head1 COPYRIGHT
106              
107             This program is free software licensed under the...
108              
109             The BSD License
110              
111             The full text of the license can be found in the LICENSE file included with this module.
112              
113             =head1 SEE ALSO
114              
115             L
116              
117             =cut
118              
119             1;