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   112 use strict;
  13         46  
  13         465  
3 13     13   71 use warnings;
  13         46  
  13         3300  
4              
5             our $VERSION='0.65';
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         30 my %self = @_;
47 5         28 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             Please open on GitHub
92              
93             =head1 AUTHOR
94              
95             Michael R. Davis
96              
97             =head1 COPYRIGHT
98              
99             MIT License
100              
101             Copyright (c) 2023 Michael R. Davis
102              
103             =head1 SEE ALSO
104              
105             L
106              
107             =cut
108              
109             1;