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; |