line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package MyLibrary::Patron; |
2
|
|
|
|
|
|
|
|
3
|
3
|
|
|
3
|
|
49381
|
use MyLibrary::DB; |
|
3
|
|
|
|
|
9
|
|
|
3
|
|
|
|
|
90
|
|
4
|
3
|
|
|
3
|
|
1709
|
use MyLibrary::Patron::Links; |
|
3
|
|
|
|
|
9
|
|
|
3
|
|
|
|
|
84
|
|
5
|
3
|
|
|
3
|
|
19
|
use Carp qw(croak); |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
142
|
|
6
|
3
|
|
|
3
|
|
16
|
use strict; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
12199
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
=head1 NAME |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
MyLibrary::Patron |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
=head1 SYNOPSIS |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
# require the necessary module |
16
|
|
|
|
|
|
|
use MyLibrary::Patron; |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
# create an undefined Patron object |
19
|
|
|
|
|
|
|
my $patron = MyLibrary::Patron->new(); |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
# get patron id |
22
|
|
|
|
|
|
|
my $patron_id = $patron->patron_id(); |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
# set the various attributes of a Patron object |
25
|
|
|
|
|
|
|
$patron->patron_firstname('Robert'); |
26
|
|
|
|
|
|
|
$patron->patron_surname('Fox'); |
27
|
|
|
|
|
|
|
$patron->patron_image('/path/to/image.jpg'); |
28
|
|
|
|
|
|
|
$patron->patron_url('http://homesite/for/patron'); |
29
|
|
|
|
|
|
|
$patron->patron_username('username'); |
30
|
|
|
|
|
|
|
$patron->patron_organization('University of Notre Dame'); |
31
|
|
|
|
|
|
|
$patron->patron_address_1('address info'); |
32
|
|
|
|
|
|
|
$patron->patron_can_contact(1); |
33
|
|
|
|
|
|
|
$patron->patron_password('#$@$^&*'); |
34
|
|
|
|
|
|
|
$patron->patron_total_visits(23); |
35
|
|
|
|
|
|
|
$patron->patron_last_visit('2005-15-08'); |
36
|
|
|
|
|
|
|
$patron->patron_remember_me(1); |
37
|
|
|
|
|
|
|
$patron->patron_email('yourname@nd.edu'); |
38
|
|
|
|
|
|
|
$patron->patron_stylesheet_id(25); |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
# commit a Patron to the database |
41
|
|
|
|
|
|
|
$patron->commit(); |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
# manipulate patron to resource relations |
44
|
|
|
|
|
|
|
my @patron_resources = $patron->patron_resources(new => [@resource_ids]); |
45
|
|
|
|
|
|
|
$patron->patron_resources(del => [@resource_ids]); |
46
|
|
|
|
|
|
|
my @patron_resources = $patron->patron_resources(sort => 'name'); |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
# create, delete and retrieve associated personal links |
49
|
|
|
|
|
|
|
$patron->add_link(link_name => 'CNN', link_url => 'http://mysite.com'); |
50
|
|
|
|
|
|
|
my $num_deleted = $patron->delete_link(link_id => $link_id); |
51
|
|
|
|
|
|
|
my @patron_links = $patron->get_links(); |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
# get or set personal link attributes |
54
|
|
|
|
|
|
|
my $link_id = $patron_links[0]->link_id(); |
55
|
|
|
|
|
|
|
$patron_links[0]->link_name('CNN2'); |
56
|
|
|
|
|
|
|
my $link_name = $patron_links[0]->link_name(); |
57
|
|
|
|
|
|
|
my $link_url = $patron_links[0]->link_url(); |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
# resource usage counts |
60
|
|
|
|
|
|
|
MyLibrary::Patron->resource_usage(action => 'increment', patron => $patron_id, resource => $resource_id); |
61
|
|
|
|
|
|
|
my $usage_count = MyLibrary::Patron->resource_usage(action => 'resource_usage_count', patron => $patron_id, resource => $resource_id); |
62
|
|
|
|
|
|
|
my $resource_usage_count = MyLibrary::Patron->resource_usage(action => 'absolute_usage_count', resource => $resource_id); |
63
|
|
|
|
|
|
|
my $patron_usage_count = MyLibrary::Patron->resource_usage(action => 'patron_usage_count', resource => $resource_id); |
64
|
|
|
|
|
|
|
my $patron_resource_count = MyLibrary::Patron->resource_usage(action => 'patron_resource_count', patron => $patron_id); |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
# manipulate patron -> term relations |
67
|
|
|
|
|
|
|
my @patron_terms = $patron->patron_terms(); |
68
|
|
|
|
|
|
|
$patron->patron_terms(new => [@term_ids]); |
69
|
|
|
|
|
|
|
$patron->patron_terms(del => [@term_ids]); |
70
|
|
|
|
|
|
|
my @patron_terms = $patron->patron_terms(sort => 'name'); |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
# get a list of Patron objects |
73
|
|
|
|
|
|
|
my @patrons = MyLibrary::Patron->get_patrons(); |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
# delete a Patron object from the database |
76
|
|
|
|
|
|
|
$patron->delete(); |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
=head1 DESCRIPTION |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
Use this module to get and set patron information to a MyLibrary database as well as retrieve a list of all Patron objects in a MyLibrary instance. This package also contains several methods which can be used to retrieve related information about a given patron such as which resources they have selected as well as their customized interface. |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
=head1 METHODS |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=head2 new() |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
This class method is the constructor for this package. The method is responsible for initializing all attributes associated with a given Patron object. The method can also be used to create a Patron object using a patron id or name. The patron would thus already need to exist in the database in order for these parameters to have any effect. |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
=head2 patron_id() |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
This method is used exclusively to retrieve an exising patron's database id, if the patron has been commited to the database. This method may not be used to set a patron's database id. |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
# get patron id |
93
|
|
|
|
|
|
|
my $patron_id = $patron->patron_id(); |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
This is a required Patron object attribute. |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
=head2 patron_firstname() |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
This method may be used to either get or set a patron's first name. This is a required attribute, meaning that the object cannot be commited to the database if this attribute is left null. |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
# set patron_firstname() |
102
|
|
|
|
|
|
|
$patron->patron_firstname('Robert'); |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
# get patron_firstname() |
105
|
|
|
|
|
|
|
my $patron_first_name = $patron->patron_firstname(); |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
=head2 patron_surname() |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
This method may be used to either get or set a patorn's last name. This is a required attribute, meaning that the object cannot be commited to the database if this attribute is left null. |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
# set patron_surname() |
112
|
|
|
|
|
|
|
$patron->patron_surname('Miller'); |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
# get patron_surname() |
115
|
|
|
|
|
|
|
my $patron_last_name = $patron->patron_surname(); |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
=head2 patron_image() |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
This method was added in response to certain metadata standards (namely FOAF), and allows the programmer to add a path within a patron record to an image associated with the patron. For example, the image could be chosen by the patron or a picture of the patron. This is not a required attribute. |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
# set the patron_image() |
122
|
|
|
|
|
|
|
$patron->patron_image('/usr/local/bin/me.jpg'); |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
# get the patron_image() |
125
|
|
|
|
|
|
|
my $patron_image = $patron->patron_image(); |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
=head2 patron_email() |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
This method gets or sets a patron's email address. This is not a required attribute. |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
# set patron's email address |
132
|
|
|
|
|
|
|
$patron->patron_email('eric'); |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
# get patron's email address |
135
|
|
|
|
|
|
|
my $email = $patron->patron_email(); |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
=head2 patron_address_1(), patron_address_2(), patron_address_3(), patron_address_4(), patron_address_5() |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
These methods should be used to set or get the patron's address information. Typically, this is a street address or building location. This is not a required attribute. The five address fields can contain any information which is appropriate for indicating the patron's full address. These fields are intentionally open ended so that address formats from various nationalities can be stored in these fields. Each field can correspond to a particular line in an address. |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
# set a patron's address part one |
142
|
|
|
|
|
|
|
$patron->patron_address_1('2634 Willow Street'); |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
# get a patron's address part one |
145
|
|
|
|
|
|
|
my $patron_address_one = $patron->patron_address_1(); |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
=head2 patron_can_contact() |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
This method should be used to set the can_contact flag. This is a binary attribute, and is not required. However, a devault value of '0' ('Do not contact') will be set if no value is indicated. The input to this method will be sanitized from non-binary content. |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
# set a patron's can_contact flag |
152
|
|
|
|
|
|
|
$patron->patron_can_contact(1); |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
# get a patron's can_contact flag |
155
|
|
|
|
|
|
|
my $patron_contact_flag = $patron->patron_can_contact(); |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
=head2 patron_password() |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
This method can be used to either retrieve or set a patron's password. This attribute will only be used when the system relies upon the 'default' method of authentication (which is to store patron passwords locally as opposed to relying upon an insitutional authentication system). The non-encrypted password chosen and entered by the patron will be encrypted. When the password is retrieved, it will also be in an encrypted form for security purposes. Authentication methods can then be used to perform password verification against this patron attribute. Alpha or numeric digits may be used in a patron's password in any order, however, authentication module methods may place certain requirements on password length and complexity. This method simply encrypts, stores and retrieves patron passwords. |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
# set the patron's password |
162
|
|
|
|
|
|
|
my $entered_password = $input->{'password'}; |
163
|
|
|
|
|
|
|
$patron->patron_password($entered_password); |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
# retrieve the encrypted form of a patron's password |
166
|
|
|
|
|
|
|
my $patron_password = $patron->patron_password(); |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
=head2 patron_remember_me() |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
This method should be used to set the wants_cookie flag, which indicates whether the patron desires to have a "permanent" cookie placed on the current computer they are working on. This will allow the patron to automatically log into their MyLibrary account the next time they use this particular machine. This is a binary attribute, and is not required. However, a devault value of '0' ('Does not want permanent cookie') will be set if no value is indicated. The input to this method will be sanitized from non-binary content. |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
# set a patron's wants_cookie flag |
173
|
|
|
|
|
|
|
$patron->patron_remember_me(1); |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
# get a patron's wants_cookie flag |
176
|
|
|
|
|
|
|
my $patron_wants_cookie_flag = $patron->patron_remember_me(); |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
=head2 patron_username() |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
This method should be used to either set or get a patron's system username. The ultimate source of the username content will either come from the patron themselves or from an external authority (such as an LDAP database). This is the attribute the patron uses to identify themselves to the MyLibrary system. This is a required attribute. |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
# set the patron's username |
183
|
|
|
|
|
|
|
$patron->patron_username('johnsmith'); |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
# get a patron's username |
186
|
|
|
|
|
|
|
my $patron_username = $patron->patron_username(); |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
=head2 patron_organization() |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
Use this method as an accessor to the parent organization for the patron. This method will perform the standard set and get operations on this attribute. The organization should correspond to the parent institution within which the patron resides, or could also correspond to sub organizations within the parent institution. |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
# set the patron's organization |
193
|
|
|
|
|
|
|
$patron->patron_organization('University of Notre Dame'); |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
# get a patron's organization name |
196
|
|
|
|
|
|
|
my $patron_organization = $patron->patron_organization(); |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
=head2 patron_last_visit() |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
This method can be used to get or set the date of the last time the patron visited the MyLibrary system. The input to this method will be sanitized and if an inappropriate date is input, the method will simply not execute. This is not a required attribute. |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
# set the date of the last visit |
203
|
|
|
|
|
|
|
$patron->patron_last_visit('2003-10-05'); |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
# get the date of the last visit |
206
|
|
|
|
|
|
|
my $patron_last_visit = $patron->patron_last_visit(); |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
=head2 patron_total_visits() |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
This method can be used to either retrieve the total number of visits or increment the total visit count by the amount indicated. The amount indicated must be a positive integer. However, this is not a required attribute. Any other parameter input for this method will simply be ignored. |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
# increment the number of total visits by a certain number |
213
|
|
|
|
|
|
|
$patron->patron_total_visits(increment => 6); |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
# retrieve the number of total visits |
216
|
|
|
|
|
|
|
my $patron_total_visits = $patron->patron_total_visits(); |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
=head2 patron_stylesheet_id() |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
Patrons may indicate a preference for a certain style of their interface. This will organize certain interface attributes such as coordinating colors, graphical options and positioning of interface elements. The stylesheets supplied by MyLibrary administrators will provide the patron with a choice of style for their page. This method must be used to either retrieve or set the stylesheet id with which the patron will be associated. The input to this method must be an integer. This is a required attribute. If no stylesheet id is provided, a default stylesheet will be assigned when the patron initially creates their page. However, the patron can choose another stylesheet at any time. |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
# associate a stylesheet with a patron |
223
|
|
|
|
|
|
|
$patron->patron_stylesheet_id(16); |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
# retrieve the stylesheet associated with this patron |
226
|
|
|
|
|
|
|
my $patron_stylesheet_id = $patron->patron_stylesheet_id(); |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
=head2 commit() |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
This method will simply commit the current Patron object to the database and update any attribute information that has changed for an existing patron. Database integrity checks will be performed upon commit. |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
# commit the Patron object to the database |
233
|
|
|
|
|
|
|
$patron->commit(); |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
=head2 patron_resources() |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
This object method can be used to create or delete relations between patron objects and resources objects in the underlying database. It can also be used to obtain a list of resource ids associated with a particular patron. The method always returns the current list of resource ids associated with a patron object regardless of the parameters passed to it. If the sort parameter is passed, the list of resource ids returned will be sorted. Currently, sorting is only available by resource name ('name'). |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
Null will be returned if no resources are associated with the patron object. The method will also check to make sure that resources exist that are to be added or deleted. If resource ids are passed to this method which do not correspond to an existing resource object, they will be ignored. |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
The resources associated with the patron object are, in effect, "owned" by the patron. In other words, these resources have been hand picked for the patron or by the patron in order to form a specialized list somehow associated with the patron. For example, resources may be in the subject area in which the patron is interested, or a list of a certain type of resource that the patron regularly uses. Also, a default list of resources may be created for the patron and this method can be used to make that association. |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
# simply return a list of associated resource ids |
244
|
|
|
|
|
|
|
my @patron_resources = $patron->patron_resources(); |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
# retrieve a sorted list |
247
|
|
|
|
|
|
|
my @sorted_resource_list = $patron->patron_resources(sort => 'name'); |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
# add a list of resources to a patron |
250
|
|
|
|
|
|
|
$patron->patron_resources(new => [@resource_ids]); |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
# delete a list of resources from a patron |
253
|
|
|
|
|
|
|
$patron->patron_resources(del => [@resource_ids]); |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
=head2 resource_usage() |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
This is a class method that can be used to retrieve usage counts based on a number of criteria or increment usage counts for a particular patron and resource. Regarding statistical usage retrieval, counts can be generated according to number of uses by a single patron for a single resource, a group of resources, or statistical tidbits like how many patrons have used a particular resource. The output is entirely dependent upon the type and combination of parameters passed to the method. |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
Examples for each combination of parameters and output follow. |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
# simply increment the usage value for a patron and particular resource |
262
|
|
|
|
|
|
|
MyLibrary::Patron->resource_usage(action => 'increment', patron => $patron_id, resource => $resource_id); |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
# retrieve the resource usage count for a patron |
265
|
|
|
|
|
|
|
my $usage_count = MyLibrary::Patron->resource_usage(action => 'resource_usage_count', patron => $patron_id, resource => $resource_id); |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
# determine an absolute usage count for a patricular resource |
268
|
|
|
|
|
|
|
my $resource_usage_count = MyLibrary::Patron->resource_usage(action => 'absolute_usage_count', resource => $resource_id); |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
# determine how many patrons have used a particular resource at least once |
271
|
|
|
|
|
|
|
my $patron_usage_count = MyLibrary::Patron->resource_usage(action => 'patron_usage_count', resource => $resource_id); |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
# retrieve a count of resources a particular patron has used |
274
|
|
|
|
|
|
|
my $patron_resource_count = MyLibrary::Patron->resource_usage(action => 'patron_resource_count', patron => $patron_id); |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
=head2 patron_terms() |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
This object method should be used to manipulate relations between patron and term objects. The output is always the current list of term ids associated with the patron or null. The output list can be sorted by term name. Term object relations can be created or deleted using this method. |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
# get an unordered list of term ids |
281
|
|
|
|
|
|
|
my @patron_terms = $patron->patron_terms(); |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
# get a name sorted list of term ids |
284
|
|
|
|
|
|
|
my @patron_terms = $patron->patron_terms(sort => 'name'); |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
# add term assciations |
287
|
|
|
|
|
|
|
$patron->patron_terms(new => [@term_ids]); |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
# delete term associations |
290
|
|
|
|
|
|
|
$patron->patron_terms(del => [@term_ids]); |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
=head2 delete() |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
This method is used to delete a Patron object from the database. This is an irreversible process. |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
# delete patron from database |
297
|
|
|
|
|
|
|
$patron->delete(); |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
=head2 get_patrons() |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
This is a class method that will allow the programmer to retrieve all of the patron objects which currently exist in a MyLibrary instance. These are full class objects and any object methods can be used on the objects retrieved using this method. The method will return an array of Patron objects. |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
# get all patron objects |
304
|
|
|
|
|
|
|
my @patrons = MyLibrary::Patron->get_patrons(); |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
=head1 AUTHORS |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
Robert Fox |
309
|
|
|
|
|
|
|
Eric Lease Morgan |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
=cut |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
sub new { |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
# declare a few variables |
316
|
2
|
|
|
2
|
1
|
1829
|
my ($class, %opts) = @_; |
317
|
2
|
|
|
|
|
5
|
my $self = {}; |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
# check for an id |
320
|
2
|
50
|
|
|
|
38
|
if ($opts{id}) { |
|
|
50
|
|
|
|
|
|
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
# find this record |
323
|
0
|
|
|
|
|
0
|
my $dbh = MyLibrary::DB->dbh(); |
324
|
0
|
|
|
|
|
0
|
my $rv = $dbh->selectrow_hashref('SELECT * FROM patrons WHERE patron_id = ?', undef, $opts{id}); |
325
|
0
|
0
|
|
|
|
0
|
if (ref($rv) eq "HASH") { $self = $rv } |
|
0
|
|
|
|
|
0
|
|
326
|
0
|
|
|
|
|
0
|
else { return } |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
# check for username |
329
|
|
|
|
|
|
|
} elsif ($opts{username}) { |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
# get a record based on this username |
332
|
0
|
|
|
|
|
0
|
my $dbh = MyLibrary::DB->dbh(); |
333
|
0
|
|
|
|
|
0
|
my $rv = $dbh->selectrow_hashref('SELECT * FROM patrons WHERE patron_username = ?', undef, $opts{username}); |
334
|
0
|
0
|
|
|
|
0
|
if (ref($rv) eq "HASH") { $self = $rv } |
|
0
|
|
|
|
|
0
|
|
335
|
0
|
|
|
|
|
0
|
else { return } |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
} |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
# return the object |
340
|
2
|
|
|
|
|
10
|
return bless $self, $class; |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
} |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
sub patron_email { |
346
|
2
|
|
|
2
|
1
|
440
|
my ($self, $email) = @_; |
347
|
2
|
100
|
|
|
|
6
|
if ($email) { $self->{patron_email} = $email } |
|
1
|
|
|
|
|
9
|
|
348
|
1
|
|
|
|
|
8
|
else { return $self->{patron_email} } |
349
|
|
|
|
|
|
|
} |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
sub patron_firstname { |
353
|
3
|
|
|
3
|
1
|
11
|
my ($self, $name_first) = @_; |
354
|
3
|
100
|
|
|
|
10
|
if ($name_first) { $self->{patron_firstname} = $name_first } |
|
2
|
|
|
|
|
11
|
|
355
|
1
|
|
|
|
|
5
|
else { return $self->{patron_firstname} } |
356
|
|
|
|
|
|
|
} |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
sub patron_surname { |
360
|
3
|
|
|
3
|
1
|
10
|
my ($self, $name_last) = @_; |
361
|
3
|
100
|
|
|
|
8
|
if ($name_last) { $self->{patron_surname} = $name_last } |
|
2
|
|
|
|
|
7
|
|
362
|
1
|
|
|
|
|
5
|
else { return $self->{patron_surname} } |
363
|
|
|
|
|
|
|
} |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
sub patron_image { |
366
|
2
|
|
|
2
|
1
|
3
|
my ($self, $image) = @_; |
367
|
2
|
100
|
|
|
|
6
|
if ($image) { $self->{patron_image} = $image } |
|
1
|
|
|
|
|
38
|
|
368
|
1
|
|
|
|
|
5
|
else { return $self->{patron_image} } |
369
|
|
|
|
|
|
|
} |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
sub patron_url { |
372
|
2
|
|
|
2
|
0
|
3
|
my ($self, $url) = @_; |
373
|
2
|
100
|
|
|
|
6
|
if ($url) { $self->{patron_url} = $url } |
|
1
|
|
|
|
|
3
|
|
374
|
1
|
|
|
|
|
5
|
else { return $self->{patron_url} } |
375
|
|
|
|
|
|
|
} |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
sub patron_password { |
378
|
2
|
|
|
2
|
1
|
4
|
my ($self, $password) = @_; |
379
|
2
|
100
|
|
|
|
6
|
if ($password) { |
380
|
1
|
|
|
|
|
4
|
my $encrypted_password = $self->_encrypt_password($password); |
381
|
1
|
|
|
|
|
4
|
$self->{patron_password} = $encrypted_password; |
382
|
|
|
|
|
|
|
} else { |
383
|
1
|
|
|
|
|
15
|
return $self->{patron_password}; |
384
|
|
|
|
|
|
|
} |
385
|
|
|
|
|
|
|
} |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
sub patron_address_1 { |
389
|
2
|
|
|
2
|
1
|
3
|
my ($self, $address_1) = @_; |
390
|
2
|
100
|
|
|
|
6
|
if ($address_1) { $self->{patron_address_1} = $address_1 } |
|
1
|
|
|
|
|
3
|
|
391
|
1
|
|
|
|
|
5
|
else { return $self->{patron_address_1} } |
392
|
|
|
|
|
|
|
} |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
sub patron_address_2 { |
396
|
2
|
|
|
2
|
1
|
5
|
my ($self, $address_2) = @_; |
397
|
2
|
100
|
|
|
|
6
|
if ($address_2) { $self->{patron_address_2} = $address_2 } |
|
1
|
|
|
|
|
3
|
|
398
|
1
|
|
|
|
|
5
|
else { return $self->{patron_address_2} } |
399
|
|
|
|
|
|
|
} |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
sub patron_address_3 { |
402
|
2
|
|
|
2
|
1
|
5
|
my ($self, $address_3) = @_; |
403
|
2
|
100
|
|
|
|
6
|
if ($address_3) { $self->{patron_address_3} = $address_3 } |
|
1
|
|
|
|
|
3
|
|
404
|
1
|
|
|
|
|
6
|
else { return $self->{patron_address_3} } |
405
|
|
|
|
|
|
|
} |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
sub patron_address_4 { |
408
|
2
|
|
|
2
|
1
|
4
|
my ($self, $address_4) = @_; |
409
|
2
|
100
|
|
|
|
5
|
if ($address_4) { $self->{patron_address_4} = $address_4 } |
|
1
|
|
|
|
|
3
|
|
410
|
1
|
|
|
|
|
5
|
else { return $self->{patron_address_4} } |
411
|
|
|
|
|
|
|
} |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
sub patron_address_5 { |
415
|
2
|
|
|
2
|
1
|
4
|
my ($self, $address_5) = @_; |
416
|
2
|
100
|
|
|
|
5
|
if ($address_5) { $self->{patron_address_5} = $address_5 } |
|
1
|
|
|
|
|
5
|
|
417
|
1
|
|
|
|
|
5
|
else { return $self->{patron_address_5} } |
418
|
|
|
|
|
|
|
} |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
sub patron_can_contact { |
421
|
2
|
|
|
2
|
1
|
4
|
my ($self, $patron_can_contact) = @_; |
422
|
2
|
100
|
|
|
|
7
|
if ($patron_can_contact) { $self->{patron_can_contact} = $patron_can_contact } |
|
1
|
|
|
|
|
4
|
|
423
|
1
|
|
|
|
|
5
|
else { return $self->{patron_can_contact} } |
424
|
|
|
|
|
|
|
} |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
sub patron_remember_me { |
427
|
2
|
|
|
2
|
1
|
4
|
my ($self, $wants_cookie) = @_; |
428
|
2
|
100
|
|
|
|
7
|
if ($wants_cookie) { $self->{patron_remember_me} = $wants_cookie } |
|
1
|
|
|
|
|
3
|
|
429
|
1
|
|
|
|
|
4
|
else { return $self->{patron_remember_me} } |
430
|
|
|
|
|
|
|
} |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
sub patron_username { |
434
|
2
|
|
|
2
|
1
|
3
|
my ($self, $username) = @_; |
435
|
2
|
100
|
|
|
|
5
|
if ($username) { $self->{patron_username} = $username } |
|
1
|
|
|
|
|
3
|
|
436
|
1
|
|
|
|
|
5
|
else { return $self->{patron_username} } |
437
|
|
|
|
|
|
|
} |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
sub patron_organization { |
440
|
2
|
|
|
2
|
1
|
3
|
my ($self, $organization) = @_; |
441
|
2
|
100
|
|
|
|
6
|
if ($organization) { $self->{patron_organization} = $organization } |
|
1
|
|
|
|
|
4
|
|
442
|
1
|
|
|
|
|
4
|
else { return $self->{patron_organization} } |
443
|
|
|
|
|
|
|
} |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
sub patron_last_visit { |
446
|
2
|
|
|
2
|
1
|
7
|
my ($self, $last_visit) = @_; |
447
|
2
|
100
|
|
|
|
12
|
if ($last_visit) { $self->{patron_last_visit} = $last_visit } |
|
1
|
|
|
|
|
17
|
|
448
|
1
|
|
|
|
|
139
|
else { return $self->{patron_last_visit} } |
449
|
|
|
|
|
|
|
} |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
sub patron_total_visits { |
453
|
2
|
|
|
2
|
1
|
4
|
my ($self, $total_visits) = @_; |
454
|
2
|
100
|
|
|
|
9
|
if ($total_visits) { $self->{patron_total_visits} = $total_visits } |
|
1
|
|
|
|
|
5
|
|
455
|
1
|
|
|
|
|
5
|
else { return $self->{patron_total_visits} } |
456
|
|
|
|
|
|
|
} |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
sub patron_stylesheet_id { |
460
|
3
|
|
|
3
|
1
|
10
|
my ($self, $stylesheet_id) = @_; |
461
|
3
|
100
|
|
|
|
47
|
if ($stylesheet_id) { $self->{patron_stylesheet_id} = $stylesheet_id } |
|
2
|
|
|
|
|
9
|
|
462
|
1
|
|
|
|
|
6
|
else { return $self->{patron_stylesheet_id} } |
463
|
|
|
|
|
|
|
} |
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
sub patron_id { |
467
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
468
|
0
|
|
|
|
|
0
|
return $self->{patron_id}; |
469
|
|
|
|
|
|
|
} |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
sub commit { |
473
|
|
|
|
|
|
|
|
474
|
2
|
|
|
2
|
1
|
8
|
my $self = shift; |
475
|
2
|
|
|
|
|
19
|
my $dbh = MyLibrary::DB->dbh(); |
476
|
|
|
|
|
|
|
|
477
|
0
|
0
|
|
|
|
0
|
if ($self->patron_id()) { |
478
|
|
|
|
|
|
|
|
479
|
0
|
|
|
|
|
0
|
my $return = $dbh->do('UPDATE patrons SET patron_firstname = ?, patron_surname = ?, patron_email = ?, patron_image = ?, patron_url = ?, patron_username = ?, patron_organization = ?, patron_address_1 = ?, patron_address_2 = ?, patron_address_3 = ?, patron_address_4 = ?, patron_address_5 = ?, patron_can_contact = ?, patron_password = ?, patron_total_visits = ?, patron_last_visit = ?, patron_remember_me = ?, patron_stylesheet_id = ? WHERE patron_id = ?', undef, $self->patron_firstname(), $self->patron_surname(), $self->patron_email(), $self->patron_image(), $self->patron_url(), $self->patron_username(), $self->patron_organization(), $self->patron_address_1(), $self->patron_address_2(), $self->patron_address_3(), $self->patron_address_4(), $self->patron_address_5(), $self->patron_can_contact(), $self->patron_password(), $self->patron_total_visits(), $self->patron_last_visit(), $self->patron_remember_me(), $self->patron_stylesheet_id(), $self->patron_id()); |
480
|
|
|
|
|
|
|
|
481
|
0
|
0
|
0
|
|
|
0
|
if ($return > 1 || ! $return) { croak "Patron update in commit() failed. $return records were updated."; } |
|
0
|
|
|
|
|
0
|
|
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
} else { |
484
|
|
|
|
|
|
|
|
485
|
0
|
|
|
|
|
0
|
my $id = MyLibrary::DB->nextID(); |
486
|
0
|
|
|
|
|
0
|
my $return = $dbh->do('INSERT INTO patrons (patron_id, patron_firstname, patron_surname, patron_email, patron_image, patron_url, patron_username, patron_organization, patron_address_1, patron_address_2, patron_address_3, patron_address_4, patron_address_5, patron_can_contact, patron_password, patron_total_visits, patron_last_visit, patron_remember_me, patron_stylesheet_id) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)', undef, $id, $self->patron_firstname(), $self->patron_surname(), $self->patron_email(), $self->patron_image(), $self->patron_url(), $self->patron_username(), $self->patron_organization(), $self->patron_address_1(), $self->patron_address_2(), $self->patron_address_3(), $self->patron_address_4(), $self->patron_address_5(), $self->patron_can_contact(), $self->patron_password(), $self->patron_total_visits(), $self->patron_last_visit(), $self->patron_remember_me(), $self->patron_stylesheet_id(), $self->patron_id()); |
487
|
0
|
0
|
0
|
|
|
0
|
if ($return > 1 || ! $return) { croak 'Patron commit() failed.'; } |
|
0
|
|
|
|
|
0
|
|
488
|
0
|
|
|
|
|
0
|
$self->{patron_id} = $id; |
489
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
} |
491
|
|
|
|
|
|
|
|
492
|
0
|
|
|
|
|
0
|
return 1; |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
} |
495
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
sub patron_resources { |
497
|
|
|
|
|
|
|
|
498
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
499
|
0
|
|
|
|
|
0
|
my %opts = @_; |
500
|
0
|
|
|
|
|
0
|
my @new_related_resources; |
501
|
0
|
0
|
|
|
|
0
|
if ($opts{new}) { |
502
|
0
|
|
|
|
|
0
|
@new_related_resources = @{$opts{new}}; |
|
0
|
|
|
|
|
0
|
|
503
|
|
|
|
|
|
|
} |
504
|
0
|
|
|
|
|
0
|
my @del_related_resources; |
505
|
0
|
0
|
|
|
|
0
|
if ($opts{del}) { |
506
|
0
|
|
|
|
|
0
|
@del_related_resources = @{$opts{del}}; |
|
0
|
|
|
|
|
0
|
|
507
|
|
|
|
|
|
|
} |
508
|
|
|
|
|
|
|
|
509
|
0
|
|
|
|
|
0
|
my $sort; |
510
|
0
|
0
|
|
|
|
0
|
if ($opts{'sort'}) { |
511
|
0
|
0
|
|
|
|
0
|
if ($opts{'sort'} eq 'name') { |
512
|
0
|
|
|
|
|
0
|
$sort = 'resource_name'; |
513
|
|
|
|
|
|
|
} |
514
|
|
|
|
|
|
|
} |
515
|
|
|
|
|
|
|
|
516
|
0
|
0
|
|
|
|
0
|
unless ($self->patron_id() =~ /^\d+$/) { |
517
|
0
|
|
|
|
|
0
|
croak "Patron id not found. Resource associations cannot be made with a patron object which is not initialized. Please run commit() against this patron object first."; |
518
|
|
|
|
|
|
|
} |
519
|
|
|
|
|
|
|
|
520
|
0
|
|
|
|
|
0
|
my $dbh = MyLibrary::DB->dbh(); |
521
|
|
|
|
|
|
|
|
522
|
0
|
|
|
|
|
0
|
my $strict_relations; |
523
|
0
|
0
|
|
|
|
0
|
if ($opts{strict}) { |
524
|
0
|
0
|
0
|
|
|
0
|
if ($opts{strict} == 1) { |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
525
|
0
|
|
|
|
|
0
|
$strict_relations = 'on'; |
526
|
|
|
|
|
|
|
} elsif ($opts{strict} == 0) { |
527
|
0
|
|
|
|
|
0
|
$strict_relations = 'off'; |
528
|
|
|
|
|
|
|
} elsif (($opts{strict} !~ /^\d$/ && ($opts{strict} == 1 || $opts{strict} == 0)) || $opts{strict} ne 'off' || $opts{strict} ne 'on') { |
529
|
0
|
|
|
|
|
0
|
$strict_relations = 'on'; |
530
|
|
|
|
|
|
|
} else { |
531
|
0
|
|
|
|
|
0
|
$strict_relations = $opts{strict}; |
532
|
|
|
|
|
|
|
} |
533
|
|
|
|
|
|
|
} else { |
534
|
0
|
|
|
|
|
0
|
$strict_relations = 'on'; |
535
|
|
|
|
|
|
|
} |
536
|
|
|
|
|
|
|
|
537
|
0
|
0
|
|
|
|
0
|
if (@new_related_resources) { |
538
|
0
|
|
|
|
|
0
|
RESOURCES: foreach my $new_related_resource (@new_related_resources) { |
539
|
|
|
|
|
|
|
|
540
|
0
|
0
|
|
|
|
0
|
if ($new_related_resource !~ /^\d+$/) { |
541
|
0
|
|
|
|
|
0
|
croak "Only numeric digits may be submitted as resource ids for resource relations. $new_related_resource submitted."; |
542
|
|
|
|
|
|
|
} |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
# check to make sure this resource exists |
545
|
0
|
0
|
|
|
|
0
|
if ($strict_relations eq 'on') { |
546
|
0
|
|
|
|
|
0
|
my @resource_array = $dbh->selectrow_array('SELECT * FROM resources WHERE resource_id = ?', undef, $new_related_resource); |
547
|
0
|
0
|
|
|
|
0
|
unless (scalar(@resource_array)) { |
548
|
0
|
|
|
|
|
0
|
next RESOURCES; |
549
|
|
|
|
|
|
|
} |
550
|
|
|
|
|
|
|
} |
551
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
# check to see if this resource already exists for the patron |
553
|
0
|
|
|
|
|
0
|
my @resource_association = $dbh->selectrow_array('SELECT * FROM patron_resource WHERE patron_id = ? AND resource_id = ? AND patron_owned = 1', undef, $self->patron_id(), $new_related_resource); |
554
|
0
|
0
|
|
|
|
0
|
if (scalar(@resource_association)) { |
555
|
0
|
|
|
|
|
0
|
next RESOURCES; |
556
|
|
|
|
|
|
|
} else { |
557
|
0
|
|
|
|
|
0
|
my $return = $dbh->do('INSERT INTO patron_resource (patron_id, resource_id, patron_owned) VALUES (?,?,?)', undef, $self->patron_id(), $new_related_resource, 1); |
558
|
0
|
0
|
0
|
|
|
0
|
if ($return > 1 || ! $return) {croak "Unable to create patron->resource association. $return rows were inserted.";} |
|
0
|
|
|
|
|
0
|
|
559
|
|
|
|
|
|
|
} |
560
|
|
|
|
|
|
|
} |
561
|
|
|
|
|
|
|
} |
562
|
|
|
|
|
|
|
|
563
|
0
|
0
|
|
|
|
0
|
if (@del_related_resources) { |
564
|
0
|
|
|
|
|
0
|
my $sth = $dbh->prepare('DELETE FROM patron_resource WHERE patron_id = ? and resource_id = ?'); |
565
|
0
|
|
|
|
|
0
|
foreach my $related_resource (@del_related_resources) { |
566
|
0
|
|
|
|
|
0
|
$sth->execute($self->patron_id(), $related_resource); |
567
|
|
|
|
|
|
|
} |
568
|
|
|
|
|
|
|
} |
569
|
|
|
|
|
|
|
|
570
|
0
|
|
|
|
|
0
|
my $related_resource_ids; |
571
|
0
|
0
|
|
|
|
0
|
if ($opts{'sort'}) { |
572
|
0
|
|
|
|
|
0
|
$related_resource_ids = $dbh->selectcol_arrayref("SELECT pr.resource_id FROM patron_resource pr, resources r WHERE pr.patron_id = ? AND pr.patron_owned = 1 AND pr.resource_id = r.resource_id ORDER BY r.$sort", undef, $self->patron_id()); |
573
|
|
|
|
|
|
|
} else { |
574
|
0
|
|
|
|
|
0
|
$related_resource_ids = $dbh->selectcol_arrayref('SELECT resource_id FROM patron_resource WHERE patron_id = ? AND patron_owned = 1', undef, $self->patron_id()); |
575
|
|
|
|
|
|
|
} |
576
|
|
|
|
|
|
|
|
577
|
0
|
|
|
|
|
0
|
return @{$related_resource_ids}; |
|
0
|
|
|
|
|
0
|
|
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
} |
580
|
|
|
|
|
|
|
|
581
|
|
|
|
|
|
|
sub add_link { |
582
|
|
|
|
|
|
|
|
583
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
584
|
0
|
|
|
|
|
0
|
my %opts = @_; |
585
|
0
|
0
|
0
|
|
|
0
|
unless ($opts{link_name} && $opts{link_url}) { |
586
|
0
|
|
|
|
|
0
|
croak ("Missing parameter for add_link(). Both a link name and link url must be submitted."); |
587
|
|
|
|
|
|
|
} |
588
|
|
|
|
|
|
|
|
589
|
0
|
|
|
|
|
0
|
my $new_link = MyLibrary::Patron::Links->new(); |
590
|
0
|
|
|
|
|
0
|
$new_link->link_name($opts{link_name}); |
591
|
0
|
|
|
|
|
0
|
$new_link->link_url($opts{link_url}); |
592
|
0
|
|
|
|
|
0
|
$new_link->patron_id($self->patron_id()); |
593
|
0
|
|
|
|
|
0
|
$new_link->commit(); |
594
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
} |
596
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
sub delete_link { |
598
|
|
|
|
|
|
|
|
599
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
600
|
0
|
|
|
|
|
0
|
my %opts = @_; |
601
|
0
|
0
|
|
|
|
0
|
unless ($opts{link_id}) { |
602
|
0
|
|
|
|
|
0
|
croak ("Missing parameter for delete_link(). A link id must be submitted."); |
603
|
|
|
|
|
|
|
} |
604
|
|
|
|
|
|
|
|
605
|
0
|
|
|
|
|
0
|
my $del_link = MyLibrary::Patron::Links->new(id => $opts{link_id}); |
606
|
0
|
|
|
|
|
0
|
my $return = $del_link->delete(); |
607
|
0
|
|
|
|
|
0
|
return $return; |
608
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
} |
610
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
sub get_links { |
612
|
|
|
|
|
|
|
|
613
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
614
|
0
|
|
|
|
|
0
|
my @link_ids = MyLibrary::Patron::Links->get_links(patron_id => $self->patron_id()); |
615
|
0
|
|
|
|
|
0
|
my @return_objects = (); |
616
|
0
|
|
|
|
|
0
|
foreach my $link_id (@link_ids) { |
617
|
0
|
|
|
|
|
0
|
my $link = MyLibrary::Patron::Links->new(id =>$link_id); |
618
|
0
|
|
|
|
|
0
|
push(@return_objects, $link); |
619
|
|
|
|
|
|
|
} |
620
|
|
|
|
|
|
|
|
621
|
0
|
0
|
|
|
|
0
|
if (scalar(@return_objects) >= 1) { |
622
|
0
|
|
|
|
|
0
|
return @return_objects; |
623
|
|
|
|
|
|
|
} else { |
624
|
0
|
|
|
|
|
0
|
return; |
625
|
|
|
|
|
|
|
} |
626
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
} |
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
sub patron_terms { |
630
|
|
|
|
|
|
|
|
631
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
632
|
0
|
|
|
|
|
0
|
my %opts = @_; |
633
|
0
|
|
|
|
|
0
|
my @new_related_terms; |
634
|
0
|
0
|
|
|
|
0
|
if ($opts{new}) { |
635
|
0
|
|
|
|
|
0
|
@new_related_terms = @{$opts{new}}; |
|
0
|
|
|
|
|
0
|
|
636
|
|
|
|
|
|
|
} |
637
|
0
|
|
|
|
|
0
|
my @del_related_terms; |
638
|
0
|
0
|
|
|
|
0
|
if ($opts{del}) { |
639
|
0
|
|
|
|
|
0
|
@del_related_terms = @{$opts{del}}; |
|
0
|
|
|
|
|
0
|
|
640
|
|
|
|
|
|
|
} |
641
|
|
|
|
|
|
|
|
642
|
0
|
|
|
|
|
0
|
my $sort; |
643
|
0
|
0
|
|
|
|
0
|
if ($opts{'sort'}) { |
644
|
0
|
0
|
|
|
|
0
|
if ($opts{'sort'} eq 'name') { |
645
|
0
|
|
|
|
|
0
|
$sort = 'term_name'; |
646
|
|
|
|
|
|
|
} |
647
|
|
|
|
|
|
|
} |
648
|
|
|
|
|
|
|
|
649
|
0
|
0
|
|
|
|
0
|
unless ($self->patron_id() =~ /^\d+$/) { |
650
|
0
|
|
|
|
|
0
|
croak "Patron id not found. Resource associations cannot be made with a patron object which is not initialized. Please run commit() against this patron object first."; |
651
|
|
|
|
|
|
|
} |
652
|
|
|
|
|
|
|
|
653
|
0
|
|
|
|
|
0
|
my $dbh = MyLibrary::DB->dbh(); |
654
|
|
|
|
|
|
|
|
655
|
0
|
|
|
|
|
0
|
my $strict_relations; |
656
|
0
|
0
|
|
|
|
0
|
if ($opts{strict}) { |
657
|
0
|
0
|
0
|
|
|
0
|
if ($opts{strict} == 1) { |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
658
|
0
|
|
|
|
|
0
|
$strict_relations = 'on'; |
659
|
|
|
|
|
|
|
} elsif ($opts{strict} == 0) { |
660
|
0
|
|
|
|
|
0
|
$strict_relations = 'off'; |
661
|
|
|
|
|
|
|
} elsif (($opts{strict} !~ /^\d$/ && ($opts{strict} == 1 || $opts{strict} == 0)) || $opts{strict} ne 'off' || $opts{strict} ne 'on') { |
662
|
0
|
|
|
|
|
0
|
$strict_relations = 'on'; |
663
|
|
|
|
|
|
|
} else { |
664
|
0
|
|
|
|
|
0
|
$strict_relations = $opts{strict}; |
665
|
|
|
|
|
|
|
} |
666
|
|
|
|
|
|
|
} else { |
667
|
0
|
|
|
|
|
0
|
$strict_relations = 'on'; |
668
|
|
|
|
|
|
|
} |
669
|
|
|
|
|
|
|
|
670
|
0
|
0
|
|
|
|
0
|
if (@new_related_terms) { |
671
|
0
|
|
|
|
|
0
|
TERMS: foreach my $new_related_term (@new_related_terms) { |
672
|
|
|
|
|
|
|
|
673
|
0
|
0
|
|
|
|
0
|
if ($new_related_term !~ /^\d+$/) { |
674
|
0
|
|
|
|
|
0
|
croak "Only numeric digits may be submitted as term ids for term relations. $new_related_term submitted."; |
675
|
|
|
|
|
|
|
} |
676
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
# check to make sure this term exists |
678
|
0
|
0
|
|
|
|
0
|
if ($strict_relations eq 'on') { |
679
|
0
|
|
|
|
|
0
|
my @term_array = $dbh->selectrow_array('SELECT * FROM terms WHERE term_id = ?', undef, $new_related_term); |
680
|
0
|
0
|
|
|
|
0
|
unless (scalar(@term_array)) { |
681
|
0
|
|
|
|
|
0
|
next TERMS; |
682
|
|
|
|
|
|
|
} |
683
|
|
|
|
|
|
|
} |
684
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
# check to see if this term already exists for the patron |
686
|
0
|
|
|
|
|
0
|
my @term_association = $dbh->selectrow_array('SELECT * FROM patron_term WHERE patron_id = ? AND term_id = ?', undef, $self->patron_id(), $new_related_term); |
687
|
0
|
0
|
|
|
|
0
|
if (scalar(@term_association)) { |
688
|
0
|
|
|
|
|
0
|
next TERMS; |
689
|
|
|
|
|
|
|
} else { |
690
|
0
|
|
|
|
|
0
|
my $return = $dbh->do('INSERT INTO patron_term (patron_id, term_id) VALUES (?,?)', undef, $self->patron_id(), $new_related_term); |
691
|
0
|
0
|
0
|
|
|
0
|
if ($return > 1 || ! $return) {croak "Unable to create patron->term association. $return rows were inserted.";} |
|
0
|
|
|
|
|
0
|
|
692
|
|
|
|
|
|
|
} |
693
|
|
|
|
|
|
|
} |
694
|
|
|
|
|
|
|
} |
695
|
|
|
|
|
|
|
|
696
|
0
|
0
|
|
|
|
0
|
if (@del_related_terms) { |
697
|
0
|
|
|
|
|
0
|
my $sth = $dbh->prepare('DELETE FROM patron_term WHERE patron_id = ? and term_id = ?'); |
698
|
0
|
|
|
|
|
0
|
foreach my $related_term (@del_related_terms) { |
699
|
0
|
|
|
|
|
0
|
$sth->execute($self->patron_id(), $related_term); |
700
|
|
|
|
|
|
|
} |
701
|
|
|
|
|
|
|
} |
702
|
|
|
|
|
|
|
|
703
|
0
|
|
|
|
|
0
|
my $related_term_ids; |
704
|
0
|
0
|
|
|
|
0
|
if ($opts{'sort'}) { |
705
|
0
|
|
|
|
|
0
|
$related_term_ids = $dbh->selectcol_arrayref("SELECT pt.term_id FROM patron_term pt, terms t WHERE pt.patron_id = ? AND pt.term_id = t.term_id ORDER BY t.$sort", undef, $self->patron_id()); |
706
|
|
|
|
|
|
|
} else { |
707
|
0
|
|
|
|
|
0
|
$related_term_ids = $dbh->selectcol_arrayref('SELECT term_id FROM patron_term WHERE patron_id = ?', undef, $self->patron_id()); |
708
|
|
|
|
|
|
|
} |
709
|
|
|
|
|
|
|
|
710
|
0
|
|
|
|
|
0
|
return @{$related_term_ids}; |
|
0
|
|
|
|
|
0
|
|
711
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
} |
713
|
|
|
|
|
|
|
|
714
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
sub resource_usage { |
716
|
|
|
|
|
|
|
|
717
|
0
|
|
|
0
|
1
|
0
|
my $class = shift; |
718
|
0
|
|
|
|
|
0
|
my %opts = @_; |
719
|
|
|
|
|
|
|
|
720
|
0
|
|
|
|
|
0
|
my $dbh = MyLibrary::DB->dbh(); |
721
|
|
|
|
|
|
|
|
722
|
0
|
0
|
|
|
|
0
|
unless ($opts{action}) { |
723
|
0
|
|
|
|
|
0
|
croak "An action parameter must be submitted to this method. Valid action parameter types are increment, resource_usage_count, absolute_usage_count, patron_usage_count and patron_resource_count. Other parameters are also required depending on the action."; |
724
|
|
|
|
|
|
|
} |
725
|
|
|
|
|
|
|
|
726
|
0
|
|
|
|
|
0
|
my $strict_relations; |
727
|
0
|
0
|
|
|
|
0
|
if ($opts{strict}) { |
728
|
0
|
0
|
0
|
|
|
0
|
if ($opts{strict} == 1) { |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
729
|
0
|
|
|
|
|
0
|
$strict_relations = 'on'; |
730
|
|
|
|
|
|
|
} elsif ($opts{strict} == 0) { |
731
|
0
|
|
|
|
|
0
|
$strict_relations = 'off'; |
732
|
|
|
|
|
|
|
} elsif (($opts{strict} !~ /^\d$/ && ($opts{strict} == 1 || $opts{strict} == 0)) || $opts{strict} ne 'off' || $opts{strict} ne 'on') { |
733
|
0
|
|
|
|
|
0
|
$strict_relations = 'on'; |
734
|
|
|
|
|
|
|
} else { |
735
|
0
|
|
|
|
|
0
|
$strict_relations = $opts{strict}; |
736
|
|
|
|
|
|
|
} |
737
|
|
|
|
|
|
|
} else { |
738
|
0
|
|
|
|
|
0
|
$strict_relations = 'on'; |
739
|
|
|
|
|
|
|
} |
740
|
|
|
|
|
|
|
|
741
|
0
|
0
|
|
|
|
0
|
if ($opts{action} eq 'increment') { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
742
|
|
|
|
|
|
|
|
743
|
0
|
0
|
0
|
|
|
0
|
unless ($opts{patron} && $opts{patron}) { |
744
|
0
|
|
|
|
|
0
|
croak "A valid patron and resource id must be submitted in the patron parameter in order to perform this action. One of these parameters was not passed."; |
745
|
|
|
|
|
|
|
} |
746
|
|
|
|
|
|
|
|
747
|
0
|
0
|
|
|
|
0
|
if ($opts{patron} !~ /^\d+$/) { |
748
|
0
|
|
|
|
|
0
|
croak "A valid patron id must be submitted in the patron parameter in order to perform this action."; |
749
|
|
|
|
|
|
|
} |
750
|
|
|
|
|
|
|
|
751
|
0
|
0
|
|
|
|
0
|
if ($opts{resource} !~ /^\d+$/) { |
752
|
0
|
|
|
|
|
0
|
croak "A valid resource id must be submitted in the patron parameter in order to perform this action."; |
753
|
|
|
|
|
|
|
} |
754
|
|
|
|
|
|
|
|
755
|
0
|
|
|
|
|
0
|
my @current_count_array = $dbh->selectrow_array('SELECT usage_count FROM patron_resource WHERE patron_id = ? AND resource_id = ?', undef, $opts{patron}, $opts{resource}); |
756
|
0
|
|
|
|
|
0
|
my $current_count = $current_count_array[0]; |
757
|
0
|
|
|
|
|
0
|
my $count_increment = ++$current_count; |
758
|
0
|
|
|
|
|
0
|
my $return = $dbh->do('UPDATE patron_resource SET usage_count = ? WHERE patron_id = ? AND resource_id = ?', undef, $count_increment, $opts{patron}, $opts{resource}); |
759
|
0
|
0
|
0
|
|
|
0
|
if ($return > 1 || ! $return) { croak "Increment usage count failed for patron_id $opts{patron} and resource_id $opts{resource}." } |
|
0
|
|
|
|
|
0
|
|
760
|
|
|
|
|
|
|
|
761
|
|
|
|
|
|
|
# update patron 0 for absolute count |
762
|
0
|
|
|
|
|
0
|
my @zero_count_array = $dbh->selectrow_array('SELECT usage_count FROM patron_resource WHERE patron_id = ? AND resource_id = ?', undef, 0, $opts{resource}); |
763
|
0
|
|
|
|
|
0
|
my $zero_count = $zero_count_array[0]; |
764
|
0
|
0
|
|
|
|
0
|
if (! $zero_count) { |
765
|
0
|
|
|
|
|
0
|
$dbh->do('INSERT INTO patron_resource (patron_id, resource_id, usage_count) VALUES (?,?,1)', undef, 0, $opts{resource}); |
766
|
|
|
|
|
|
|
} else { |
767
|
0
|
|
|
|
|
0
|
my $new_count = ++$zero_count; |
768
|
0
|
|
|
|
|
0
|
my $return = $dbh->do('UPDATE patron_resource SET usage_count = ? WHERE patron_id = ? AND resource_id = ?', undef, $new_count, 0, $opts{resource}); |
769
|
0
|
0
|
0
|
|
|
0
|
if ($return > 1 || ! $return) { croak "Increment usage count failed for patron_id 0 and resource_id $opts{resource}."; } |
|
0
|
|
|
|
|
0
|
|
770
|
|
|
|
|
|
|
} |
771
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
} elsif ($opts{action} eq 'resource_usage_count') { |
774
|
|
|
|
|
|
|
|
775
|
0
|
0
|
0
|
|
|
0
|
unless ($opts{patron} && $opts{patron}) { |
776
|
0
|
|
|
|
|
0
|
croak "A valid patron and resource id must be submitted in the patron parameter in order to perform this action. One of these parameters was not passed."; |
777
|
|
|
|
|
|
|
} |
778
|
|
|
|
|
|
|
|
779
|
0
|
0
|
|
|
|
0
|
if ($opts{patron} !~ /^\d+$/) { |
780
|
0
|
|
|
|
|
0
|
croak "A valid patron id must be submitted in the patron parameter in order to perform this action."; |
781
|
|
|
|
|
|
|
} |
782
|
|
|
|
|
|
|
|
783
|
0
|
0
|
|
|
|
0
|
if ($opts{resource} !~ /^\d+$/) { |
784
|
0
|
|
|
|
|
0
|
croak "A valid resource id must be submitted in the patron parameter in order to perform this action."; |
785
|
|
|
|
|
|
|
} |
786
|
|
|
|
|
|
|
|
787
|
0
|
|
|
|
|
0
|
my @usage_count_array = $dbh->selectrow_array('SELECT usage_count FROM patron_resource WHERE patron_id = ? AND resource_id = ?', undef, $opts{patron}, $opts{resource}); |
788
|
0
|
|
|
|
|
0
|
my $usage_count = $usage_count_array[0]; |
789
|
|
|
|
|
|
|
|
790
|
0
|
|
|
|
|
0
|
return $usage_count; |
791
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
} elsif ($opts{action} eq 'absolute_usage_count') { |
793
|
|
|
|
|
|
|
|
794
|
0
|
0
|
|
|
|
0
|
if ($opts{resource} !~ /^\d+$/) { |
795
|
0
|
|
|
|
|
0
|
croak "A valid resource id must be submitted in the patron parameter in order to perform this action."; |
796
|
|
|
|
|
|
|
} |
797
|
|
|
|
|
|
|
|
798
|
0
|
|
|
|
|
0
|
my @absolute_count_array = $dbh->selectrow_array('SELECT usage_count FROM patron_resource WHERE patron_id = ? AND resource_id = ?', undef, 0, $opts{resource}); |
799
|
0
|
|
|
|
|
0
|
my $absolute_count = $absolute_count_array[0]; |
800
|
|
|
|
|
|
|
|
801
|
0
|
|
|
|
|
0
|
return $absolute_count; |
802
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
} elsif ($opts{action} eq 'patron_usage_count') { |
804
|
|
|
|
|
|
|
|
805
|
0
|
0
|
|
|
|
0
|
if ($opts{resource} !~ /^\d+$/) { |
806
|
0
|
|
|
|
|
0
|
croak "A valid resource id must be submitted in the patron parameter in order to perform this action."; |
807
|
|
|
|
|
|
|
} |
808
|
|
|
|
|
|
|
|
809
|
0
|
|
|
|
|
0
|
my $patron_usage_array = $dbh->selectcol_arrayref('SELECT patron_id FROM patron_resource WHERE resource_id = ? AND patron_id >= 1', undef, $opts{resource}); |
810
|
|
|
|
|
|
|
|
811
|
0
|
|
|
|
|
0
|
my $patron_usage_count = scalar(@{$patron_usage_array}); |
|
0
|
|
|
|
|
0
|
|
812
|
|
|
|
|
|
|
|
813
|
0
|
|
|
|
|
0
|
return $patron_usage_count; |
814
|
|
|
|
|
|
|
|
815
|
|
|
|
|
|
|
} elsif ($opts{action} eq 'patron_resource_count') { |
816
|
|
|
|
|
|
|
|
817
|
0
|
0
|
|
|
|
0
|
if ($opts{patron} !~ /^\d+$/) { |
818
|
0
|
|
|
|
|
0
|
croak "A valid patron id must be submitted in the patron parameter in order to perform this action."; |
819
|
|
|
|
|
|
|
} |
820
|
|
|
|
|
|
|
|
821
|
0
|
|
|
|
|
0
|
my $patron_resource_array = $dbh->selectcol_arrayref('SELECT resource_id FROM patron_resource WHERE patron_id = ? AND usage_count > 0', undef, $opts{patron}); |
822
|
|
|
|
|
|
|
|
823
|
0
|
|
|
|
|
0
|
my $patron_resource_count = scalar(@{$patron_resource_array}); |
|
0
|
|
|
|
|
0
|
|
824
|
|
|
|
|
|
|
|
825
|
0
|
|
|
|
|
0
|
return $patron_resource_count; |
826
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
} |
828
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
} |
830
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
|
832
|
|
|
|
|
|
|
sub delete { |
833
|
|
|
|
|
|
|
|
834
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
835
|
|
|
|
|
|
|
|
836
|
0
|
0
|
|
|
|
0
|
if ($self->patron_id()) { |
837
|
|
|
|
|
|
|
|
838
|
0
|
|
|
|
|
0
|
my $dbh = MyLibrary::DB->dbh(); |
839
|
0
|
|
|
|
|
0
|
my $rv = $dbh->do('DELETE FROM patrons WHERE patron_id = ?', undef, $self->{patron_id}); |
840
|
0
|
0
|
|
|
|
0
|
if ($rv != 1) {croak ("Deleted $rv records. Please check the patron_resource table for errors.");} |
|
0
|
|
|
|
|
0
|
|
841
|
|
|
|
|
|
|
# delete any resource associations |
842
|
0
|
|
|
|
|
0
|
$dbh->do('DELETE FROM patron_resource WHERE patron_id = ?', undef, $self->patron_id()); |
843
|
|
|
|
|
|
|
# delete any term associations |
844
|
0
|
|
|
|
|
0
|
$dbh->do('DELETE FROM patron_term WHERE patron_id = ?', undef, $self->patron_id()); |
845
|
0
|
|
|
|
|
0
|
return 1; |
846
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
} |
848
|
|
|
|
|
|
|
|
849
|
0
|
|
|
|
|
0
|
return 0; |
850
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
} |
852
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
|
854
|
|
|
|
|
|
|
sub get_patrons { |
855
|
|
|
|
|
|
|
|
856
|
0
|
|
|
0
|
1
|
0
|
my $class = shift; |
857
|
0
|
|
|
|
|
0
|
my @rv; |
858
|
|
|
|
|
|
|
|
859
|
0
|
|
|
|
|
0
|
my $dbh = MyLibrary::DB->dbh(); |
860
|
0
|
|
|
|
|
0
|
my $patron_ids = $dbh->selectcol_arrayref('SELECT patron_id FROM patrons'); |
861
|
|
|
|
|
|
|
|
862
|
0
|
|
|
|
|
0
|
foreach my $patron_id (@$patron_ids) { |
863
|
|
|
|
|
|
|
|
864
|
0
|
|
|
|
|
0
|
push (@rv, MyLibrary::Patron->new(id => $patron_id)); |
865
|
|
|
|
|
|
|
|
866
|
|
|
|
|
|
|
} |
867
|
|
|
|
|
|
|
|
868
|
0
|
|
|
|
|
0
|
return @rv; |
869
|
|
|
|
|
|
|
|
870
|
|
|
|
|
|
|
} |
871
|
|
|
|
|
|
|
|
872
|
|
|
|
|
|
|
sub _encrypt_password { |
873
|
|
|
|
|
|
|
|
874
|
1
|
|
|
1
|
|
1
|
my $self = shift; |
875
|
1
|
|
|
|
|
2
|
my $password = shift; |
876
|
1
|
50
|
|
|
|
4
|
if (defined $password) { |
877
|
1
|
|
|
|
|
2
|
my $salt = substr($password, 0, 2); |
878
|
1
|
|
|
|
|
587
|
my $crypted_pw = crypt($password, $salt); |
879
|
1
|
|
|
|
|
3
|
return $crypted_pw; |
880
|
|
|
|
|
|
|
} else { |
881
|
0
|
|
|
|
|
|
croak "Password not indicated for encryption.\n"; |
882
|
|
|
|
|
|
|
} |
883
|
|
|
|
|
|
|
|
884
|
|
|
|
|
|
|
} |
885
|
|
|
|
|
|
|
|
886
|
|
|
|
|
|
|
|
887
|
|
|
|
|
|
|
1; |