File Coverage

blib/lib/MyLibrary/Resource.pm
Criterion Covered Total %
statement 136 543 25.0
branch 57 306 18.6
condition 2 150 1.3
subroutine 34 49 69.3
pod 39 40 97.5
total 268 1088 24.6


line stmt bran cond sub pod time code
1             package MyLibrary::Resource;
2              
3 3     3   39964 use MyLibrary::DB;
  3         8  
  3         96  
4 3     3   17 use Carp qw(croak longmess);
  3         4  
  3         193  
5 3     3   16 use strict;
  3         5  
  3         96  
6 3     3   16 use vars '$AUTOLOAD';
  3         6  
  3         15176  
7              
8             =head1 NAME
9              
10             MyLibrary::Resource - A class for representing a MyLibrary resource
11              
12              
13             =head1 SYNOPSIS
14              
15             # require the necessary module
16             use MyLibrary::Resource;
17            
18             # create a new Resource object
19             my $resource = MyLibrary::Resource->new();
20            
21             # set attributes of the newly created object
22             $resource->contributor('The Whole Internet Community');
23             $resource->coverage('Items in the Catalogue date from 600 BC to the 1800\'s');
24             $resource->creator('Infomotions, Inc.');
25             $resource->date('2003-11-20');
26             $resource->fkey('0002345');
27             $resource->language('en');
28             $resource->lcd(0);
29             $resource->name('Alex Catalogue');
30             $resource->note('This is a list of public domain classic literature');
31             $resource->proxied(0);
32             $resource->publisher('Infomotions, Inc.');
33             $resource->qsearch_prefix('http://infomotions.com/alex?term=');
34             $resource->qsearch_suffix('sortby=10');
35             $resource->relation('http://www.promo.net/pg');
36             $resource->format('Computer File');
37             $resource->type('Organic Object');
38             $resource->subject('Japanese; Mankind;');
39             $resource->create_date('2005-08-01');
40             $resource->rights('Items in the Catalogue are in the public domain');
41             $resource->source('Materials of the Catalogue were gathered from all over the Internet.');
42             $resource->access_note('Freely available on the World Wide Web');
43             $resource->coverage_info('Aug. 1996-');
44             $resource->full_text(1);
45             $resource->reference_linking(1);
46              
47             # all appropriate object attribute can be changed to NULL values using the delete_* methods
48             $resource->delete_note();
49             $resource->delete_access_note();
50            
51             # save the data
52             $resource->commit();
53              
54             # delete a resource
55             $resource->delete();
56            
57             # get the id of this object
58             $id = $resource->id();
59            
60             # create a new object with a specific id
61             my $resource = MyLibrary::Resource->new(id => $id);
62              
63             # create a new object with a specific name
64             my $resource = MyLibrary::Resource->new(name => 'Web of Science');
65              
66             # create a new object with a specific fkey
67             my $resource = MyLibrary::Resource->new(fkey => '00123456');
68            
69             # get selected data from the object
70             my $name = $resource->name();
71             my $note = $resource->note();
72              
73             # add a location
74             $resource->add_location(location => 'http://mysite.com', location_type => $type_id, location_note => 'This is mysite.');
75              
76             # modify a location
77             $resource->modify_location($resource_location, resource_location => 'http://mysite2.com');
78             $resource->modify_location($resource_location, location_note => 'This is my other site');
79              
80             # get a specific location by id or location string
81             my $location = $resource->get_location(id => $id);
82             my $location = $resource->get_location(resource_location => $location_string);
83              
84             # delete a location
85             $resource->delete_location($resource_location);
86              
87             # get full array of related locations
88             my @resource_locations = $resource->resource_locations();
89              
90             # get array of all resources
91             @resource_objects = MyLibrary::Resource->get_resources();
92             @resource_objects = MyLibrary::Resource->get_resources(sort => 'name');
93              
94             # get an array of resource within certain criteria
95             @resource_objects = MyLibrary::Resource->get_resources(field => 'name', value => 'Web of science');
96              
97             # get array of specific list of sorted resources
98             @resource_objects = MyLibrary::Resource->get_resources(list => [@list_resource_ids], sort => 'name');
99             @resource_objects = MyLibrary::Resource->get_resources(list => [@list_resource_ids], sort => 'name', output => 'id');
100              
101             # get a list of resources by date
102             my @resources_by_date = MyLibrary::Resource->get_resources(field => 'date_range', value => '2005-08-15_2005-08-17');
103            
104             # get array of all resource ids
105             @resource_ids = MyLibrary::Resource->get_ids();
106              
107             # test for group membership based on term name
108             my $return = $resource->test_relation(term_name => 'Biology');
109              
110             # get array of all lcd resources
111             @lcd_resource_objects = MyLibrary::Resource->lcd_resources();
112              
113             # set new lcd resource flags
114             MyLibrary::Resource->lcd_resources(new => @lcd_resources);
115              
116             # turn off lcd resource flags
117             MyLibrary::Resource->lcd_resources(del => @lcd_resources);
118              
119             # return the appropriate quick search redirection string
120             my $qsearch_redirect = MyLibrary::Resource->qsearch_redirect(resource_id => $id, qsearch_arg => $qsearch_string);
121              
122             # get array of fkey tagged resources
123             @fkey_resources = MyLibrary::Resource->get_fkey();
124              
125             # get array of related term ids
126             my @related_terms = $resource->related_terms();
127              
128              
129             =head1 DESCRIPTION
130              
131             This class is used to represent a MyLibrary resource.
132              
133              
134             =head1 METHODS
135              
136              
137             =head2 new()
138              
139             This method creates a new resource object. Called with no input, this method returns a new, empty resource:
140              
141             # create empty resource
142             my $resource = MyLibrary::Resource->new();
143              
144             Called with an id, this method returns a resource object containing the information from the underlying database:
145              
146             # create a resource from the underlying database
147             my $resource = MyLibrary::Resource->new(id => 123);
148              
149             The method returns undef if the id is invalid. The method can also be used to create a new object of an existing resource by supplying either a name or fkey parameter to the method. For example:
150              
151             # create a resource using an fkey parameter
152             my $resource = MyLibrary::Resource->new(fkey => 12345);
153              
154             If name is passed as a parameter, the result returned will be based on the context in which the method was called. If called in a scalar context, the method will return the number of records found or undef if no records were found. If called in list context, and records are found, an array of resource objects will be returned.
155              
156             # number of records in database matching name criteria
157             my $number_resources = MyLibrary::Resource->new(name => 'My Resource');
158              
159             # array of records matching name criteria
160             my @resources = MyLibrary::Resource->new(name => 'My Resource');
161              
162              
163             =head2 name()
164              
165             This method gets and sets the name of a resource object. The values of name is intended to be analogous to the Dublin Core name element. To set the name attribute:
166              
167             # set the name of a resource
168             $resource->name('DAIAD Home Page');
169              
170             To get the value of the name, try:
171              
172             # get the name
173             my $name = $resource->name;
174            
175            
176             =head2 note()
177              
178             Sets and gets the note attribute of a resource object. To set the note's value, try:
179              
180             $resource->note('This is a simple note.');
181              
182             To get the value of the note attribute, do:
183              
184             my $note = $resource->note;
185              
186             The sorts of values intended to be stored in note attributes correspond to the sorts of values assigned to Dublin Core description elements.
187              
188            
189             =head2 access_note()
190              
191             The access_note method can be used either to retrieve or assign an access note to a resource:
192              
193             # set the access note value
194             $resource->access_note('Available to Notre Dame patrons only.');
195              
196             # get the access note value
197             my $access_note = $resource->access_note;
198              
199             =head2 coverage_info()
200              
201             The coverage_info method can be used either to retrieve or assign coverage info to a resource:
202              
203             # set the coverage info value
204             $resource->coverage_info('Feb. 1996 - Aug. 2001');
205              
206             # get the coverage info value
207             my $coverage_info = $resource->coverage_info;
208              
209             =head2 full_text()
210              
211             The full_text method can be used either to retrieve or assign a full text flag to a resource:
212              
213             # set the full text flag (on)
214             $resource->full_text(1); # the resource supports full text access
215              
216             # set the full text flag (off)
217             $resource->full_text(0); # the resource does not support full text access
218              
219             # get the full text flag value
220             my $full_text_flag = $resource->full_text;
221              
222             =head2 reference_linking()
223              
224             The reference_linking method can be used to retrieve or assign a reference linking flag to a resource. The reference
225             linking flag indicates whether the resource is listed in a find text aggregator such as SFX FindText. This flag can
226             then be used to inform the patron of this availability for the given institution.
227              
228             # set the reference linking flag (on)
229             $resource->reference_linking(1); # the resource is supported by a reference linker
230              
231             # set the reference linking flag (off)
232             $resource->reference_linking(0); # the resource is not supported by a reference linker
233              
234             # get the reference linking value
235             my $reference_linking_val = $resource->reference_linking;
236            
237             =head2 lcd()
238              
239             This method is used to set and get the "lowest common denominator" (LCD) value of a resource. LCD resources are resources intended for any audience, not necessarily discipline-specific audiences. Good candidates for LCD resources are generic dictionaries, encyclopedias, a library catalog, or multi-disciplinary bibliographic databases. LCD resoruces are useful to anybody.
240              
241             lcd attributes are Boolean in nature; valid values for lcd attributes are 0 and 1.
242              
243             To set a resource's lcd attribute:
244              
245             $resource->lcd(1); # is an LCD resource
246             $resource->lcd(0); # is not an LCD resource
247              
248             To get the lcd resource:
249              
250             $lcd = $resource->lcd;
251              
252             This method will "croak" if there is an attempt to set the value of lcd to something other than 0 or 1.
253              
254              
255             =head2 fkey()
256              
257             Gets and sets the fkey value of a resource. Fkey's are "foreign keys" and intended to be the unique value (database key) of a resource from a library catalog. The combination of this attribute and the MARION field of the preferences table should create a URL allowing the user to see the cataloging record of this resource.
258              
259             Setting and getting the fkey attribute works like this:
260              
261             # set the fkey
262             $resource->fkey('0002345');
263            
264             # getting the fkey
265             my $fkey = $resource->fkey;
266            
267              
268             =head2 qsearch_prefix() and qsearch_suffix()
269              
270             These methods set and get the prefix and suffix values for "Quick Searches".
271              
272             Quick Search resources result in an HTML form allowing the end-user to query a remote Internet database with one input box and one button. Quick Search resources are reverse-engineered HTML forms supporting the HTTP GET method. By analyzing the URL's of Internet searches it becomes apparent that the searches can be divided into three parts: the prefix, the query, and the suffix. For example, the prefix for a Google search looks like this:
273              
274             http://www.google.com/search?hl=en&ie=ISO-8859-1&q=
275              
276             A query might look like this:
277              
278             mylibrary
279              
280             The suffix might look like this:
281              
282             &btnG=Google+Search
283              
284             By concatonating these three part together a URL is formed. Once formed a Web browser (user agent in HTTP parlance) can be redirected to the newly formed URL and the search results can be displayed.
285              
286             The qsearch_prefix() and qsearch_suffix() methods are used set and get the prefixes and suffixes for Quick Searches, and they work just like the other methods:
287              
288             # set the prefix and suffix
289             $resource->qsearch_prefix('http://www.google.com/search?hl=en&ie=ISO-8859-1&q=');
290             $resource->qsearch_suffix('&btnG=Google+Search');
291            
292             # create a Quick Search URL by getting the prefixes and suffixes of a resource
293             my $query = 'mylibrary';
294             my $quick_search = $resource->qsearch_prefix . $query . $resource->qsearch_suffix;
295            
296              
297             =head2 date()
298              
299             Use this method to set and get the date attribute of a resource. This value is intended to correspond to the the Dublin Core date element and is used in the system as a date stamp representing when this resource was last edited thus facilitating a "What's new?" functionality. Date values are intended to be in a YYYY-MM-DD format.
300              
301             Setting and getting date attributes works like this:
302              
303             # set the date
304             $resource->date('2003-10-28');
305            
306             # get the date
307             my $date = $resource->date;
308            
309              
310             =head2 id()
311              
312             Use this method to get the ID (database key) of a resource. Once committed, a resource will have a database key, and you can read the value of this key with this method:
313              
314             # get the ID of a resource
315             my $id = $resource->id;
316              
317             It is not possible to set the value of the id attribute.
318              
319              
320             =head2 commit()
321              
322             Use this method to save a resource's attributes to the underlying database, like this:
323              
324             # save the resource
325             $resource->commit;
326              
327             If the resource already exists in the database (it has an id attribute), then this method will do an SQL UPDATE. If this is a new resource (no previously assigned id attribute), the method will do an SQL INSERT.
328              
329             =head2 delete_[attribute_name]()
330              
331             This is a generic object attribute method that can be used to apply NULL values to a given attribute such as name and access_note. However, the boolean attribute will be excluded from this method. Examples are given below:
332              
333             # delete note value
334             $resource->delete_note();
335              
336             # delete coverage value
337             $resource-> delete_coverage();
338              
339             =head2 delete()
340              
341             This method deletes a resource from the underlying database like this:
342              
343             # delete this resource
344             $resource->delete;
345              
346             Once called this method will do an SQL DELETE operation for the given resource denoted by its id attribute.
347              
348             =head2 get_resources()
349              
350             This method returns an array of resource objects or ids, specifically, an array of all the resources in the underlying database. Once called, the programmer is intended to sort, filter, and process the items in the array as they see fit. The return set from this method can either be an array of resource objects or ids as indicated by the 'output' parameter. This method does not require input:
351              
352             # get all the resources
353             my @all_resources = MyLibrary::Resource->get_resources(output => 'id');
354            
355             # process each resource
356             foreach my $r (@all_resources) {
357            
358             # check for resources from edu domains
359             # change this
360             if ($r->url =~ /edu/) {
361            
362             # print them
363             print $r->name . "\n"
364            
365             }
366            
367             }
368              
369             # sort retrieved list of resource objects by name
370             my @all_resources = MyLibrary::Resource->get_resources(sort => 'name');
371              
372             A defined list of resources may also be retrieved using this method, if the sum total of resources is not desired or required. The list parameter can be used to retrieve such a list. Simply enclose the list in a pair of brackets.
373              
374             # retrieve specific list of resources
375             my @specific_resources = MyLibrary::Resource->get_resources(list => [@resource_ids], output => 'object');
376              
377             Also, a certain field in the resource record can be queried to determine if a resource with the specified criteria exists in the data set. This parameter cannot be used with the 'list' parameter. However, use of the method in this way requires that both a 'field' parameter and a 'value' parameter be supplied. If the correct combination of parameters is not supplied, incorrectly used parameters will simply be ignored. Example:
378              
379             # retrieve a list of resources matching title criteria
380             my @criteria_specific_resources = MyLibrary::Resource->get_resources(field => 'name', value => 'Web of science');
381              
382             A set of resources can be retrieved within a specified date range as well. The field name must state 'date_range' and the value must be in the following format: YYYY-MM-DD_YYYY-MM-DD where the first date is the beginning date and the second the ending date for the range. The output type can be either resource objects or resource ids depending on what is indicated by the output parameter. The date in question is the date that the item was entered into MyLibrary. Example:
383              
384             # retrieve a few days worth of resources
385             my @resources_by_date = MyLibrary::Resource->get_resources(field => 'date_range', value => '2005-08-15_2005-08-17');
386              
387             =head2 lcd_resources()
388              
389             This class method will allow the retrieval of an array of recource objects which have been designated "lcd" or "lowest common denominator". These are resources that are useful to anyone in any discipline of study. The method will always return a list (an array) of object references corresponding to the appropriate category. This method is very similar to the get_resources() method.
390              
391             # get all lcd resources
392             @lcd_resources = MyLibrary::Resource->lcd_resources();
393              
394             The method may also be used to set or delete lcd_resource flags. The first parameter should indicate whether lcd resource flags are being switched to true ('new') or false ('del). The second parameter should be a list or array of resources upon which the indicated operation will be performed. As mentioned previously, a list of current lcd resources will be returned upon successful execution of the method.
395              
396             # add new lcd resource flags
397             MyLibrary::Resource->lcd_resources('new', @lcd_resources);
398              
399             # delete old lcd resource flags
400             MyLibrary::Resource->lcd_resources('del', @lcd_resources);
401              
402             If new flags are indicated which are already positive, they will simply be ignored. Flags set to be turned off which are not positive will not be modified. If a resource id is indicated which does not exist in the database, a fatal exception will be thrown in the calling application.
403              
404             =head2 qsearch_redirect()
405              
406             Quick Searches in MyLibrary are really a combination of four URL components. Thus, this class method will apply only to those resources that are related to a URL typed location. The three components of a quick search are: the search prefix, the search argument and if necessary, the search suffix. This method takes as an argument the resource id, and the argument to be used for the search. Each of these parameters is necessary or the method will return null.
407              
408             The string returned from this method should be used to redirect the brower using the string as the redirection URL.
409              
410             # return the appropriate quick search redirection string
411             my $qsearch_redirect = MyLibrary::Resource->qsearch_redirect(resource_id => $id, qsearch_arg => $qsearch_string);
412              
413             =head2 get_fkey()
414              
415             This class method will allow the retrieval of an array of lightweight objects with only two attributes: resource_id and fkey. The array will contain only those objects which correspond to resource records associated with an fkey (foreign database key). This array (or list) can then be used to process through the fkey resources by calling the class constructor and operating on the full resource objects or to otherwise process through the list of resource ids which are associated with an external system record. Unlike the lcd_resources() class mothod, these objects are lightweight for faster processing in deference to the latter processing option.
416              
417             This method cannot be used to set fkeys for specific resources, it can only be used to retrieve a list representing the current list of resources with fkeys.
418              
419             # get lightweight fkey resource objects
420             @fkey_resources = get_fkey();
421              
422             =head2 test_relation()
423              
424             This object method is used to quickly test whether a relation exists between the current resource and a term or facet identified either by the term/facet name or id number. It will always return a boolean value of either '0' (no relation exists) or '1' (relation exists). The method was designed so that group membership based upon a set of criteria can easily be determined. Multiple tests can be run to determine complex sets of criteria for group membership among a set of resources. Please note that only the first parameter submitted will be considered as test criteria.
425              
426             # test for group membership based on term_name
427             my $return = $resource->test_relation(term_name => 'Biology');
428              
429             # test for group membership based on term id
430             my $return = $resource->test_relation(term_id => 16);
431              
432             # test for group membership based on facet id
433             my $return = $resource->test_relation(facet_id => 13);
434              
435             =head2 related_terms()
436              
437             This object method will allow the retrieval, addition and deletion of term relations with a given resource object. The return set is always a list (or array) of term ids which are currently related to this resource. The list can then be used to retrieve the related terms or otherwise process through the list. No parameters are necessary in order to retrieve a list of related term ids, however, new relations can be created by supplying a list of resource ids using the 'new' parameter. If a term is already related to this resource, the supplied term id will simply be ignored. Upon a resource commit (e.g. resource->commit()), the new relations will be created. Also, the input must be in the form of numeric digits. Care must be taken because false relationships could be created.
438              
439             # get all related terms
440             my @related_terms = $resource->related_terms();
441              
442             # supply new related terms
443             $resource->related_terms(new => [10, 11, 12]);
444             or
445             my @new_related_terms = $resource->related_terms(new => [@new_terms]);
446              
447             The method will by default check to make sure that the new terms to which this resource should be related exist in the database. However, this may be switched off by supplying the strict => 'off' parameter. Changing this parameter to 'off' will switch off the default behavior and allow bogus term relations to be created.
448              
449             # supply new related terms with relational integrity switched off
450             $resource->related_terms(new => [10, 12, 14], strict => 'off');
451              
452             Terms which do not exist in the database will simply be rejected if strict relational integrity is turned on.
453              
454             The method can also be used to delete a relationship between a term and a resource. This can be accomplished by supplying a list of terms via the 'del' parameter. The methodology is the same as the 'new' parameter with the primary difference being that referential integrity will be assumed (for example, that the term being severed already exists in the database). This will not delete the term itself, it will simply delete the relationship between the current resource object and the list of terms supplied with the parameter.
455              
456             # sever the relationship between this resource and a list of term ids
457             $resource->related_terms(del => [10, 11, 12]);
458              
459             or
460              
461             $resource->related_terms(del => [@list_to_be_severed]);
462              
463             If the list includes terms to which the current resource is not related, those term ids will simply be ignored. Priority will be given to term associations added to the object; deletions will occur during the commit() after new associations have been created.
464              
465              
466             =head2 proxied()
467              
468             Gets and sets the value of the proxied attribute of a resource:
469              
470             # set the value of proxied
471             $resource->proxied(0); # not proxied
472             $resource->proxied(1); # is proxied
473            
474             # get the proxied attribute
475             my $proxied = $resource->proxied;
476              
477             If a particular resource is licensed, then user agents (Web browsers) usually need to go through a proxy server before accessing the resources. This attribute denotes whether or not a resource needs to be proxied. If true (1), then the resource's URL is intended to be prefixed with value of the proxy_prefix field in the preferences table. If false (0), then the URL is intended to stand on its own.
478              
479             This method will "croak" if the value passed to it is not 1 or 0.
480              
481              
482             =head2 creator()
483              
484             Use this method to set and get the creator of a resource. The creator attribute is intended to correspond to the Dublin Core creator element. The method works just like the note method:
485              
486             # set the creator value
487             $resource->creator('University Libraries of Notre Dame');
488            
489             # get the creator
490             my $creator = $resource->creator;
491            
492            
493             =head2 publisher()
494              
495             Use this method to set and get the publisher of a resource. The publisher attribute is intended to correspond to the Dublin Core publisher element. The method works just like the note method:
496              
497             # set the publisher value
498             $resource->publisher('O\'Reilly and Associates');
499            
500             # get the publisher
501             my $publisher = $resource->publisher;
502            
503            
504             =head2 contributor()
505              
506             Use this method to set and get the contributor of a resource. The contributor attribute is intended to correspond to the Dublin Core contributor element. The method works just like the note method:
507              
508             # set the contributor value
509             $resource->contributor('The Whole Internet');
510            
511             # get the contributor
512             my $contributor = $resource->contributor;
513            
514            
515             =head2 coverage()
516              
517             Use this method to set and get the coverage of a resource. The coverage attribute is intended to correspond to the Dublin Core coverage element. The method works just like the note method:
518              
519             # set the coverage value
520             $resource->coverage('Items in the Catalogue date from 600 BC to the 1800\'s.');
521            
522             # get the coverage
523             my $coverage = $resource->coverage;
524            
525            
526             =head2 rights()
527              
528             Use this method to set and get the rights of a resource. The rights attribute is intended to correspond to the Dublin Core rights element. The method works just like the note method:
529              
530             # set the rights value
531             $resource->rights('This item is in the public domain.');
532            
533             # get the rights
534             my $rights = $resource->rights;
535            
536            
537             =head2 language()
538              
539             Use this method to set and get the language of a resource. The language attribute is intended to correspond to the Dublin Core language element. The method works just like the note method:
540              
541             # set the language value
542             $resource->language('eng');
543            
544             # get the language
545             my $language = $resource->language;
546            
547            
548             =head2 source()
549              
550             Use this method to set and get the source of a resource. The source attribute is intended to correspond to the Dublin Core source element. The method works just like the note method:
551              
552             # set the source value
553             $resource->source('This items originated at Virginia Tech.');
554            
555             # get the source
556             my $source = $resource->source;
557            
558            
559             =head2 relation()
560              
561             Use this method to set and get the relation of a resource. The relation attribute is intended to correspond to the Dublin Core relation element. The method works just like the note method:
562              
563             # set the relation value
564             $resource->relation('http://www.promo.net/pg/');
565            
566             # get the relation
567             my $relation = $resource->relation;
568              
569             =head2 format()
570              
571             Use this method to set and get the format of a resource. The format attribute is intended to correspond to the Dublin Core format element. The method works just like the note method:
572              
573             # set format
574             $resource->format('Computer File');
575              
576             # get format
577             my $format = $resource->format();
578              
579             =head2 type()
580              
581             Use this method to set and get the type of a resource. The type attribute is intended to correspond to the Dublin Core type element. The method works just like the note method:
582              
583             # set type
584             $resource->type('Organic Object');
585              
586             # get type
587             my $type = $resource->type();
588              
589             =head2 subject()
590              
591             Use this method to set and get the subject of a resource. The subject attribute is intended to correspond to the Dublin Core subject element. If more than one DCMI subject is required to describe the resource, it is suggested that the programmer delimit subject values in this field according to a pre-arranged pattern. For example, a pipe symbol '|' could be used to delimit subject entries. The method works just like the note method:
592              
593             # set the subject
594             $resource->subject('Japanese; Mankind;');
595              
596             # get the subject entry
597             my $subject_string = $resource->subject();
598              
599             =head2 create_date()
600              
601             This method is intended as an accessor to the date attribute of a resource object, corresponding to the date on which the resource was created, written, composed, manufactured, etc. This date field should NOT be used to indicate when a resource was added to this instance of MyLibrary.
602              
603             # set the create date
604             $resource->create_date('2005-08-01');
605              
606             # get the create date
607             my $create_date = $resource->create_date();
608              
609             =head2 add_location()
610              
611             This method will add a location to the resource object using supplied parameters. Required parameters are 'location' and 'location_type'. 'location note' may also be supplied as an optional parameter. The 'location_type' supplied must be a location type id. This id may be obtained using the Resource/Location.pm methods or supplied from an interface. The type must pre-exist in the database for this parameter to be valid. 'location_note' may be any string, but is usually some descriptive text about the location which may later be used as the string for the active URL or pointer to the specified location. This method will check to make sure that the location entered is unique to this resource. This method will return a '1' if the record was added, a '2' if a record with a duplicate location for this resource was found and a '0' for an unspecified problem.
612              
613             # add a location to a resource
614             $resource->add_location(location => 'http://mysite.com', location_type => $location_type_id, location_note => 'This is my site.');
615            
616             =head2 delete_location()
617              
618             This object method will delete a location from the list of locations associated with a resource. The required parameter is the resource location object to be deleted.
619              
620             # delete a location from a resource
621             $resource->delete_location($resource_location);
622              
623             =head2 resource_locations()
624              
625             This object method will allow the retrieval of an array of location objects associated with this resource. The objects returned can then be operated on using any Resource/Location.pm object methods. For example, you could cycle through the list of objects to perform other operations on them such as appending a proxy prefix.
626              
627             # obtain a list of resource location objects
628             my @resource_locations = $resource->resource_locations();
629              
630             # cycle through list to process
631             foreach my $resource_location (@resource_locations) {
632             if ($resource_location->location() eq 'http://mysite.com') {
633             $resource->delete_location($resource_location->id());
634             }
635             }
636              
637             =head2 modify_location()
638              
639             This method takes two parameters. The first parameter is a valid location object to be updated. The second parameter is the name of the location attribute to change. The second input parameter can be one (and only one) of the following: 'resource_location' and 'location_note'. The location type cannot be changed using this method. It is suggested that if the type changes, the resource location be deleted and a new resource location created. A location type change seems like a rare possibility indeed. Only one location attribute can be changed at a time.
640              
641             # modify a related location
642             $resource->modify_location($resource_location, resource_location => 'http://mysite2.com');
643             $resource->modify_location($resource_location, location_note => 'This is my other note.');
644              
645             =head2 get_location()
646              
647             Use this method to retrieve a specific location object associated with the current resource. The method can accept one of two parameters: id and resource_location. 'id' is the resource location id (key) and 'resource_location' is the string that matches the location desired. After retrieval, all of the attribute methods found in MyLibrary::Resource::Location will be available to the object. Other Resource class methods associated with locations can also be used to manipulate the object.
648              
649             # retrieve a specific location
650             my $location = $resource->get_location(id => $id);
651             my $location = $resource->get_location(resource_location => $resource_location_string);
652              
653             =head1 SEE ALSO
654              
655             For more information, see the MyLibrary home page: http://dewey.library.nd.edu/mylibrary/.
656              
657             =head1 TODO
658              
659             --there needs to be better error checking and graceful returns when errors are encountered.
660             --patron resource relational integrity needs to be addressed
661             --methods created to accomodate the 'Reviews' module
662              
663             =head1 HISTORY
664              
665             First public release, October 28, 2003.
666              
667             =head1 AUTHORS
668              
669             Robert Fox
670             Eric Lease Morgan
671              
672              
673             =cut
674              
675              
676             sub new {
677              
678             # declare local variables
679 1     1 1 875 my ($class, %opts) = @_;
680 1         3 my $self = {};
681              
682             # check for an id
683 1 50       13 if ($opts{id}) {
    50          
    50          
684            
685             # get a handle
686 0         0 my $dbh = MyLibrary::DB->dbh();
687            
688             # find this record
689 0         0 my $rv = $dbh->selectrow_hashref('SELECT * FROM resources WHERE resource_id = ?', undef, $opts{id});
690            
691             # check for success
692 0 0       0 if (ref($rv) eq "HASH") {
693 0         0 $self = $rv;
694 0         0 $self->{related_terms} = $dbh->selectall_arrayref('SELECT term_id FROM terms_resources WHERE resource_id = ?', undef, $opts{id});
695             } else {
696 0         0 return;
697             }
698            
699             } elsif ($opts{name}) {
700            
701             # get a handle
702 0         0 my $dbh = MyLibrary::DB->dbh();
703              
704             # find matching record(s)
705 0         0 my $rv = $dbh->selectall_hashref('SELECT * FROM resources WHERE resource_name = ?', 'resource_id', undef, $opts{name});
706              
707             # check for success
708 0 0       0 if (ref($rv) eq "HASH") {
709 0         0 my $num_records = keys %{$rv};
  0         0  
710 0 0       0 if (wantarray) {
711 0         0 my @return_records;
712 0         0 foreach my $resource_id (keys %{$rv}) {
  0         0  
713 0         0 my $resource = $rv->{$resource_id};
714 0         0 push(@return_records, bless($resource, $class));
715             }
716 0         0 return @return_records;
717             } else {
718 0         0 return $num_records;
719             }
720             #$self = $rv;
721             #$self->{related_terms} = $dbh->selectall_arrayref('SELECT term_id FROM terms_resources WHERE resource_id = ?', undef, $self->{resource_id});
722             } else {
723 0         0 return;
724             }
725              
726             } elsif ($opts{fkey}) {
727            
728             # get a handle
729 0         0 my $dbh = MyLibrary::DB->dbh();
730            
731             # find this record
732 0         0 my $rv = $dbh->selectrow_hashref('SELECT * FROM resources WHERE resource_fkey = ?', undef, $opts{fkey});
733              
734             # check for success
735 0 0       0 if (ref($rv) eq "HASH") {
736 0         0 $self = $rv;
737 0         0 $self->{related_terms} = $dbh->selectall_arrayref('SELECT term_id FROM terms_resources WHERE resource_id = ?', undef, $self->{resource_id});
738             } else {
739 0         0 return;
740             }
741              
742             }
743             # fill in the database defaults
744 1 50       4 if (! $self->{resource_lcd}) {
745 1         4 $self->{resource_lcd} = 0;
746             }
747 1 50       7 if ( ! $self->{resource_proxied}) {
748 1         4 $self->{resource_proxied} = 0;
749             }
750 1 50       3 if ( ! $self->{resource_full_text}) {
751 1         3 $self->{resource_full_text} = 0;
752             }
753 1 50       4 if ( ! $self->{resource_reference_linking}) {
754 1         3 $self->{resource_reference_linking} = 0;
755             }
756            
757             # return the object
758 1         4 return bless $self, $class;
759            
760             }
761              
762             sub AUTOLOAD {
763              
764             # added the following as per http://www.unix.org.ua/orelly/perl/prog3/ch12_05.htm --ELM
765 0 0   0   0 return if our $AUTOLOAD =~ /::DESTROY$/;
766              
767 0         0 my $self = shift;
768             # delete_[attribute] methods
769 0 0       0 $AUTOLOAD =~ /.*::delete_(\w+)/
770             or croak "No such method: $AUTOLOAD";
771 0 0       0 exists $self->{"resource_${1}"}
772             or croak "No such object attribute: $1";
773 0 0 0     0 unless ($1 eq 'name' || $1 eq 'lcd' || $1 eq 'proxied' || $1 eq 'full_text' || $1 eq 'reference_linking') {
774 0         0 $self->{"resource_${1}"} = undef;
775             } else {
776 0         0 croak "Illegal method call: $AUTOLOAD";
777             }
778              
779             }
780              
781             sub name {
782              
783 2     2 1 526 my ($self, $name) = @_;
784            
785 2 100       6 if ($name) { $self->{resource_name} = $name }
  1         7  
786 1         6 else { return $self->{resource_name} }
787            
788             }
789              
790              
791             sub note {
792              
793 2     2 1 4 my ($self, $note) = @_;
794            
795 2 100       6 if ($note) { $self->{resource_note} = $note }
  1         4  
796 1         6 else { return $self->{resource_note} }
797            
798             }
799              
800             sub creator {
801              
802 2     2 1 3 my ($self, $creator) = @_;
803            
804 2 100       7 if ($creator) { $self->{resource_creator} = $creator }
  1         3  
805 1         11 else { return $self->{resource_creator} }
806            
807             }
808              
809             sub publisher {
810              
811 2     2 1 5 my ($self, $publisher) = @_;
812            
813 2 100       7 if ($publisher) { $self->{resource_publisher} = $publisher }
  1         3  
814 1         4 else { return $self->{resource_publisher} }
815            
816             }
817              
818              
819             sub contributor {
820              
821 2     2 1 4 my ($self, $contributor) = @_;
822            
823 2 100       6 if ($contributor) { $self->{resource_contributor} = $contributor }
  1         4  
824 1         5 else { return $self->{resource_contributor} }
825            
826             }
827              
828             sub coverage {
829              
830 2     2 1 5 my ($self, $coverage) = @_;
831            
832 2 100       7 if ($coverage) { $self->{resource_coverage} = $coverage }
  1         4  
833 1         6 else { return $self->{resource_coverage} }
834            
835             }
836              
837             sub language {
838              
839 2     2 1 4 my ($self, $language) = @_;
840            
841 2 100       7 if ($language) { $self->{resource_language} = $language }
  1         5  
842 1         5 else { return $self->{resource_language} }
843            
844             }
845              
846              
847             sub rights {
848              
849 2     2 1 4 my ($self, $rights) = @_;
850            
851 2 100       6 if ($rights) { $self->{resource_rights} = $rights }
  1         3  
852 1         5 else { return $self->{resource_rights} }
853            
854             }
855              
856             sub source {
857              
858 2     2 1 4 my ($self, $source) = @_;
859            
860 2 100       5 if ($source) { $self->{resource_source} = $source }
  1         3  
861 1         5 else { return $self->{resource_source} }
862            
863             }
864              
865              
866             sub relation {
867              
868 2     2 1 5 my ($self, $relation) = @_;
869            
870 2 100       6 if ($relation) { $self->{resource_relation} = $relation }
  1         3  
871 1         5 else { return $self->{resource_relation} }
872            
873             }
874              
875             sub format {
876              
877 2     2 1 4 my ($self, $format) = @_;
878              
879 2 100       8 if ($format) { $self->{resource_format} = $format }
  1         4  
880 1         5 else { return $self->{resource_format} }
881              
882             }
883              
884             sub type {
885              
886 2     2 1 5 my ($self, $type) = @_;
887              
888 2 100       7 if ($type) { $self->{resource_type} = $type }
  1         4  
889 1         5 else { return $self->{resource_type} }
890              
891             }
892              
893             sub subject {
894              
895 2     2 1 4 my ($self, $subject) = @_;
896              
897 2 100       7 if ($subject) { $self->{resource_subject} = $subject }
  1         4  
898 1         5 else { return $self->{resource_subject} }
899              
900             }
901              
902             sub create_date {
903              
904 2     2 1 5 my ($self, $create_date) = @_;
905              
906 2 100       6 if ($create_date) { $self->{resource_create_date} = $create_date }
  1         3  
907 1         4 else { return $self->{resource_create_date} }
908              
909             }
910              
911              
912             sub lcd {
913              
914 2     2 1 4 my ($self, $lcd) = @_;
915            
916 2 100 33     47 if ( ! $lcd) {
    50          
917 1         6777 return $self->{resource_lcd};
918             } elsif ($lcd eq '1' || $lcd eq '0') {
919 1         4 $self->{resource_lcd} = $lcd;
920 1         3 return $self->{resource_lcd}; # operation successful
921             } else {
922 0         0 croak("Invalid value for lcd: $lcd. Valid values are 1 and 0.");
923             }
924            
925             }
926              
927             sub access_note {
928              
929 2     2 1 4 my ($self, $access_note) = @_;
930              
931 2 100       10 if ( ! $access_note) {
    50          
932 1         6 return $self->{resource_access_note};
933             } elsif ($access_note) {
934 1         3 $self->{resource_access_note} = $access_note;
935 1         3 return $self->{resource_access_note}; # operation successful
936             }
937             }
938              
939             sub coverage_info {
940              
941 2     2 1 4 my ($self, $coverage_info) = @_;
942              
943 2 100       10 if (! $coverage_info) {
    50          
944 1         5 return $self->{resource_coverage_info};
945             } elsif ($coverage_info) {
946 1         3 $self->{resource_coverage_info} = $coverage_info;
947 1         3 return $self->{resource_coverage_info}; # operation successful
948             }
949             }
950              
951             sub full_text {
952              
953 2     2 1 4 my ($self, $full_text) = @_;
954              
955 2 100 33     10 if ( ! $full_text) {
    50          
956 1         5 return $self->{resource_full_text};
957             } elsif ($full_text eq '1' || $full_text eq '0') {
958 1         3 $self->{resource_full_text} = $full_text;
959 1         3 return $self->{resource_full_text}; # operation successful
960             } else {
961 0         0 croak("Invalid value for full_text: $full_text. Valid values are 1 and 0.");
962             }
963             }
964              
965             sub reference_linking {
966              
967 2     2 1 4 my ($self, $reference_linking) = @_;
968              
969 2 50 0     5 if (! $reference_linking) {
    0          
970 2         8 return $self->{resource_reference_linking};
971             } elsif ($reference_linking eq '1' || $reference_linking eq '0') {
972 0         0 $self->{resource_reference_linking} = $reference_linking;
973 0         0 return $self->{resource_reference_linking}; # operation successful
974             } else {
975 0         0 croak("Invalid value for reference_linking: $reference_linking. Valid values are 1 and 0.");
976             }
977             }
978              
979             sub proxied {
980              
981 2     2 1 4 my ($self, $proxied) = @_;
982            
983 2 50 0     70 if (! $proxied) { } # do nothing
    0          
984 0         0 elsif ($proxied eq '1' || $proxied eq '0') { $self->{resource_proxied} = $proxied }
985 0         0 else { croak("Invalid value for proxied: $proxied. Valid values are 1 and 0.") }
986            
987 2         78 return $self->{resource_proxied};
988            
989             }
990              
991              
992             sub fkey {
993              
994 2     2 1 5 my ($self, $fkey) = @_;
995            
996 2 100       6 if ($fkey) { $self->{resource_fkey} = $fkey }
  1         6  
997 1         6 else { return $self->{resource_fkey} }
998            
999             }
1000              
1001              
1002             sub qsearch_prefix {
1003              
1004 2     2 1 4 my ($self, $qsearch_prefix) = @_;
1005            
1006 2 100       5 if ($qsearch_prefix) { $self->{qsearch_prefix} = $qsearch_prefix }
  1         5  
1007 1         5 else { return $self->{qsearch_prefix} }
1008            
1009             }
1010              
1011              
1012             sub qsearch_suffix {
1013              
1014 2     2 1 4 my ($self, $qsearch_suffix) = @_;
1015            
1016 2 100       6 if ($qsearch_suffix) { $self->{qsearch_suffix} = $qsearch_suffix }
  1         5  
1017 1         5 else { return $self->{qsearch_suffix} }
1018            
1019             }
1020              
1021              
1022             sub date {
1023              
1024 2     2 1 5 my ($self, $date) = @_;
1025            
1026 2 100       10 if ($date) { $self->{resource_date} = $date }
  1         5  
1027 1         6 else { return $self->{resource_date} }
1028            
1029             }
1030              
1031              
1032             sub id {
1033              
1034 0     0 1 0 my $self = shift;
1035            
1036 0         0 return $self->{resource_id};
1037            
1038             }
1039              
1040              
1041             sub commit {
1042              
1043             # get myself, :-)
1044 1     1 1 2 my $self = shift;
1045            
1046             # get a database handle
1047 1         9 my $dbh = MyLibrary::DB->dbh();
1048            
1049             # see if the object has an id
1050 0 0 0       if ($self->id() && scalar($dbh->selectrow_array('SELECT resource_id FROM resources WHERE resource_id = ?', undef, $self->id())) >= 1) {
1051            
1052             # update the record with this id
1053 0           my $return = $dbh->do('UPDATE resources SET resource_name = ?, resource_note = ?, resource_lcd = ?, resource_fkey = ?, resource_date = ?, qsearch_prefix = ?, qsearch_suffix = ?, resource_proxied = ?, resource_creator = ?, resource_publisher = ?, resource_contributor = ?, resource_coverage = ?, resource_rights = ?, resource_language = ?, resource_source = ?, resource_relation = ?, resource_format = ?, resource_type = ?, resource_subject = ?, resource_create_date = ?, resource_access_note = ?, resource_coverage_info = ?, resource_full_text = ?, resource_reference_linking = ? WHERE resource_id = ?', undef, $self->name(), $self->note(), $self->lcd(), $self->fkey(), $self->date(), $self->qsearch_prefix(), $self->qsearch_suffix(), $self->proxied(), $self->creator(), $self->publisher(), $self->contributor(), $self->coverage(), $self->rights(), $self->language(), $self->source(), $self->relation(), $self->format(), $self->type(), $self->subject(), $self->create_date(), $self->access_note(), $self->coverage_info(), $self->full_text(), $self->reference_linking(), $self->id());
1054 0 0 0       if ($return > 1 || ! $return) { croak "Resources update in commit() failed. $return records were updated." }
  0            
1055             # update resource=>term relational integrity
1056 0           my @related_terms = $self->related_terms();
1057 0 0 0       if (scalar(@related_terms) > 0 && @related_terms) {
1058 0           my $arr_ref = $dbh->selectall_arrayref('SELECT term_id FROM terms_resources WHERE resource_id =?', undef, $self->id());
1059             # determine which resources stay put
1060 0 0         if (scalar(@{$arr_ref}) > 0) {
  0            
1061 0           foreach my $arr_val (@{$arr_ref}) {
  0            
1062 0           my $j = scalar(@related_terms);
1063 0           for (my $i = 0; $i < scalar(@related_terms); $i++) {
1064 0 0         if ($arr_val->[0] == $related_terms[$i]) {
1065 0           splice(@related_terms, $i, 1);
1066 0           $i = $j;
1067             }
1068             }
1069             }
1070             }
1071             # add the new associations
1072 0           foreach my $related_term (@related_terms) {
1073 0           my $return = $dbh->do('INSERT INTO terms_resources (resource_id, term_id) VALUES (?,?)', undef, $self->id(), $related_term);
1074 0 0 0       if ($return > 1 || ! $return) { croak "Unable to update resource=>term relational integrity. $return rows were inserted." }
  0            
1075             }
1076             # determine which term associations to delete
1077 0           my @del_related_terms;
1078 0           my @related_terms = $self->related_terms();
1079 0 0         if (scalar(@{$arr_ref}) > 0) {
  0            
1080 0           foreach my $arr_val (@{$arr_ref}) {
  0            
1081 0           my $found;
1082 0           for (my $i = 0; $i < scalar(@related_terms); $i++) {
1083 0 0         if ($arr_val->[0] == $related_terms[$i]) {
1084 0           $found = 1;
1085 0           last;
1086             } else {
1087 0           $found = 0;
1088             }
1089             }
1090 0 0         if (!$found) {
1091 0           push (@del_related_terms, $arr_val->[0]);
1092             }
1093             }
1094             }
1095             # delete removed associations
1096 0           foreach my $del_rel_term (@del_related_terms) {
1097 0           my $return = $dbh->do('DELETE FROM terms_resources WHERE resource_id = ? AND term_id = ?', undef, $self->id(), $del_rel_term);
1098 0 0 0       if ($return > 1 || ! $return) { croak "Unable to delete resource=>term association. $return rows were deleted." }
  0            
1099 0           $return = $dbh->do('DELETE FROM suggestedResources WHERE resource_id = ? AND term_id = ?', undef, $self->id(), $del_rel_term);
1100             }
1101             }
1102            
1103             } else {
1104            
1105             # get a new sequence if necessary
1106 0           my $id;
1107 0 0         unless ($self->id()) {
1108 0           $id = MyLibrary::DB->nextID();
1109             } else {
1110 0           $id = $self->id();
1111             }
1112            
1113             # create a new record
1114 0           my $return = $dbh->do('INSERT INTO resources (resource_id, resource_name, resource_note, resource_lcd, resource_fkey, resource_date, qsearch_prefix, qsearch_suffix, resource_proxied, resource_creator, resource_publisher, resource_contributor, resource_coverage, resource_rights, resource_language, resource_source, resource_relation, resource_format, resource_type, resource_subject, resource_create_date, resource_access_note, resource_coverage_info, resource_full_text, resource_reference_linking) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)', undef, $id, $self->name(), $self->note(), $self->lcd(), $self->fkey(), $self->date(), $self->qsearch_prefix(), $self->qsearch_suffix(), $self->proxied(), $self->creator(), $self->publisher(), $self->contributor(), $self->coverage(), $self->rights(), $self->language(), $self->source(), $self->relation(), $self->format(), $self->type(), $self->subject(), $self->create_date(), $self->access_note(), $self->coverage_info(), $self->full_text(), $self->reference_linking());
1115 0 0 0       if ($return > 1 || ! $return) { longmess 'Resources commit() failed.'; }
  0            
1116 0           $self->{resource_id} = $id;
1117             # update resource=>term relational integrity
1118 0           my @related_terms = $self->related_terms();
1119 0 0 0       if (scalar(@related_terms) > 0 && @related_terms) {
1120 0           foreach my $related_term (@related_terms) {
1121 0           my $return = $dbh->do('INSERT INTO terms_resources (resource_id, term_id) VALUES (?,?)', undef, $self->id(), $related_term);
1122 0 0 0       if ($return > 1 || ! $return) { croak "Unable to update resource=>term relational integrity. $return rows were inserted." }
  0            
1123             }
1124             }
1125             }
1126            
1127             # done
1128 0           return 1;
1129             }
1130              
1131              
1132             sub delete {
1133              
1134 0     0 1   my $self = shift;
1135              
1136 0 0         if ($self->{resource_id}) {
1137              
1138 0           my $dbh = MyLibrary::DB->dbh();
1139 0           my @resource_locations = $self->resource_locations();
1140 0           foreach my $resource_location (@resource_locations) {
1141 0           $resource_location->delete();
1142             }
1143 0           my $rv = $dbh->do('DELETE FROM resources WHERE resource_id = ?', undef, $self->{resource_id});
1144 0 0         if ($rv != 1) {croak ("Deleted $rv records. I'll bet this isn't what you wanted.");}
  0            
1145 0           $rv = $dbh->do('SELECT * FROM terms_resources WHERE resource_id = ?', undef, $self->{resource_id});
1146 0 0         if ($rv > 0) {
1147 0           $rv = $dbh->do('DELETE FROM terms_resources WHERE resource_id = ?', undef, $self->{resource_id});
1148 0 0 0       if ($rv < 1 || ! $rv) {croak ("Resource => Term associations could not be deleted. Referential integrity may be compromised.");}
  0            
1149             }
1150 0           $rv = $dbh->do('SELECT * FROM suggestedResources WHERE resource_id = ?', undef, $self->{resource_id});
1151 0 0         if ($rv > 0) {
1152 0           $rv = $dbh->do('DELETE FROM suggestedResources WHERE resource_id = ?', undef, $self->{resource_id});
1153 0 0 0       if ($rv < 1 || ! $rv) {croak ("Resource => Term associations could not be deleted. Referential integrity may be compromised.");}
  0            
1154             }
1155              
1156 0           $rv = $dbh->do('DELETE FROM patron_resource WHERE resource_id = ?', undef, $self->{resource_id});
1157              
1158 0           return 1;
1159              
1160             }
1161              
1162 0           return 0;
1163              
1164             }
1165              
1166              
1167             sub get_resources {
1168              
1169 0     0 1   my $self = shift;
1170 0           my %opts = @_;
1171 0           my ($sort, $field, $value, $query_field, $output);
1172 0           my @rv = ();
1173 0           my @list_ids;
1174 0 0         if (%opts) {
1175 0 0         if ($opts{'sort'}) {
1176 0           $sort = $opts{'sort'};
1177             }
1178 0 0 0       if ($opts{'list'} && !$opts{'field'}) {
1179 0           @list_ids = @{$opts{'list'}};
  0            
1180             }
1181 0 0 0       if ($opts{'field'} && $opts{'value'} && ! $opts{'list'}) {
      0        
1182 0           $field = $opts{'field'};
1183 0           $value = $opts{'value'};
1184 0 0         if ($field eq 'name') {
    0          
    0          
    0          
    0          
    0          
1185 0           $query_field = 'resource_name';
1186             } elsif ($field eq 'description') {
1187 0           $query_field = 'resource_note';
1188             } elsif ($field eq 'fkey') {
1189 0           $query_field = 'resource_fkey';
1190             } elsif ($field eq 'access_note') {
1191 0           $query_field = 'resource_access_note';
1192             } elsif ($field eq 'date_range') {
1193 0           $query_field = 'date_range';
1194             } elsif ($field eq 'creator') {
1195 0           $query_field = 'resource_creator';
1196             }
1197             }
1198 0 0         if ($opts{'output'}) {
1199 0           $output = $opts{'output'};
1200             }
1201             }
1202 0 0         if (!$output) {
1203 0           $output = 'object';
1204             }
1205 0           my $list_of_ids;
1206 0 0 0       if (@list_ids && scalar(@list_ids) >= 1) {
1207 0           foreach my $list_id (@list_ids) {
1208 0           $list_of_ids .= "$list_id, ";
1209             }
1210 0           chop($list_of_ids);
1211 0           chop($list_of_ids);
1212             }
1213            
1214             # create and execute a query
1215 0           my $dbh = MyLibrary::DB->dbh();
1216 0           my $resource_ids;
1217 0 0 0       if ( ! $sort && $list_of_ids ) { $resource_ids = $dbh->selectcol_arrayref("SELECT resource_id FROM resources WHERE resource_id IN ($list_of_ids)"); }
  0 0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
1218 0           elsif ( ! $sort ) { $resource_ids = $dbh->selectcol_arrayref('SELECT resource_id FROM resources'); }
1219 0           elsif ( $sort && $sort eq 'name' && ! $list_of_ids && ! $field && ! $value ) { $resource_ids = $dbh->selectcol_arrayref('SELECT resource_id FROM resources ORDER BY resource_name'); }
1220             elsif ( $sort && $sort eq 'name' && ! $list_of_ids && $field && $value ) {
1221            
1222 0 0         if ($field ne 'date_range') { $resource_ids = $dbh->selectcol_arrayref("SELECT resource_id FROM resources WHERE $query_field LIKE \'%$value%\' ORDER BY resource_name");}
  0 0          
1223             elsif ($field eq 'date_range') {
1224            
1225 0           $value =~ /(.+)?_(.+)/;
1226 0           my $date_1 = $1;
1227 0           my $date_2 = $2;
1228 0           $resource_ids = $dbh->selectcol_arrayref("SELECT resource_id FROM resources WHERE resource_date BETWEEN \'$date_1\' AND \'$date_2\'");
1229            
1230             }
1231            
1232             }
1233            
1234             elsif ( ! $sort && $sort eq 'name' && ! $list_of_ids && $field && $value ) {
1235            
1236 0 0         if ($field ne 'date_range') { $resource_ids = $dbh->selectcol_arrayref("SELECT resource_id FROM resources WHERE $query_field LIKE \'%$value%\'"); }
  0 0          
1237             elsif ($field eq 'date_range') {
1238            
1239 0           $value =~ /(.+)?_(.+)/;
1240 0           my $date_1 = $1;
1241 0           my $date_2 = $2;
1242 0           $resource_ids = $dbh->selectcol_arrayref("SELECT resource_id FROM resources WHERE resource_date BETWEEN \'$date_1\' AND \'$date_2\' ORDER BY resource_name");
1243            
1244             }
1245            
1246             }
1247            
1248 0           elsif ( $sort && $sort eq 'name' && $list_of_ids ) { $resource_ids = $dbh->selectcol_arrayref("SELECT resource_id FROM resources WHERE resource_id IN ($list_of_ids) ORDER BY resource_name"); }
1249 0           elsif ( $sort && $sort eq 'creator' && $list_of_ids ) { $resource_ids = $dbh->selectcol_arrayref("SELECT resource_id FROM resources WHERE resource_id IN ($list_of_ids) ORDER BY resource_creator"); }
1250              
1251             # determine type of output
1252 0 0         if ($output eq 'object') {
    0          
1253 0           foreach my $resource_id (@$resource_ids) {
1254 0           push (@rv, MyLibrary::Resource->new(id => $resource_id));
1255             }
1256             } elsif ($output eq 'id') {
1257 0           foreach my $resource_id (@$resource_ids) {
1258 0           push (@rv, $resource_id);
1259             }
1260             } else {
1261 0           foreach my $resource_id (@$resource_ids) {
1262 0           push (@rv, MyLibrary::Resource->new(id => $resource_id));
1263             }
1264             }
1265              
1266 0           return @rv;
1267             }
1268              
1269             sub get_ids {
1270 0     0 0   my $self = shift;
1271 0           my $dbh = MyLibrary::DB->dbh();
1272 0           my $resource_ids = $dbh->selectcol_arrayref('SELECT resource_id FROM resources');
1273 0           return @{$resource_ids};
  0            
1274             }
1275              
1276             sub lcd_resources {
1277              
1278 0     0 1   my $class = shift;
1279 0           my $first_parameter = shift;
1280 0           my @lcd_resources = @_;
1281 0           my @rv = ();
1282 0           my $dbh = MyLibrary::DB->dbh();
1283            
1284 0 0         if ($first_parameter) {
1285 0 0 0       if ($first_parameter ne 'new' && $first_parameter ne 'del') {
1286 0           croak ("Operation parameter supplied is not correct. Parameter \'$first_parameter\' was submitted.\n");
1287             }
1288 0 0 0       if (@lcd_resources && scalar(@lcd_resources) > 0) {
1289 0           my $resource_list = $dbh->selectcol_arrayref('SELECT resource_id FROM resources');
1290 0           my $found;
1291 0           foreach my $lcd_resource_id (@lcd_resources) {
1292 0 0         if ($lcd_resource_id !~ /^\d+$/) {
1293 0           croak ("Non number submitted as resource id.\n");
1294             }
1295 0           foreach my $resource_id (@$resource_list) {
1296 0 0         if ($lcd_resource_id == $resource_id) {
1297 0           $found = 1;
1298 0           last;
1299             } else {
1300 0           $found = 0;
1301             }
1302             }
1303 0 0         if (!$found) {
1304 0           croak ("Resource $lcd_resource_id not found in lcd_resources() method.\n");
1305             }
1306             }
1307             }
1308 0 0 0       if ($first_parameter eq 'new' && @lcd_resources) {
    0 0        
1309 0           foreach my $lcd_resource_id (@lcd_resources) {
1310 0           my $rv = $dbh->do('UPDATE resources SET resource_lcd = 1 WHERE resource_id = ?', undef, $lcd_resource_id);
1311 0 0 0       if ($rv > 1 || ! $rv) {
1312 0           croak ("Resources update in lcd_resources() failed. $rv records were updated.");
1313             }
1314             }
1315             } elsif ($first_parameter eq 'del' && @lcd_resources) {
1316 0           foreach my $lcd_resource_id (@lcd_resources) {
1317 0           my $rv = $dbh->do('UPDATE resources SET resource_lcd = 0 WHERE resource_id = ?', undef, $lcd_resource_id);
1318 0 0 0       if ($rv > 1 || ! $rv) {
1319 0           croak ("Resources update in lcd_resources() failed. $rv records were updated.");
1320             }
1321             }
1322             }
1323             }
1324              
1325 0           my $rows = $dbh->prepare('SELECT * FROM resources WHERE resource_lcd = 1 ORDER BY resource_name');
1326 0           $rows->execute();
1327              
1328             # build array
1329 0           while (my $row = $rows->fetchrow_hashref()) {
1330 0           push (@rv, bless ($row, 'MyLibrary::Resource'));
1331             }
1332              
1333 0           return @rv;
1334             }
1335              
1336             sub qsearch_redirect {
1337              
1338 0     0 1   my $class = shift;
1339 0           my %args = @_;
1340              
1341 0 0         unless ($args{'resource_id'}) {
1342 0           return;
1343             }
1344              
1345 0           my $resource = MyLibrary::Resource->new(id => $args{'resource_id'});
1346 0           my $q_prefix = $resource->qsearch_prefix();
1347 0           my $q_suffix = $resource->qsearch_suffix();
1348              
1349 0 0         unless ($q_prefix) {
1350 0           return;
1351             }
1352              
1353 0 0         unless ($args{'qsearch_arg'}) {
1354 0           return;
1355             }
1356              
1357 0           my $qsearch_arg = $args{'qsearch_arg'};
1358              
1359 0           my $return_string = $q_prefix . $qsearch_arg . $q_suffix;
1360              
1361 0           return $return_string;
1362             }
1363              
1364             sub get_fkey {
1365              
1366 0     0 1   my $class = shift;
1367 0           my @rv = ();
1368              
1369             # connect to database
1370 0           my $dbh = MyLibrary::DB->dbh();
1371 0           my $rows = $dbh->prepare('SELECT resource_id, resource_fkey FROM resources WHERE resource_fkey IS NOT NULL ORDER BY resource_id');
1372 0           $rows->execute();
1373              
1374             # build array
1375 0           while (my $row = $rows->fetchrow_hashref()) {
1376 0           push (@rv, bless($row, 'MyLibrary::Resource'));
1377             }
1378 0           return @rv;
1379             }
1380              
1381             sub test_relation {
1382              
1383 0     0 1   my $self = shift;
1384 0           my %opts = @_;
1385 0           my $rv = 0;
1386 3     3   2368 use MyLibrary::Term;
  3         10  
  3         113  
1387 3     3   2807 use MyLibrary::Facet;
  3         9  
  3         3164  
1388              
1389 0 0         if ($opts{'term_name'}) {
    0          
    0          
    0          
1390 0           my @term_ids = $self->related_terms();
1391 0           foreach my $term_id (@term_ids) {
1392 0           my $term = MyLibrary::Term->new(id => $term_id);
1393 0 0         if ($term->term_name() eq $opts{'term_name'}) {
1394 0           $rv = 1;
1395 0           last;
1396             }
1397             }
1398             } elsif ($opts{'term_id'}) {
1399 0           my @term_ids = $self->related_terms();
1400 0           foreach my $term_id (@term_ids) {
1401 0 0         if ($term_id == $opts{'term_id'}) {
1402 0           $rv = 1;
1403 0           last;
1404             }
1405             }
1406             } elsif ($opts{'facet_name'}) {
1407 0           my @term_ids = $self->related_terms();
1408 0           my $facet = MyLibrary::Facet->new(name => $opts{'facet_name'});
1409 0           my @related_term_ids = $facet->related_terms();
1410 0 0         if (!$facet) {
1411 0           return 0;
1412             }
1413 0           foreach my $term_id (@term_ids) {
1414 0           foreach my $facet_term_id (@related_term_ids) {
1415 0 0         if ($term_id == $facet_term_id) {
1416 0           $rv = 1;
1417 0           last;
1418             }
1419             }
1420 0 0         if ($rv) {
1421 0           last;
1422             }
1423             }
1424             } elsif ($opts{'facet_id'}) {
1425 0           my @term_ids = $self->related_terms();
1426 0           my $facet = MyLibrary::Facet->new(id => $opts{'facet_id'});
1427 0           my @related_term_ids = $facet->related_terms();
1428 0 0         if (!$facet) {
1429 0           return 0;
1430             }
1431 0           foreach my $term_id (@term_ids) {
1432 0           foreach my $facet_term_id (@related_term_ids) {
1433 0 0         if ($term_id == $facet_term_id) {
1434 0           $rv = 1;
1435 0           last;
1436             }
1437             }
1438 0 0         if ($rv) {
1439 0           last;
1440             }
1441             }
1442             }
1443 0           return $rv;
1444             }
1445              
1446             sub related_terms {
1447              
1448 0     0 1   my $self = shift;
1449 0           my %opts = @_;
1450 0           my @new_related_terms;
1451 0 0         if ($opts{new}) {
1452 0           @new_related_terms = @{$opts{new}};
  0            
1453             }
1454 0           my @del_related_terms;
1455 0 0         if ($opts{del}) {
1456 0           @del_related_terms = @{$opts{del}};
  0            
1457             }
1458 0           my @related_terms;
1459             my $strict_relations;
1460 0 0         if ($opts{strict}) {
1461 0 0 0       if ($opts{strict} == 1) {
    0 0        
    0 0        
      0        
1462 0           $strict_relations = 'on';
1463             } elsif ($opts{strict} == 0) {
1464 0           $strict_relations = 'off';
1465             } elsif (($opts{strict} !~ /^\d$/ && ($opts{strict} == 1 || $opts{strict} == 0)) || $opts{strict} ne 'off' || $opts{strict} ne 'on') {
1466 0           $strict_relations = 'on';
1467             } else {
1468 0           $strict_relations = $opts{strict};
1469             }
1470             } else {
1471 0           $strict_relations = 'on';
1472             }
1473 0 0         if (@new_related_terms) {
1474 0           TERMS: foreach my $new_related_term (@new_related_terms) {
1475 0 0         if ($new_related_term !~ /^\d+$/) {
1476 0           croak "Only numeric digits may be submitted as term ids for resource relations. $new_related_term submitted.";
1477             }
1478 0 0         if ($strict_relations eq 'on') {
1479 0           my $dbh = MyLibrary::DB->dbh();
1480 0           my $term_list = $dbh->selectcol_arrayref('SELECT term_id FROM terms');
1481 0           my $found_term;
1482 0           TERM_VAL: foreach my $term_list_val (@$term_list) {
1483 0 0         if ($term_list_val == $new_related_term) {
1484 0           $found_term = 1;
1485 0           last TERM_VAL;
1486             } else {
1487 0           $found_term = 0;
1488             }
1489             }
1490 0 0         if ($found_term == 0) {
1491 0           next TERMS;
1492             }
1493             }
1494 0           my $found = 0;
1495 0 0         if ($self->{related_terms}) {
1496 0           foreach my $related_term (@{$self->{related_terms}}) {
  0            
1497 0 0         if ($new_related_term == @$related_term[0]) {
1498 0           $found = 1;
1499             }
1500             }
1501             } else {
1502 0           $found = 0;
1503             }
1504 0 0         if ($found) {
1505 0           next TERMS;
1506             } else {
1507 0           my @related_term_num = ();
1508 0           my $related_term_num = \@related_term_num;
1509 0           $related_term_num->[0] = $new_related_term;
1510 0           push(@{$self->{related_terms}}, $related_term_num);
  0            
1511             }
1512             }
1513             }
1514 0 0         if (@del_related_terms) {
1515 0           foreach my $del_related_term (@del_related_terms) {
1516 0           my $j = scalar(@{$self->{related_terms}});
  0            
1517 0           for (my $i = 0; $i < scalar(@{$self->{related_terms}}); $i++) {
  0            
1518 0 0         if ($self->{related_terms}->[$i]->[0] == $del_related_term) {
1519 0           splice(@{$self->{related_terms}}, $i, 1);
  0            
1520 0           $i = $j;
1521             }
1522             }
1523             }
1524             }
1525            
1526 0           foreach my $related_term (@{$self->{related_terms}}) {
  0            
1527 0           push(@related_terms, $related_term->[0]);
1528             }
1529            
1530 0           return @related_terms;
1531             }
1532              
1533             sub add_location {
1534              
1535 0     0 1   my $self = shift;
1536 0           my %opts = @_;
1537 0 0         unless ($self->id()) {
1538 0           $self->{resource_id} = MyLibrary::DB->nextID();
1539             }
1540 0 0         if (!$opts{location}) {
1541 0           croak('add_location() requires location parameter input.');
1542             }
1543 0 0         if (!$opts{location_type}) {
1544 0           croak('add_location() requires location_type parameter input.');
1545             }
1546 3     3   1644 use MyLibrary::Resource::Location;
  3         6  
  3         1943  
1547 0           my @resource_locations = MyLibrary::Resource::Location->new(location => $opts{location});
1548 0           my $found = 0;
1549 0 0         if (scalar(@resource_locations) >= 1) {
1550 0           foreach my $location (@resource_locations) {
1551             # check to see if this is the correct location/resource_id combination
1552 0 0         if ($location->resource_id() == $self->id()) {
1553 0           $found = 1;
1554 0           last;
1555             }
1556             }
1557             }
1558 0 0         if ($found) {
1559 0           return 2;
1560             }
1561 0 0         unless ($found) {
1562            
1563 0           my $resource_location = MyLibrary::Resource::Location->new();
1564 0           $resource_location->location($opts{location});
1565 0           $resource_location->resource_location_type($opts{location_type});
1566 0 0         if ($opts{location_note}) {
1567 0           $resource_location->location_note($opts{location_note});
1568             }
1569 0           $resource_location->resource_id($self->id(), strict => 'off');
1570 0           $resource_location->commit();
1571 0           return 1;
1572             }
1573 0           return 0;
1574             }
1575              
1576             sub delete_location {
1577              
1578 0     0 1   my $self = shift;
1579 0           my $location_object = shift;
1580 0 0         if (ref($location_object) ne 'MyLibrary::Resource::Location') {
1581 0           croak('Location object not passed to delete_location() method.');
1582             }
1583 0           $location_object->delete();
1584 0           return 1;
1585              
1586             }
1587              
1588             sub modify_location {
1589              
1590 0     0 1   my $self = shift;
1591 0           my $location_object = shift;
1592 0           my %opts = @_;
1593 0 0         if (ref($location_object) ne 'MyLibrary::Resource::Location') {
1594 0           croak('Location object not passed to modify_location() method.');
1595             }
1596 0 0 0       if (!$opts{resource_location} && !$opts{location_note}) {
1597 0           croak('missing parameter for modify_location() method.');
1598             }
1599 0 0         if ($opts{resource_location}) {
1600 0           $location_object->location($opts{resource_location});
1601             }
1602 0 0 0       if ($opts{location_note}) {
    0          
1603 0           $location_object->location_note($opts{location_note});
1604             } elsif (!$opts{location_note} || $opts{location_note} =~ /^\s+$/) {
1605 0           $location_object->delete_location_note();
1606             }
1607 0           $location_object->commit();
1608 0           return 1;
1609              
1610             }
1611              
1612             sub get_location {
1613 0     0 1   my $self = shift;
1614 0           my %opts = @_;
1615 0 0 0       if (!$opts{resource_location} && !$opts{id}) {
    0 0        
1616 0           croak ('Necessary paramter missing in call to get_location() method.');
1617             } elsif ($opts{resource_location} && $opts{id}) {
1618 0           croak ('Too many parameters entered for get_location() method.');
1619             }
1620 0 0         if ($opts{id}) {
    0          
1621 0           my $location = MyLibrary::Resource::Location->new(id => $opts{id});
1622 0           return $location;
1623             } elsif ($opts{resource_location}) {
1624 0           my @locations = MyLibrary::Resource::Location->new(location => $opts{resource_location});
1625 0 0         if (scalar(@locations) >= 1) {
1626 0           foreach my $location (@locations) {
1627 0 0         if ($location->resource_id() == $self->id()) {
1628 0           return $location;
1629             }
1630             }
1631             } else {
1632 0           return 0;
1633             }
1634             }
1635              
1636             # non specific error
1637 0           return 0;
1638              
1639             }
1640              
1641             sub resource_locations {
1642              
1643 0     0 1   my $self = shift;
1644 3     3   29 use MyLibrary::Resource::Location;
  3         5  
  3         264  
1645 0 0         unless ($self->id() =~ /\d+/) {
1646 0           return;
1647             }
1648 0           my @resource_locations = MyLibrary::Resource::Location->get_locations(id => $self->id());
1649 0           return @resource_locations;
1650              
1651             }
1652              
1653              
1654             # return true
1655             1;