|  line  | 
 stmt  | 
 bran  | 
 cond  | 
 sub  | 
 pod  | 
 time  | 
 code  | 
| 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #!/usr/bin/perl -w  | 
| 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # Data::Toolkit::Connector::DBI  | 
| 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # Andrew Findlay  | 
| 
6
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # Dec 2006  | 
| 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # andrew.findlay@skills-1st.co.uk  | 
| 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
9
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # $Id: DBI.pm 388 2013-08-30 15:19:23Z remotesvn $  | 
| 
10
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
11
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 package Data::Toolkit::Connector::DBI;  | 
| 
12
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
13
 | 
1
 | 
 
 | 
 
 | 
  
1
  
 | 
 
 | 
717
 | 
 use strict;  | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
33
 | 
    | 
| 
14
 | 
1
 | 
 
 | 
 
 | 
  
1
  
 | 
 
 | 
5
 | 
 use Carp;  | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
30
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
65
 | 
    | 
| 
15
 | 
1
 | 
 
 | 
 
 | 
  
1
  
 | 
 
 | 
5
 | 
 use Clone qw(clone);  | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
36
 | 
    | 
| 
16
 | 
1
 | 
 
 | 
 
 | 
  
1
  
 | 
 
 | 
8902
 | 
 use DBI;  | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
20451
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
56
 | 
    | 
| 
17
 | 
1
 | 
 
 | 
 
 | 
  
1
  
 | 
 
 | 
648
 | 
 use Data::Toolkit::Entry;  | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
7
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
26
 | 
    | 
| 
18
 | 
1
 | 
 
 | 
 
 | 
  
1
  
 | 
 
 | 
6
 | 
 use Data::Toolkit::Connector;  | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
18
 | 
    | 
| 
19
 | 
1
 | 
 
 | 
 
 | 
  
1
  
 | 
 
 | 
4
 | 
 use Data::Dumper;  | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
74
 | 
    | 
| 
20
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
21
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 our @ISA = ("Data::Toolkit::Connector");  | 
| 
22
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
23
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head1 NAME  | 
| 
24
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
25
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Data::Toolkit::Connector::DBI  | 
| 
26
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
27
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head1 DESCRIPTION  | 
| 
28
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
29
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Connector for relational databases accessed through Perl's DBI methods  | 
| 
30
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
31
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head1 SYNOPSIS  | 
| 
32
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
33
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    $dbiConn = Data::Toolkit::Connector::DBI->new();  | 
| 
34
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
35
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    $dbi = DBI->connect( $data_source, $username, $auth, \%attr ) or die "$@";  | 
| 
36
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
37
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    $dbiConn->server( $dbi );  | 
| 
38
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
39
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    $spec = $dbiConn->filterspec( "SELECT joinkey,name FROM people WHERE joinkey = '%mykey%'" );  | 
| 
40
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    $msg = $dbiConn->search( $entry );  | 
| 
41
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    while ( $entry = $dbiConn->next() ) {  | 
| 
42
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	process $entry.....  | 
| 
43
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    }  | 
| 
44
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
45
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    $msg = $dbiConn->search( $entry );  | 
| 
46
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    $entry = $dbiConn->allrows();  | 
| 
47
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
48
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    $spec = $dbiConn->addspec( "INSERT INTO people (joinkey,name) VALUES (%mykey%,%myname%)" );  | 
| 
49
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    $dbiConn->add( $entry );  | 
| 
50
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
51
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    $spec = $dbiConn->updatespec( "UPDATE people set name = %myname% WHERE joinkey = %mykey%" );  | 
| 
52
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    $dbiConn->update( $entry );  | 
| 
53
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
54
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    $spec = $dbiConn->deletespec( "DELETE FROM people WHERE joinkey = %mykey%" );  | 
| 
55
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    $msg = $dbiConn->delete( $entry );  | 
| 
56
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
57
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Data::Toolkit::Connector::DBI does not do any commits or rollbacks. If you need  | 
| 
58
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 transactions, you should call the DBI commit and rollback methods directly.  | 
| 
59
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
60
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Note that all data is supplied via placeholders rather than being interpolated  | 
| 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 into the SQL strings. Thus for example, this addspec:  | 
| 
62
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
63
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    INSERT INTO people (joinkey,name) VALUES (%mykey%,%myname%)  | 
| 
64
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
65
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 is translated before passing to the database engine, becoming:  | 
| 
66
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
67
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    INSERT INTO people (joinkey,name) VALUES (?,?)  | 
| 
68
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
69
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 and the actual values of the 'mykey' and 'myname' attributes are passed as parameters.  | 
| 
70
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 This avoids all problems with quoting and SQL-injection attacks. It does make some  | 
| 
71
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 SELECT statements a bit harder to compose, particularly when you want to use LIKE  | 
| 
72
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 to do substring searches. The solution is to use CONCAT():  | 
| 
73
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
74
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    SELECT joinkey,sn FROM people WHERE sn LIKE CONCAT(%firstletter%, '%%')  | 
| 
75
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
76
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The value of the 'firstletter' attribute will become a parameter when the  | 
| 
77
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 select operation is executed.  | 
| 
78
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
79
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head1 Non-SQL databases  | 
| 
80
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
81
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Not using SQL? No problem: Data::Toolkit::Connector::DBI does not attempt to  | 
| 
82
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 understand the strings that you give it. All it does is attribute-name  | 
| 
83
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 substitution, so provided your database query language understands the '?'  | 
| 
84
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 placeholder convention it will all work.  | 
| 
85
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
86
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head1 DEPENDENCIES  | 
| 
87
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
88
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    Carp  | 
| 
89
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    Clone  | 
| 
90
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    DBI  | 
| 
91
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    DBD::CSV (for testing)  | 
| 
92
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
93
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =cut  | 
| 
94
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
95
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ########################################################################  | 
| 
96
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # Package globals  | 
| 
97
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ########################################################################  | 
| 
98
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
99
 | 
1
 | 
 
 | 
 
 | 
  
1
  
 | 
 
 | 
4
 | 
 use vars qw($VERSION);  | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2616
 | 
    | 
