File Coverage

blib/lib/MyLibrary/Patron.pm
Criterion Covered Total %
statement 97 320 30.3
branch 39 174 22.4
condition 0 63 0.0
subroutine 25 34 73.5
pod 25 29 86.2
total 186 620 30.0


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;