| 
100
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $VERSION = '1.0';  | 
| 
101
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
102
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # Set this non-zero for debug logging  | 
| 
103
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
104
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 my $debug = 0;  | 
| 
105
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
106
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ########################################################################  | 
| 
107
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # Constructors and destructors  | 
| 
108
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ########################################################################  | 
| 
109
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
110
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head1 Constructor  | 
| 
111
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
112
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head2 new  | 
| 
113
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
114
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    my $dbiConn = Data::Toolkit::Connector::DBI->new();  | 
| 
115
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
116
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Creates an object of type Data::Toolkit::Connector::DBI  | 
| 
117
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
118
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =cut  | 
| 
119
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
120
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub new {  | 
| 
121
 | 
1
 | 
 
 | 
 
 | 
  
1
  
 | 
  
1
  
 | 
3
 | 
 	my $class = shift;  | 
| 
122
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
123
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
16
 | 
 	my $self = $class->SUPER::new(@_);  | 
| 
124
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4
 | 
 	bless ($self, $class);  | 
| 
125
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
126
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
5
 | 
 	carp "Data::Toolkit::Connector::DBI->new $self" if $debug;  | 
| 
127
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
 	return $self;  | 
| 
128
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
129
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
130
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub DESTROY {  | 
| 
131
 | 
1
 | 
 
 | 
 
 | 
  
1
  
 | 
 
 | 
3
 | 
 	my $self = shift;  | 
| 
132
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
32
 | 
 	carp "Data::Toolkit::Connector::DBI Destroying $self" if $debug;  | 
| 
133
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
134
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
135
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ########################################################################  | 
| 
136
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # Methods  | 
| 
137
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ########################################################################  | 
| 
138
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
139
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head1 Methods  | 
| 
140
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
141
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =cut  | 
| 
142
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
143
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ########################################  | 
| 
144
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
145
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head2 server  | 
| 
146
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
147
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Define the database server for the connector to use.  | 
| 
148
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 This should be an object of type DBI  | 
| 
149
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
150
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    my $res = $dbiConn->server( DBI->connect($data_source, $username, $auth) );  | 
| 
151
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
152
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Returns the object that it is passed.  | 
| 
153
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
154
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =cut  | 
| 
155
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
156
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub server {  | 
| 
157
 | 
1
 | 
 
 | 
 
 | 
  
1
  
 | 
  
1
  
 | 
76446
 | 
 	my $self = shift;  | 
| 
158
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4
 | 
 	my $server = shift;  | 
| 
159
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
160
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
9
 | 
 	croak "Data::Toolkit::Connector::DBI->server expects a parameter" if !$server;  | 
| 
161
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
6
 | 
 	carp "Data::Toolkit::Connector::DBI->server $self" if $debug;  | 
| 
162
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
163
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
11
 | 
 	return $self->{server} = $server;  | 
| 
164
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
165
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
166
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
167
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
168
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ########################################  | 
| 
169
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
170
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head2 filterspec  | 
| 
171
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
172
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Supply or fetch filterspec  | 
| 
173
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
174
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    $hashref = $ldapConn->filterspec();  | 
| 
175
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    $hashref = $ldapConn->filterspec( "SELECT key,name FROM people WHERE key = '%mykey'" );  | 
| 
176
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
177
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Parameters are indicated thus: %name% - this will result in a '?'-style placeholder in  | 
| 
178
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 the SQL statement and the named attribute will be extracted from the supplied entry  | 
| 
179
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 by the search() method.  | 
| 
180
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
181
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =cut  | 
| 
182
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
183
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub filterspec {  | 
| 
184
 | 
7
 | 
 
 | 
 
 | 
  
7
  
 | 
  
1
  
 | 
594
 | 
 	my $self = shift;  | 
| 
185
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
16
 | 
 	my $filterspec = shift;  | 
| 
186
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
187
 | 
7
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
23
 | 
 	carp "Data::Toolkit::Connector::DBI->filterspec $self $filterspec " if $debug;  | 
| 
188
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
189
 | 
7
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
26
 | 
 	croak "Data::Toolkit::Connector::DBI->filterspec called before server connection opened" if !$self->{server};  | 
| 
190
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
191
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# No arg supplied - just return existing setting  | 
| 
192
 | 
7
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
20
 | 
 	return $self->{filterspec} if (!$filterspec);  | 
| 
193
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
194
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# We have a new filterspec so stash it for future reference  | 
| 
195
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
18
 | 
 	$self->{filterspec} = $filterspec;  | 
| 
196
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
197
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# We need to parse the spec to find the list of args that it calls for.  | 
| 
198
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Start by clearing the arglist and filter string  | 
| 
199
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
14
 | 
 	my $filter = '';  | 
| 
200
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
11
 | 
 	my @arglist;  | 
| 
201
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
18
 | 
 	$self->{search_arglist} = \@arglist;  | 
| 
202
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
203
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Parameter names are between pairs of % characters  | 
| 
204
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Where we want a literal '%' it is represented by '%%'  | 
| 
205
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# so if the search string has at least two '%' left then there is work to be done  | 
| 
206
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
40
 | 
 	while ($filterspec =~ /%.*%/) {  | 
| 
207
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
24
 | 
 		my ($left,$name,$right) = ($filterspec =~ /^([^%]*)%([a-zA-Z0-9_]*)%(.*)$/);  | 
| 
208
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		# Everything before the first % gets added to the filter  | 
| 
209
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
10
 | 
 		$filter .= $left;  | 
| 
210
 | 
4
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
10
 | 
 		if ($name) {  | 
| 
211
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 			# Add the name to the list of attributes needed when the search is performed  | 
| 
212
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
6
 | 
 			push @arglist, $name;  | 
| 
213
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 			# Put the placeholder in the actual filter  | 
| 
214
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4
 | 
 			$filter .= '?';  | 
| 
215
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		}  | 
| 
216
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		else {  | 
| 
217
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 			# We got '%%' so add a literal '%' to the filter  | 
| 
218
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4
 | 
 			$filter .= '%';  | 
| 
219
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		}  | 
| 
220
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		# The remainder of the filterspec goes round again  | 
| 
221
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
15
 | 
 		$filterspec = $right;  | 
| 
222
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
223
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Anything left in the filterspec gets appended to the filter  | 
| 
224
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
17
 | 
 	$filter .= $filterspec;  | 
| 
225
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
226
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Stash the resulting string and associated list of attributes  | 
| 
227
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
13
 | 
 	$self->{selectstatement} = $filter;  | 
| 
228
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
229
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Prepare the statement and stash the statement handle  | 
| 
230
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
77
 | 
 	$self->{search_sth} = $self->{server}->prepare( $filter );  | 
| 
231
 | 
7
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
1263
 | 
 	croak "Failed to prepare filter '$filter'" if !$self->{search_sth};  | 
| 
232
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
233
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Return the spec string that we were given  | 
| 
234
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
28
 | 
 	return $self->{filterspec};  | 
| 
235
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
236
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
237
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ########################################  | 
| 
238
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
239
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head2 search  | 
| 
240
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
241
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Search the database.  | 
| 
242
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 If an entry is supplied, attributes from it may be used in the search.  | 
| 
243
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
244
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    $msg = $dbiConn->search();  | 
| 
245
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    $msg = $dbiConn->search( $entry );  | 
| 
246
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
247
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Returns the result of the DBI execute() operation.  | 
| 
248
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 This will be false if an error occurred.  | 
| 
249
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
250
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =cut  | 
| 
251
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
252
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub search {  | 
| 
253
 | 
9
 | 
 
 | 
 
 | 
  
9
  
 | 
  
1
  
 | 
23
 | 
 	my $self = shift;  | 
| 
254
 | 
9
 | 
 
 | 
 
 | 
 
 | 
 
 | 
13
 | 
 	my $entry = shift;  | 
| 
255
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
256
 | 
9
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
32
 | 
 	croak "Data::Toolkit::Connector::DBI->search called before searchspec has been defined" if !$self->{search_sth};  | 
| 
257
 | 
9
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
27
 | 
 	carp "Data::Toolkit::Connector::DBI->search $self" if $debug;  | 
| 
258
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
259
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Sanity check  | 
| 
260
 | 
9
 | 
  
 50
  
 | 
  
 66
  
 | 
 
 | 
 
 | 
57
 | 
 	if ($entry and not $entry->isa('Data::Toolkit::Entry')) {  | 
| 
261
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 		croak "Data::Toolkit::Connector::DBI->search parameter must be an entry";  | 
| 
262
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
263
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
264
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Invalidate the current result entry  | 
| 
265
 | 
9
 | 
 
 | 
 
 | 
 
 | 
 
 | 
17
 | 
 	$self->{current} = undef;  | 
| 
266
 | 
9
 | 
 
 | 
 
 | 
 
 | 
 
 | 
18
 | 
 	$self->{currentDBRow} = undef;  | 
| 
267
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
268
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# The args to be passed to the SQL SELECT statement  | 
| 
269
 | 
9
 | 
 
 | 
 
 | 
 
 | 
 
 | 
12
 | 
 	my @args;  | 
| 
270
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# The array of names that came from the filterspec  | 
| 
271
 | 
9
 | 
 
 | 
 
 | 
 
 | 
 
 | 
16
 | 
 	my @arglist = @{$self->{search_arglist}};  | 
| 
 
 | 
9
 | 
 
 | 
 
 | 
 
 | 
 
 | 
26
 | 
    | 
| 
272
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Check that we have an entry to get params from  | 
| 
273
 | 
9
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
33
 | 
 	print "ARGLIST for search: ", (join '/', @arglist), "\n" if $debug;  | 
| 
274
 | 
9
 | 
  
 50
  
 | 
  
 66
  
 | 
 
 | 
 
 | 
38
 | 
 	if ($arglist[0] and !$entry) {  | 
| 
275
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 		croak "Data::Toolkit::Connector::DBI->search requires an entry when the searchspec includes parameters";  | 
| 
276
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
277
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
278
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Extract the args from the entry  | 
| 
279
 | 
9
 | 
 
 | 
 
 | 
 
 | 
 
 | 
12
 | 
 	my $arg;  | 
| 
280
 | 
9
 | 
 
 | 
 
 | 
 
 | 
 
 | 
20
 | 
 	foreach $arg (@arglist) {  | 
| 
281
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
11
 | 
 		my $value = $entry->get($arg);  | 
| 
282
 | 
3
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
16
 | 
 		croak "search spec calls for a '$arg' attribute but the entry does not have one" if !$value;  | 
| 
283
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		# We only use the first value from the list.  | 
| 
284
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		# This is permitted to bu undef or the null string.  | 
| 
285
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
7
 | 
 		$value = $value->[0];  | 
| 
286
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
11
 | 
 		push @args, $value;  | 
| 
287
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
288
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
289
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Start the search and return the statement handle having stashed a copy internally  | 
| 
290
 | 
9
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1009
 | 
 	return $self->{searchresult} = $self->{search_sth}->execute( @args );  | 
| 
291
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
292
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
293
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
294
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
295
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ########################################  | 
| 
296
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
297
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head2 next  | 
| 
298
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
299
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Return the next entry from the SQL search as a Data::Toolkit::Entry object.  | 
| 
300
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Optionally apply a map to the data.  | 
| 
301
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
302
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Updates the "current" entry (see "current" method description below).  | 
| 
303
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
304
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    my $entry = $dbConn->next();  | 
| 
305
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    my $entry = $dbConn->next( $map );  | 
| 
306
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
307
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The result is a Data::Toolkit::Entry object if there is data left to be read,  | 
| 
308
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 otherwise it is undef.  | 
| 
309
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
310
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =cut  | 
| 
311
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
312
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub next {  | 
| 
313
 | 
8
 | 
 
 | 
 
 | 
  
8
  
 | 
  
1
  
 | 
27
 | 
 	my $self = shift;  | 
| 
314
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
13
 | 
 	my $map = shift;  | 
| 
315
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
316
 | 
8
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
32
 | 
 	carp "Data::Toolkit::Connector::DBI->next $self" if $debug;  | 
| 
317
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
318
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Invalidate the old 'current entry' in case we have to return early  | 
| 
319
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
20
 | 
 	$self->{current} = undef;  | 
| 
320
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
321
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Sanity check  | 
| 
322
 | 
8
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
24
 | 
 	croak "Data::Toolkit::Connector::DBI->next called but no search has been started" if !$self->{search_sth};  | 
| 
323
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
324
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Pull out the next row from the database  | 
| 
325
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
309
 | 
 	my $dbRow = $self->{search_sth}->fetchrow_hashref("NAME_lc");  | 
| 
326
 | 
8
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
42
 | 
 	return undef if !$dbRow;  | 
| 
327
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
328
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Build an entry  | 
| 
329
 | 
6
 | 
 
 | 
 
 | 
 
 | 
 
 | 
45
 | 
 	my $entry = Data::Toolkit::Entry->new();  | 
| 
330
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
331
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Now step through the list of columns and assign data to attributes in the entry  | 
| 
332
 | 
6
 | 
 
 | 
 
 | 
 
 | 
 
 | 
8
 | 
 	my $attrib;  | 
| 
333
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
334
 | 
6
 | 
 
 | 
 
 | 
 
 | 
 
 | 
23
 | 
 	foreach $attrib (keys %$dbRow) {  | 
| 
335
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
144
 | 
 		$entry->set( $attrib, [ $dbRow->{$attrib} ] );  | 
| 
336
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
337
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
338
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Save this as the current entry  | 
| 
339
 | 
6
 | 
 
 | 
 
 | 
 
 | 
 
 | 
71
 | 
 	$self->{current} = $entry;  | 
| 
340
 | 
6
 | 
 
 | 
 
 | 
 
 | 
 
 | 
11
 | 
 	$self->{currentRow} = $dbRow;  | 
| 
341
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
342
 | 
6
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
21
 | 
 	carp "Data::Toolkit::Connector::DBI->next using row: ".(join ',', (keys %$dbRow)) if $debug;  | 
| 
343
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Do we have a map to apply?  | 
| 
344
 | 
6
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
14
 | 
 	if ($map) {  | 
| 
345
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 		return $entry->map($map);  | 
| 
346
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
347
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
348
 | 
6
 | 
 
 | 
 
 | 
 
 | 
 
 | 
18
 | 
 	return $entry;  | 
| 
349
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
350
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
351
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ########################################  | 
| 
352
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
353
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head2 allrows  | 
| 
354
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
355
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Merges the data from all rows returned by the SQL search into a single  | 
| 
356
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Data::Toolkit::Entry object, so that each attribute has multiple values.  | 
| 
357
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Optionally apply a map to the data.  | 
| 
358
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
359
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 After this method if called, the "current" entry will be empty  | 
| 
360
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 (see "current" method description below).  | 
| 
361
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
362
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    my $entry = $dbConn->allrows();  | 
| 
363
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    my $entry = $dbConn->allrows( $map );  | 
| 
364
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
365
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The result is a Data::Toolkit::Entry object if there is data left to be read,  | 
| 
366
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 otherwise it is undef.  | 
| 
367
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
368
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =cut  | 
| 
369
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
370
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub allrows {  | 
| 
371
 | 
1
 | 
 
 | 
 
 | 
  
1
  
 | 
  
1
  
 | 
3
 | 
 	my $self = shift;  | 
| 
372
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
 	my $map = shift;  | 
| 
373
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
374
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
15
 | 
 	carp "Data::Toolkit::Connector::DBI->allrows $self" if $debug;  | 
| 
375
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
376
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Invalidate the old 'current entry' in case we have to return early  | 
| 
377
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
 	$self->{current} = undef;  | 
| 
378
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# We will use up all the rows so clear this  | 
| 
379
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
 	$self->{currentRow} = undef;  | 
| 
380
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
381
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Sanity check  | 
| 
382
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
7
 | 
 	croak "Data::Toolkit::Connector::DBI->allrows called but no search has been started" if !$self->{search_sth};  | 
| 
383
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
384
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Pull out the next row from the database  | 
| 
385
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
31
 | 
 	my $dbRow = $self->{search_sth}->fetchrow_hashref("NAME_lc");  | 
| 
386
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
7
 | 
 	return undef if !$dbRow;  | 
| 
387
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
388
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Build an entry  | 
| 
389
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
5
 | 
 	my $entry = Data::Toolkit::Entry->new();  | 
| 
390
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
391
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# While the search returns rows of data, slurp them up and add the values to the entry  | 
| 
392
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
 	my $count = 0;  | 
| 
393
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
5
 | 
 	while ($dbRow) {  | 
| 
394
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		# Step through the list of columns and add data to attributes in the entry  | 
| 
395
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4
 | 
 		my $attrib;  | 
| 
396
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
 		$count++;  | 
| 
397
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
398
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
7
 | 
 		foreach $attrib (keys %$dbRow) {  | 
| 
399
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
41
 | 
 			$entry->add( $attrib, [ $dbRow->{$attrib} ] );  | 
| 
400
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		}  | 
| 
401
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
402
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		# Fetch the next row  | 
| 
403
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
71
 | 
 		$dbRow = $self->{search_sth}->fetchrow_hashref("NAME_lc");  | 
| 
404
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
405
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
406
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Save this as the current entry  | 
| 
407
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
 	$self->{current} = $entry;  | 
| 
408
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
409
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
4
 | 
 	carp "Data::Toolkit::Connector::DBI->allrows found $count rows" if $debug;  | 
| 
410
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
411
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Do we have a map to apply?  | 
| 
412
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
4
 | 
 	if ($map) {  | 
| 
413
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 		return $entry->map($map);  | 
| 
414
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
415
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
416
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
 	return $entry;  | 
| 
417
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
418
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
419
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
420
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ########################################  | 
| 
421
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
422
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head2 current  | 
| 
423
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
424
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Return the current entry in the list of search results.  | 
| 
425
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The current entry is not defined until the "next" method has been called after a search.  | 
| 
426
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
427
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    $entry = $dbConn->current();  | 
| 
428
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
429
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =cut  | 
| 
430
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
431
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub current {  | 
| 
432
 | 
0
 | 
 
 | 
 
 | 
  
0
  
 | 
  
1
  
 | 
0
 | 
 	my $self = shift;  | 
| 
433
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
434
 | 
0
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	carp "Data::Toolkit::Connector::DBI->current $self" if $debug;  | 
| 
435
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
436
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	return $self->{current};  | 
| 
437
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
438
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
439
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
440
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
441
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ########################################  | 
| 
442
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
443
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head2 addspec  | 
| 
444
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
445
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Supply or fetch spec for add  | 
| 
446
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
447
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    $spec = $dbiConn->addspec();  | 
| 
448
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    $spec = $dbiConn->addspec( "INSERT INTO people (joinkey,name) VALUES (%key%, %myname%)" );  | 
| 
449
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
450
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Parameters are indicated thus: %name% - this will result in a '?'-style placeholder in  | 
| 
451
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 the SQL statement and the named attribute will be extracted from the supplied entry  | 
| 
452
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 by the add() method. Note that these parameters should not be quoted - they are not  | 
| 
453
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 passed as text to the database engine.  | 
| 
454
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
455
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =cut  | 
| 
456
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
457
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub addspec {  | 
| 
458
 | 
1
 | 
 
 | 
 
 | 
  
1
  
 | 
  
1
  
 | 
19
 | 
 	my $self = shift;  | 
| 
459
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
 	my $addspec = shift;  | 
| 
460
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
461
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
5
 | 
 	carp "Data::Toolkit::Connector::DBI->addspec $self $addspec " if $debug;  | 
| 
462
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
463
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
6
 | 
 	croak "Data::Toolkit::Connector::DBI->addspec called before server connection opened" if !$self->{server};  | 
| 
464
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
465
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# No arg supplied - just return existing setting  | 
| 
466
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
4
 | 
 	return $self->{addspec} if (!$addspec);  | 
| 
467
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
468
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# We have a new addspec so stash it for future reference  | 
| 
469
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
 	$self->{addspec} = $addspec;  | 
| 
470
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
471
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# We need to parse the spec to find the list of args that it calls for.  | 
| 
472
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Start by clearing the arglist and add string  | 
| 
473
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
 	my $add = '';  | 
| 
474
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4
 | 
 	my @arglist;  | 
| 
475
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
 	$self->{add_arglist} = \@arglist;  | 
| 
476
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
477
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Parameter names are between pairs of % characters  | 
| 
478
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Where we want a literal '%' it is represented by '%%'  | 
| 
479
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# so if the add string has at least two '%' left then there is work to be done  | 
| 
480
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
9
 | 
 	while ($addspec =~ /%.*%/) {  | 
| 
481
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
21
 | 
 		my ($left,$name,$right) = ($addspec =~ /^([^%]*)%([a-zA-Z0-9_]*)%(.*)$/);  | 
| 
482
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		# Everything before the first % gets added to the add string  | 
| 
483
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
14
 | 
 		$add .= $left;  | 
| 
484
 | 
3
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
10
 | 
 		if ($name) {  | 
| 
485
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 			# Add the name to the list of attributes needed when the add is performed  | 
| 
486
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
6
 | 
 			push @arglist, $name;  | 
| 
487
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 			# Put the placeholder in the actual add string  | 
| 
488
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
6
 | 
 			$add .= '?';  | 
| 
489
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		}  | 
| 
490
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		else {  | 
| 
491
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 			# We got '%%' so add a literal '%' to the add string  | 
| 
492
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 			$add .= '%';  | 
| 
493
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		}  | 
| 
494
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		# The remainder of the addspec goes round again  | 
| 
495
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
13
 | 
 		$addspec = $right;  | 
| 
496
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
497
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Anything left in the addspec gets appended to the add string  | 
| 
498
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
 	$add .= $addspec;  | 
| 
499
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
500
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Stash the resulting string  | 
| 
501
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
 	$self->{add_statement} = $add;  | 
| 
502
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
503
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Prepare the statement and stash the statement handle  | 
| 
504
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
8
 | 
 	$self->{add_sth} = $self->{server}->prepare( $add );  | 
| 
505
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
96
 | 
 	croak "Failed to prepare add '$add'" if !$self->{add_sth};  | 
| 
506
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
507
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Return the spec string that we were given  | 
| 
508
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
5
 | 
 	return $self->{addspec};  | 
| 
509
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
510
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
511
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ########################################  | 
| 
512
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
513
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head2 add  | 
| 
514
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
515
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Update a row in the database using data from a source entry and an optional map.  | 
| 
516
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 If a map is supplied, it is used to transform data from the source entry before  | 
| 
517
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 it is applied to the database operation.  | 
| 
518
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
519
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Returns the result of the DBI execute operation.  | 
| 
520
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
521
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    $msg = $dbConn->add($sourceEntry);  | 
| 
522
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    $msg = $dbConn->add($sourceEntry, $addMap);  | 
| 
523
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
524
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 A suitable add operation must have been defined using the addspec() method  | 
| 
525
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 before add() is called:  | 
| 
526
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
527
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    $spec = $dbiConn->addspec( "INSERT INTO people (joinkey,name) VALUES (%key%, %myname%)" );  | 
| 
528
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    $msg = $dbiConn->add( $entry );  | 
| 
529
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
530
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 NOTE that only the first value of a given attribute is used, as relational databases expect  | 
| 
531
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 a single value for each column in a given row.  | 
| 
532
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
533
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =cut  | 
| 
534
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
535
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub add {  | 
| 
536
 | 
1
 | 
 
 | 
 
 | 
  
1
  
 | 
  
1
  
 | 
7
 | 
 	my $self = shift;  | 
| 
537
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
 	my $source = shift;  | 
| 
538
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
 	my $map = shift;  | 
| 
539
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
540
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
5
 | 
 	croak "Data::Toolkit::Connector::DBI->add called before addspec has been defined" if !$self->{add_sth};  | 
| 
541
 | 
1
 | 
  
 50
  
 | 
  
 33
  
 | 
 
 | 
 
 | 
14
 | 
 	croak "Data::Toolkit::Connector::DBI->add first parameter should be a Data::Toolkit::Entry"  | 
| 
542
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		if ($source and !$source->isa('Data::Toolkit::Entry'));  | 
| 
543
 | 
1
 | 
  
 50
  
 | 
  
 33
  
 | 
 
 | 
 
 | 
14
 | 
 	croak "Data::Toolkit::Connector::DBI->add second parameter should be a Data::Toolkit::Map"  | 
| 
544
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		if ($map and !$map->isa('Data::Toolkit::Map'));  | 
| 
545
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
546
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
4
 | 
 	carp "Data::Toolkit::Connector::DBI->add $self $source" if $debug;  | 
| 
547
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
548
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Apply the map if we have one  | 
| 
549
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
4
 | 
 	$source = $source->map($map) if $map;  | 
| 
550
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
551
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# The args to be passed to the SQL UPDATE statement  | 
| 
552
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
 	my @args;  | 
| 
553
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# The array of names that came from the addspec  | 
| 
554
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
 	my @arglist = @{$self->{add_arglist}};  | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
5
 | 
    | 
| 
555
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Check that we have an entry to get params from  | 
| 
556
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
4
 | 
 	print "ARGLIST for add: ", (join '/', @arglist), "\n" if $debug;  | 
| 
557
 | 
1
 | 
  
 50
  
 | 
  
 33
  
 | 
 
 | 
 
 | 
10
 | 
 	if ($arglist[0] and !$source) {  | 
| 
558
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 		croak "Data::Toolkit::Connector::DBI->add requires an entry when the addspec includes parameters";  | 
| 
559
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
560
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
561
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Extract the args from the entry  | 
| 
562
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1
 | 
 	my $arg;  | 
| 
563
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
 	foreach $arg (@arglist) {  | 
| 
564
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
13
 | 
 		my $value = $source->get($arg);  | 
| 
565
 | 
3
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
11
 | 
 		croak "add spec calls for a '$arg' attribute but the entry does not have one" if !$value;  | 
| 
566
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		# We only use the first value from the list.  | 
| 
567
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		# This is permitted to be undef or the null string.  | 
| 
568
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
11
 | 
 		$value = $value->[0];  | 
| 
569
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
10
 | 
 		push @args, $value;  | 
| 
570
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
571
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
572
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Start the operation and return the statement handle having stashed a copy internally  | 
| 
573
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
16560
 | 
 	return $self->{add_result} = $self->{add_sth}->execute( @args );  | 
| 
574
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
575
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
576
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
577
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ########################################  | 
| 
578
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
579
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head2 updatespec  | 
| 
580
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
581
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Supply or fetch spec for update  | 
| 
582
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
583
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    $spec = $dbiConn->updatespec();  | 
| 
584
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    $spec = $dbiConn->updatespec( "UPDATE people set name = %myname% WHERE joinkey = %mykey%" );  | 
| 
585
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
586
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Parameters are indicated thus: %name% - this will result in a '?'-style placeholder in  | 
| 
587
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 the SQL statement and the named attribute will be extracted from the supplied entry  | 
| 
588
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 by the update() method.  | 
| 
589
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
590
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =cut  | 
| 
591
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
592
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub updatespec {  | 
| 
593
 | 
1
 | 
 
 | 
 
 | 
  
1
  
 | 
  
1
  
 | 
3
 | 
 	my $self = shift;  | 
| 
594
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
 	my $updatespec = shift;  | 
| 
595
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
596
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
4
 | 
 	carp "Data::Toolkit::Connector::DBI->updatespec $self $updatespec " if $debug;  | 
| 
597
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
598
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
5
 | 
 	croak "Data::Toolkit::Connector::DBI->updatespec called before server connection opened" if !$self->{server};  | 
| 
599
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
600
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# No arg supplied - just return existing setting  | 
| 
601
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
4
 | 
 	return $self->{updatespec} if (!$updatespec);  | 
| 
602
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
603
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# We have a new updatespec so stash it for future reference  | 
| 
604
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
5
 | 
 	$self->{updatespec} = $updatespec;  | 
| 
605
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
606
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# We need to parse the spec to find the list of args that it calls for.  | 
| 
607
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Start by clearing the arglist and update string  | 
| 
608
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
 	my $update = '';  | 
| 
609
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
 	my @arglist;  | 
| 
610
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
12
 | 
 	$self->{update_arglist} = \@arglist;  | 
| 
611
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
612
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Parameter names are between pairs of % characters  | 
| 
613
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Where we want a literal '%' it is represented by '%%'  | 
| 
614
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# so if the update string has at least two '%' left then there is work to be done  | 
| 
615
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
10
 | 
 	while ($updatespec =~ /%.*%/) {  | 
| 
616
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
18
 | 
 		my ($left,$name,$right) = ($updatespec =~ /^([^%]*)%([a-zA-Z0-9_]*)%(.*)$/);  | 
| 
617
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		# Everything before the first % gets added to the update string  | 
| 
618
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
5
 | 
 		$update .= $left;  | 
| 
619
 | 
3
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
7
 | 
 		if ($name) {  | 
| 
620
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 			# Add the name to the list of attributes needed when the update is performed  | 
| 
621
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4
 | 
 			push @arglist, $name;  | 
| 
622
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 			# Put the placeholder in the actual update string  | 
| 
623
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
5
 | 
 			$update .= '?';  | 
| 
624
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		}  | 
| 
625
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		else {  | 
| 
626
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 			# We got '%%' so add a literal '%' to the update string  | 
| 
627
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 			$update .= '%';  | 
| 
628
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		}  | 
| 
629
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		# The remainder of the updatespec goes round again  | 
| 
630
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
11
 | 
 		$updatespec = $right;  | 
| 
631
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
632
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Anything left in the updatespec gets appended to the update string  | 
| 
633
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
 	$update .= $updatespec;  | 
| 
634
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
635
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Stash the resulting string and associated list of attributes  | 
| 
636
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
 	$self->{update_statement} = $update;  | 
| 
637
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
638
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Prepare the statement and stash the statement handle  | 
| 
639
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
8
 | 
 	$self->{update_sth} = $self->{server}->prepare( $update );  | 
| 
640
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
151
 | 
 	croak "Failed to prepare update '$update'" if !$self->{update_sth};  | 
| 
641
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
642
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
4
 | 
 	carp "Data::Toolkit::Connector::DBI->updatespec setting '$update', (" . (join ',',@arglist) . ")" if $debug;  | 
| 
643
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
644
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Return the spec string that we were given  | 
| 
645
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4
 | 
 	return $self->{updatespec};  | 
| 
646
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
647
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
648
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ########################################  | 
| 
649
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
650
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head2 update  | 
| 
651
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
652
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Update a row in the database using data from a source entry and an optional map.  | 
| 
653
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 If a map is supplied, it is used to transform data from the source entry before  | 
| 
654
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 it is applied to the database operation.  | 
| 
655
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
656
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Returns the result of the DBI execute operation.  | 
| 
657
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
658
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    $msg = $dbConn->update($sourceEntry);  | 
| 
659
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    $msg = $dbConn->update($sourceEntry, $updateMap);  | 
| 
660
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
661
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 A suitable update operation must have been defined using the updatespec() method  | 
| 
662
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 before update() is called:  | 
| 
663
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
664
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    $spec = $dbiConn->updatespec( "UPDATE people set name = %myname% WHERE key = %mykey%" );  | 
| 
665
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    $msg = $dbiConn->update( $entry );  | 
| 
666
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
667
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 NOTE that only the first value of a given attribute is used, as relational databases expect  | 
| 
668
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 a single value for each column in a given row.  | 
| 
669
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
670
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Note also that multiple rows could be affected by a single call to this method, depending  | 
| 
671
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 on how the updatespec has been defined.  | 
| 
672
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
673
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =cut  | 
| 
674
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
675
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub update {  | 
| 
676
 | 
1
 | 
 
 | 
 
 | 
  
1
  
 | 
  
1
  
 | 
2
 | 
 	my $self = shift;  | 
| 
677
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4
 | 
 	my $source = shift;  | 
| 
678
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1
 | 
 	my $map = shift;  | 
| 
679
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
680
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
6
 | 
 	croak "Data::Toolkit::Connector::DBI->update called before updatespec has been defined" if !$self->{update_sth};  | 
| 
681
 | 
1
 | 
  
 50
  
 | 
  
 33
  
 | 
 
 | 
 
 | 
13
 | 
 	croak "Data::Toolkit::Connector::DBI->update first parameter should be a Data::Toolkit::Entry"  | 
| 
682
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		if ($source and !$source->isa('Data::Toolkit::Entry'));  | 
| 
683
 | 
1
 | 
  
 50
  
 | 
  
 33
  
 | 
 
 | 
 
 | 
5
 | 
 	croak "Data::Toolkit::Connector::DBI->update second parameter should be a Data::Toolkit::Map"  | 
| 
684
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		if ($map and !$map->isa('Data::Toolkit::Map'));  | 
| 
685
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
686
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
4
 | 
 	carp "Data::Toolkit::Connector::DBI->update $self $source" if $debug;  | 
| 
687
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
688
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Apply the map if we have one  | 
| 
689
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
4
 | 
 	$source = $source->map($map) if $map;  | 
| 
690
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
691
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# The args to be passed to the SQL UPDATE statement  | 
| 
692
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1
 | 
 	my @args;  | 
| 
693
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# The array of names that came from the updatespec  | 
| 
694
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
 	my @arglist = @{$self->{update_arglist}};  | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4
 | 
    | 
| 
695
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Check that we have an entry to get params from  | 
| 
696
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
5
 | 
 	print "ARGLIST for update: ", (join ',', @arglist), "\n" if $debug;  | 
| 
697
 | 
1
 | 
  
 50
  
 | 
  
 33
  
 | 
 
 | 
 
 | 
9
 | 
 	if ($arglist[0] and !$source) {  | 
| 
698
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 		croak "Data::Toolkit::Connector::DBI->update requires an entry when the updatespec includes parameters";  | 
| 
699
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
700
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
701
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Extract the args from the entry  | 
| 
702
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
8
 | 
 	my $arg;  | 
| 
703
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4
 | 
 	foreach $arg (@arglist) {  | 
| 
704
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
8
 | 
 		my $value = $source->get($arg);  | 
| 
705
 | 
3
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
8
 | 
 		croak "update spec calls for a '$arg' attribute but the entry does not have one" if !$value;  | 
| 
706
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		# We only use the first value from the list.  | 
| 
707
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		# This is permitted to be the null string.  | 
| 
708
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		# It should not be undef, as that would need an 'IS NULL' clause in SQL.  | 
| 
709
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
6
 | 
 		$value = $value->[0];  | 
| 
710
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
8
 | 
 		push @args, $value;  | 
| 
711
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
712
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
713
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Start the search and return the statement handle having stashed a copy internally  | 
| 
714
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
6125
 | 
 	return $self->{update_result} = $self->{update_sth}->execute( @args );  | 
| 
715
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
716
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
717
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
718
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ########################################  | 
| 
719
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
720
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head2 deletespec  | 
| 
721
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
722
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Supply or fetch spec for delete  | 
| 
723
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
724
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    $spec = $dbiConn->deletespec();  | 
| 
725
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    $spec = $dbiConn->deletespec( "DELETE from people WHERE joinkey = %mykey%" );  | 
| 
726
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
727
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Parameters are indicated thus: %name% - this will result in a '?'-style placeholder in  | 
| 
728
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 the SQL statement and the named attribute will be extracted from the supplied entry  | 
| 
729
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 by the delete() method.  | 
| 
730
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
731
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =cut  | 
| 
732
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
733
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub deletespec {  | 
| 
734
 | 
1
 | 
 
 | 
 
 | 
  
1
  
 | 
  
1
  
 | 
2
 | 
 	my $self = shift;  | 
| 
735
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
 	my $deletespec = shift;  | 
| 
736
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
737
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
4
 | 
 	carp "Data::Toolkit::Connector::DBI->deletespec $self $deletespec " if $debug;  | 
| 
738
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
739
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
6
 | 
 	croak "Data::Toolkit::Connector::DBI->deletespec called before server connection opened" if !$self->{server};  | 
| 
740
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
741
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# No arg supplied - just return existing setting  | 
| 
742
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
5
 | 
 	return $self->{deletespec} if (!$deletespec);  | 
| 
743
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
744
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# We have a new deletespec so stash it for future reference  | 
| 
745
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
 	$self->{deletespec} = $deletespec;  | 
| 
746
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
747
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# We need to parse the spec to find the list of args that it calls for.  | 
| 
748
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Start by clearing the arglist and delete string  | 
| 
749
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
 	my $delete = '';  | 
| 
750
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1
 | 
 	my @arglist;  | 
| 
751
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
 	$self->{delete_arglist} = \@arglist;  | 
| 
752
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
753
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Parameter names are between pairs of % characters  | 
| 
754
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Where we want a literal '%' it is represented by '%%'  | 
| 
755
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# so if the delete string has at least two '%' left then there is work to be done  | 
| 
756
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
8
 | 
 	while ($deletespec =~ /%.*%/) {  | 
| 
757
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
7
 | 
 		my ($left,$name,$right) = ($deletespec =~ /^([^%]*)%([a-zA-Z0-9_]*)%(.*)$/);  | 
| 
758
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		# Everything before the first % gets added to the delete string  | 
| 
759
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
 		$delete .= $left;  | 
| 
760
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
4
 | 
 		if ($name) {  | 
| 
761
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 			# Add the name to the list of attributes needed when the delete is performed  | 
| 
762
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
 			push @arglist, $name;  | 
| 
763
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 			# Put the placeholder in the actual delete string  | 
| 
764
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
 			$delete .= '?';  | 
| 
765
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		}  | 
| 
766
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		else {  | 
| 
767
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 			# We got '%%' so add a literal '%' to the delete string  | 
| 
768
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 			$delete .= '%';  | 
| 
769
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		}  | 
| 
770
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		# The remainder of the deletespec goes round again  | 
| 
771
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
 		$deletespec = $right;  | 
| 
772
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
773
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Anything left in the deletespec gets appended to the delete string  | 
| 
774
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
14
 | 
 	$delete .= $deletespec;  | 
| 
775
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
776
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Stash the resulting string and associated list of attributes  | 
| 
777
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
 	$self->{delete_statement} = $delete;  | 
| 
778
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
779
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Prepare the statement and stash the statement handle  | 
| 
780
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
15
 | 
 	$self->{delete_sth} = $self->{server}->prepare( $delete );  | 
| 
781
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
110
 | 
 	croak "Failed to prepare delete '$delete'" if !$self->{delete_sth};  | 
| 
782
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
783
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
4
 | 
 	carp "Data::Toolkit::Connector::DBI->deletespec setting '$delete', (" . (join ',',@arglist) . ")" if $debug;  | 
| 
784
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
785
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Return the spec string that we were given  | 
| 
786
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4
 | 
 	return $self->{deletespec};  | 
| 
787
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
788
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
789
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ########################################  | 
| 
790
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
791
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head2 delete  | 
| 
792
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
793
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Delete a row from the database using data from a source entry and an optional map.  | 
| 
794
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 If a map is supplied, it is used to transform data from the source entry before  | 
| 
795
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 it is applied to the database operation.  | 
| 
796
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
797
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Returns the result of the DBI execute operation.  | 
| 
798
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
799
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    $msg = $dbConn->delete($sourceEntry);  | 
| 
800
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    $msg = $dbConn->delete($sourceEntry, $deleteMap);  | 
| 
801
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
802
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 A suitable delete operation must have been defined using the deletespec() method  | 
| 
803
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 before delete() is called:  | 
| 
804
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
805
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    $spec = $dbiConn->deletespec( "DELETE FROM people WHERE joinkey = %mykey%" );  | 
| 
806
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    $msg = $dbiConn->delete( $entry );  | 
| 
807
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
808
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 NOTE that only the first value of a given attribute is used.  | 
| 
809
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
810
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Note also that multiple rows could be affected by a single call to this method, depending  | 
| 
811
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 on how the deletespec has been defined.  | 
| 
812
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
813
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =cut  | 
| 
814
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
815
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub delete {  | 
| 
816
 | 
1
 | 
 
 | 
 
 | 
  
1
  
 | 
  
1
  
 | 
2
 | 
 	my $self = shift;  | 
| 
817
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
 	my $source = shift;  | 
| 
818
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
 	my $map = shift;  | 
| 
819
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
820
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
5
 | 
 	croak "Data::Toolkit::Connector::DBI->delete called before deletespec has been defined" if !$self->{delete_sth};  | 
| 
821
 | 
1
 | 
  
 50
  
 | 
  
 33
  
 | 
 
 | 
 
 | 
18
 | 
 	croak "Data::Toolkit::Connector::DBI->delete first parameter should be a Data::Toolkit::Entry"  | 
| 
822
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		if ($source and !$source->isa('Data::Toolkit::Entry'));  | 
| 
823
 | 
1
 | 
  
 50
  
 | 
  
 33
  
 | 
 
 | 
 
 | 
10
 | 
 	croak "Data::Toolkit::Connector::DBI->delete second parameter should be a Data::Toolkit::Map"  | 
| 
824
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		if ($map and !$map->isa('Data::Toolkit::Map'));  | 
| 
825
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
826
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
18
 | 
 	carp "Data::Toolkit::Connector::DBI->delete $self $source" if $debug;  | 
| 
827
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
828
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Apply the map if we have one  | 
| 
829
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
4
 | 
 	$source = $source->map($map) if $map;  | 
| 
830
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
831
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# The args to be passed to the SQL UPDATE statement  | 
| 
832
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
 	my @args;  | 
| 
833
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# The array of names that came from the deletespec  | 
| 
834
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
 	my @arglist = @{$self->{delete_arglist}};  | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
    | 
| 
835
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Check that we have an entry to get params from  | 
| 
836
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
9
 | 
 	print "ARGLIST for delete: ", (join ',', @arglist), "\n" if $debug;  | 
| 
837
 | 
1
 | 
  
 50
  
 | 
  
 33
  
 | 
 
 | 
 
 | 
8
 | 
 	if ($arglist[0] and !$source) {  | 
| 
838
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 		croak "Data::Toolkit::Connector::DBI->delete requires an entry when the deletespec includes parameters";  | 
| 
839
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
840
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
841
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Extract the args from the entry  | 
| 
842
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
 	my $arg;  | 
| 
843
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
 	foreach $arg (@arglist) {  | 
| 
844
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4
 | 
 		my $value = $source->get($arg);  | 
| 
845
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
4
 | 
 		croak "delete spec calls for a '$arg' attribute but the entry does not have one" if !$value;  | 
| 
846
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		# We only use the first value from the list.  | 
| 
847
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		# This is permitted to be the null string.  | 
| 
848
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		# It should not be undef, as that would need an 'IS NULL' clause in SQL.  | 
| 
849
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
 		$value = $value->[0];  | 
| 
850
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
 		push @args, $value;  | 
| 
851
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
852
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
853
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Start the search and return the statement handle having stashed a copy internally  | 
| 
854
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
15554
 | 
 	return $self->{delete_result} = $self->{delete_sth}->execute( @args );  | 
| 
855
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
856
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
857
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ########################################################################  | 
| 
858
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # Debugging methods  | 
| 
859
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ########################################################################  | 
| 
860
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
861
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head1 Debugging methods  | 
| 
862
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
863
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head2 debug  | 
| 
864
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
865
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Set and/or get the debug level for Data::Toolkit::Connector  | 
| 
866
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
867
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    my $currentDebugLevel = Data::Toolkit::Connector::LDAP->debug();  | 
| 
868
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    my $newDebugLevel = Data::Toolkit::Connector::LDAP->debug(1);  | 
| 
869
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
870
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Any non-zero debug level causes the module to print copious debugging information.  | 
| 
871
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
872
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Note that this is a package method, not an object method. It should always be  | 
| 
873
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 called exactly as shown above.  | 
| 
874
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
875
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 All debug information is reported using "carp" from the Carp module, so if  | 
| 
876
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 you want a full stack backtrace included you can run your program like this:  | 
| 
877
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
878
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    perl -MCarp=verbose myProg  | 
| 
879
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
880
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =cut  | 
| 
881
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
882
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # Class method to set and/or get debug level  | 
| 
883
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #  | 
| 
884
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub debug {  | 
| 
885
 | 
1
 | 
 
 | 
 
 | 
  
1
  
 | 
  
1
  
 | 
63
 | 
 	my $class = shift;  | 
| 
886
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
6
 | 
 	if (ref $class)  { croak "Class method 'debug' called as object method" }  | 
| 
 
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
887
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# print "DEBUG: ", (join '/', @_), "\n";  | 
| 
888
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
5
 | 
 	$debug = shift if (@_ == 1);  | 
| 
889
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
11
 | 
 	return $debug  | 
| 
890
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
891
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
892
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
893
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ########################################################################  | 
| 
894
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ########################################################################  | 
| 
895
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
896
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head1 Author  | 
| 
897
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
898
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Andrew Findlay  | 
| 
899
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
900
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Skills 1st Ltd  | 
| 
901
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
902
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 andrew.findlay@skills-1st.co.uk  | 
| 
903
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
904
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 http://www.skills-1st.co.uk/  | 
| 
905
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
906
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =cut  | 
| 
907
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
908
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ########################################################################  | 
| 
909
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ########################################################################  | 
| 
910
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 1;  |