1: #!/usr/local/bin/perl -w
2:
3: use strict;
4:
5: use Getopt::Std;
6:
7: use DBI;
8: use DBD::ODBC;
9:
10: my $DBI_DSN='dbi:ODBC:needs2.odbc';
11: my $DBI_USER='smete_user';
12: my $DBI_PWD='needsmete';
13: my $dbh;
14:
15: sub SP_ct_key {
16: my ($dbh,$name) = @_;
17: # Fetch the ct_key number from the contrib_type table
18: my @row_ary = $dbh->selectrow_array(q{SELECT c.ct_key FROM contrib_type c WHERE c.name = ?}, undef, $name);
19: my $ct_key = $row_ary[0];
20: # print $ct_key . "\n";
21: return $ct_key;
22: }
23:
24: # Find general_key given a title
25: # return undef if nothing found
26: # Usage: OAIc_loexists($dbh,$title)
27: sub OAIc_loexists {
28: my ($dbh, $title) = @_;
29: my @row_ary = $dbh->selectrow_array(q{SELECT lo.id FROM learning_object lo WHERE lo.title = ?}, undef, $title);
30: if ($row_ary[0]) {
31: return $row_ary[0];
32: } else {
33: return undef;
34: }
35: }
36:
37: # Generate a key given a field name
38: # e.g., my $key = &OAIc_key ($dbh,$field_name);
39: sub OAIc_key {
40: my ($dbh,$field_name) = @_;
41: # Fetch the current key number from the KEYS table
42: my @row_ary = $dbh->selectrow_array(q{SELECT k.key_value FROM keys k WHERE k.field_name = ?}, undef, $field_name);
43: # Increment the value by 1
44: my $key = $row_ary[0] + 1;
45: # print $key . "\n";
46: # Now update the table with the new value
47: my $rc = $dbh->do(q{UPDATE keys SET key_value = ?, mod_date=GetDate() FROM keys k WHERE k.field_name = ?}, undef, $key, $field_name) || warn "Unable to update key value in table keys: $dbh->errstr\n";
48: $dbh->commit;
49: return $key;
50: }
51:
52: # Generate a needs number "nn"
53: # e.g., my $nn = &OAIc_nn ( '2000', '01', 1000 );
54: sub OAIc_nn {
55: my ( $pubYear, $pubMonth, $lo_key ) = @_;
56: # Format lo_key to be 10 characters long
57: $lo_key = sprintf("%10d",$lo_key);
58: # Replace leading spaces with a 0
59: $lo_key =~ tr/ /0/;
60: my $nn = sprintf("%s_%s_%s", $pubYear, $pubMonth, $lo_key );
61: # print $nn . "\n";
62: return $nn;
63: }
64:
65: # Update MATTI (special to handle version.installation_note);
66: sub OAIc_update_matti {
67: my ($dbh, $id, $installation_note) = @_;
68: my $rc;
69: # UPDATE [needs_3_1]..version
70: printf("Update installation note for id = %s\n", $id);
71: $rc = $dbh->do(q{UPDATE version SET installation_note = ? WHERE resource_id = ?}, undef, substr($installation_note,0,1024), $id);
72: if (!$rc) {
73: $dbh->rollback;
74: $dbh->disconnect;
75: die "Unable to update record into lo_platform: $dbh->errstr\n";
76: }
77: }
78:
79: # Update lo into tables
80: sub OAIc_update_lo {
81: my ($dbh, $general_key, $title, $language, $description, $image, $pub_month, $pub_year, $keywords, $submitter_key, $author, $publisher, $collection, $format, $platform, $os, $url, $ped_lcontext, $ped_enduserrole, $author_reg_key, $publisher_reg_key) = @_;
82: my $rc;
83: # UPDATE [needs_3_1]..version
84: $rc = $dbh->do(q{UPDATE version SET media_format_id = ?, platform_type_id = ?, location_url = ?, operating_system = ?, modification_date = GetDate(), reporter_id = ? WHERE resource_id = ?}, undef, $format, $platform, $url, $os, $submitter_key, $general_key);
85: if (!$rc) {
86: $dbh->rollback;
87: $dbh->disconnect;
88: die "Unable to update record into lo_platform: $dbh->errstr\n";
89: }
90: # UPDATE [needs_3_1]..lo
91: $rc = $dbh->do(q{UPDATE lo SET title = ?, primary_language = ?, description = ?, keywords = ?, modification_date = GetDate(), publish_month = ?, publish_year = ? WHERE id = ?}, undef, $title, $language, substr($description,0,4096), $keywords, $pub_month, $pub_year, $general_key);
92: if (!$rc) {
93: die "Unable to update record into lo: $dbh->errstr\n";
94: $dbh->rollback;
95: $dbh->disconnect;
96: }
97: # UPDATE [needs_3_1]..learning_object_pedagogy
98: $rc = $dbh->do(q{UPDATE learning_object_pedagogy SET modification_date = GetDate() WHERE learning_object_id = ?}, undef, $general_key);
99: if (!$rc) {
100: die "Unable to update record into learning_object_pedagogy: $dbh->errstr\n";
101: $dbh->rollback;
102: $dbh->disconnect;
103: }
104: my @row_ary = $dbh->selectrow_array(q{SELECT lo.pedagogy_id FROM learning_object_pedagogy lo WHERE lo.learning_object_id = ?}, undef, $general_key);
105: my $pedagogy_id = $row_ary[0];
106: $rc = $dbh->do(q{UPDATE pedagogy SET learning_context = ?, end_user_type_id = ?, modification_date = GetDate() WHERE id = ?}, undef, $ped_lcontext, $ped_enduserrole, $general_key);
107: if (!$rc) {
108: $dbh->rollback;
109: $dbh->disconnect;
110: die "Unable to update record into pedagogy: $dbh->errstr\n";
111: }
112: # Upon success commit
113: $dbh->commit;
114: return $rc;
115: }
116:
117: # Insert lo into tables
118: sub OAIc_insert_lo {
119: my ($dbh, $title, $language, $description, $image, $pub_month, $pub_year, $keywords, $submitter_key, $author, $publisher, $collection, $format, $platform, $os, $url, $ped_lcontext, $ped_enduserrole, $author_reg_key, $publisher_reg_key, $collection_reg_key, $difficulty_id, $interactivity_level_id, $pedagogy_description, $resource_type_id,$rights_description,$cost) = @_;
120: my $rc;
121: # INSERT INTO [needs_3_1]..lo
122: $rc = $dbh->do(q{INSERT INTO learning_object (title, primary_language, description, keywords, creation_date, modification_date, publish_month, publish_year, submitter) VALUES (?,?,?,?,GetDate(),GetDate(),?,?,?)}, undef, $title, $language, substr($description,0,4096), $keywords, $pub_month, $pub_year, $submitter_key);
123: if (!$rc) {
124: $dbh->rollback;
125: $dbh->disconnect;
126: die "Unable to insert new record into lo: $dbh->errstr\n";
127: }
128: my $id = OAIc_loexists($dbh,$title);
129: printf("Learning Object ID:%s\n", $id);
130: printf("Author ID:%s\n", $author_reg_key);
131: # INSERT INTO [needs_3_1]..learning_object_contributor
132: # Add author contribution (ct_key=8)
133: $rc = $dbh->do(q{INSERT INTO learning_object_contributor (learning_object_id, entity_id, role_id, order_by) VALUES (?,?,8,1)}, undef, $id, $author_reg_key);
134: # Add publisher contribution (ct_key=9)
135: $rc = $dbh->do(q{INSERT INTO learning_object_contributor (learning_object_id, entity_id, role_id, order_by) VALUES (?,?,9,2)}, undef, $id, $publisher_reg_key);
136: # Add collection contribution (ct_key=12)
137: $rc = $dbh->do(q{INSERT INTO learning_object_contributor (learning_object_id, entity_id, role_id, order_by) VALUES (?,?,12,2)}, undef, $id, $collection_reg_key);
138: if (!$rc) {
139: $dbh->rollback;
140: $dbh->disconnect;
141: die "Unable to insert new record into learning_object_contributor: $dbh->errstr\n";
142: }
143: # INSERT INTO [needs_3_1]..pedagogy
144: my $pedagogy_id = $dbh->selectrow_array(q{SELECT NEWID()});
145: printf("Pedagogy ID:%s\n", $pedagogy_id);
146: if (!$pedagogy_id) {
147: $dbh->rollback;
148: $dbh->disconnect;
149: die "Unable to insert new record into pedagogy: $dbh->errstr\n";
150: }
151: $rc = $dbh->do(q{INSERT INTO pedagogy (id,description,difficulty_id,interactivity_level_id,learning_context,end_user_type_id,resource_type_id,locale_id) VALUES (?,?,?,?,?,?,?,1)}, undef, $pedagogy_id, $pedagogy_description, $difficulty_id, $interactivity_level_id, $ped_lcontext, $ped_enduserrole, $resource_type_id);
152: if (!$rc) {
153: $dbh->rollback;
154: $dbh->disconnect;
155: die "Unable to insert new record into pedagogy: $dbh->errstr\n";
156: }
157: # INSERT INTO [needs_v2_1]..learning_object_pedagogy
158: $rc = $dbh->do(q{INSERT INTO learning_object_pedagogy (learning_object_id,pedagogy_id,order_by,creation_date,modification_date,status) VALUES (?,?,?,GetDate(),GetDate(),?)}, undef, $id, $pedagogy_id, 1, 'complete');
159: if (!$rc) {
160: $dbh->rollback;
161: $dbh->disconnect;
162: die "Unable to insert new record into learning_object_pedagogy: $dbh->errstr\n";
163: }
164: # INSERT INTO [needs_v2_1]..version
165: $rc = $dbh->do(q{INSERT INTO version (resource_id, media_format_id, platform_type_id, location_url, license, purchase_license_type_id, modification_date, creation_date, reporter_id) VALUES (?,?,?,?,?,?,GetDate(),GetDate(),?)}, undef, $id, $format, $platform, $url, $rights_description, $cost, $submitter_key);
166: if (!$rc) {
167: $dbh->rollback;
168: $dbh->disconnect;
169: die "Unable to insert new record into version: $dbh->errstr\n";
170: }
171: # Upon success commit
172: $dbh->commit;
173: return $rc;
174: }
175:
176: # Insert lo into tables (DLESE only)
177: sub OAIc_insert_lo_dlese {
178: my ($dbh, $title, $language, $description, $image, $pub_month, $pub_year, $keywords, $submitter_key, $publisher, $collection, $format, $platform, $location, $learning_context, $intendedenduserrole_id, $collection_reg_key, $rights_description, $cost) = @_;
179: my $rc;
180: # INSERT INTO [needs_3_1]..lo
181: $rc = $dbh->do(q{INSERT INTO lo (title, primary_language, description, keywords, creation_date, modification_date, publish_month, publish_year, submitter) VALUES (?,?,?,?,GetDate(),GetDate(),?,?,?)}, undef, $title, $language, substr($description,0,4096), $keywords, $pub_month, $pub_year, $submitter_key);
182: if (!$rc) {
183: $dbh->rollback;
184: $dbh->disconnect;
185: die "Unable to insert new record into lo: $dbh->errstr\n";
186: }
187: my $id = OAIc_loexists($dbh,$title);
188: printf("Learning Object ID:%s\n", $id);
189:
190: # INSERT INTO [needs_3_1]..pedagogy
191: #my $pedagogy_id = $dbh->selectrow_array(q{SELECT NEWID()});
192: #printf("Pedagogy ID:%s\n", $pedagogy_id);
193: #if (!$pedagogy_id) {
194: # $dbh->rollback;
195: # $dbh->disconnect;
196: # die "Unable to insert new record into pedagogy: $dbh->errstr\n";
197: #}
198: #$rc = $dbh->do(q{INSERT INTO pedagogy (id,description,difficulty_id,interactivity_level_id,learning_context,end_user_type_id,resource_type_id,locale_id) VALUES (?,?,?,?,?,?,?,1)}, undef, $pedagogy_id, $pedagogy_description, $difficulty_id, $interactivity_level_id, $ped_lcontext, $ped_enduserrole, $resource_type_id);
199: #if (!$rc) {
200: #$dbh->rollback;
201: #$dbh->disconnect;
202: #die "Unable to insert new record into pedagogy: $dbh->errstr\n";
203: #}
204: # INSERT INTO [needs_v2_1]..learning_object_pedagogy
205: #$rc = $dbh->do(q{INSERT INTO learning_object_pedagogy (learning_object_id,pedagogy_id,order_by,creation_date,modification_date,status) VALUES (?,?,?,GetDate(),GetDate(),?)}, undef, $id, $pedagogy_id, 1, 'complete');
206: #if (!$rc) {
207: #$dbh->rollback;
208: #$dbh->disconnect;
209: #die "Unable to insert new record into learning_object_pedagogy: $dbh->errstr\n";
210: #}
211: # INSERT INTO [needs_v2_1]..version
212: $rc = $dbh->do(q{INSERT INTO version (resource_id, media_format_id, platform_type_id, location_url, license, purchase_license_type_id, modification_date, creation_date, reporter_id) VALUES (?,?,?,?,?,?,GetDate(),GetDate(),?)}, undef, $id, $format, $platform, $location, $rights_description, $cost, $submitter_key);
213: if (!$rc) {
214: $dbh->rollback;
215: $dbh->disconnect;
216: die "Unable to insert new record into version: $dbh->errstr\n";
217: }
218: # Upon success commit
219: $dbh->commit;
220: return $rc;
221: }
222:
223: # Update DLESE
224: sub OAIc_update_lo_dlese {
225: my ($dbh, $id, $learning_context, $intendedenduserrole_id, $rights_description, $cost) = @_;
226: my $rc;
227: # UPDATE [needs_3_1]..version
228: $rc = $dbh->do(q{UPDATE version SET license = ?, purchase_license_type_id = ? WHERE resource_id = ?}, undef, substr($rights_description,0,4096), $cost, $id);
229: if (!$rc) {
230: $dbh->rollback;
231: $dbh->disconnect;
232: die "Unable to update record into lo_platform: $dbh->errstr\n";
233: }
234: # Upon success commit
235: $dbh->commit;
236: return $rc;
237: }
238:
239: sub OAIc_personexists {
240: my ($dbh,$email) = @_;
241: my @person_row_ary = $dbh->selectrow_array(q{SELECT entity.id FROM entity entity WHERE entity.email_address = ?}, undef, $email);
242: if ($person_row_ary[0]) {
243: return $person_row_ary[0];
244: } else {
245: return undef;
246: }
247: }
248:
249: sub OAIc_personexists_name {
250: my ($dbh,$name) = @_;
251: my @person_row_ary = $dbh->selectrow_array(q{SELECT entity.id FROM entity entity WHERE entity.name = ?}, undef, $name);
252: if ($person_row_ary[0]) {
253: return $person_row_ary[0];
254: } else {
255: return undef;
256: }
257: }
258: sub OAIc_orgexists {
259: my ($dbh,$name) = @_;
260: my @org_row_ary = $dbh->selectrow_array(q{SELECT entity.id FROM entity entity WHERE entity.name = ?}, undef, $name);
261: if ($org_row_ary[0]) {
262: return $org_row_ary[0];
263: } else {
264: return undef;
265: }
266: }
267:
268: sub OAIc_insert_person {
269: my ($dbh,$affiliate_key,$submitter_key,$personLastname,$personFirstname,$personEmail,$personCompany) = @_;
270: my $rc = $dbh->do(q{INSERT INTO entity (entity_type,name,email_address,privacy_flags,object_type) VALUES (2,?,?,0,'person')}, undef, join(' ',$personFirstname,$personLastname), $personEmail);
271: if (!$rc) {
272: $dbh->rollback;
273: $dbh->disconnect;
274: die "Unable to insert new person into entity: $dbh->errstr \n";
275: }
276: my $id = OAIc_personexists_name($dbh,join(' ',$personFirstname,$personLastname));
277: $rc = $dbh->do(q{INSERT INTO person (id,type,first_name,last_name,company) VALUES (?,'person',?,?,?)}, undef, $id, $personFirstname, $personLastname, $personCompany);
278: if (!$rc) {
279: $dbh->rollback;
280: $dbh->disconnect;
281: die "Unable to insert new person into person: $dbh->errstr \n";
282: }
283: return $rc;
284: }
285:
286: sub OAIc_insert_person_full {
287: my ($dbh,$publisher_reg_key,$submitter_key,$person_last_name,$person_first_name,$entity_email_address,$person_company,$person_middle_name,$person_title,$entity_address,$entity_city,$entity_state,$entity_postal_code,$entity_home_page_url,$entity_phone,$entity_fax,$entity_country) = @_;
288: my $rc = $dbh->do(q{INSERT INTO entity (entity_type,name,email_address,privacy_flags,object_type,address,city,state,postal_code,home_page_url,phone,fax,country) VALUES (2,?,?,0,'person',?,?,?,?,?,?,?,?)}, undef, join(' ',$person_first_name,$person_middle_name,$person_last_name),$entity_email_address,$entity_address,$entity_city,$entity_state,$entity_postal_code,$entity_home_page_url,$entity_phone,$entity_fax,$entity_country);
289: if (!$rc) {
290: $dbh->rollback;
291: $dbh->disconnect;
292: die "Unable to insert new person into entity: $dbh->errstr \n";
293: }
294: my $id = OAIc_personexists($dbh,$entity_email_address);
295: $rc = $dbh->do(q{INSERT INTO person (id,type,first_name,last_name,middle_name,title,company) VALUES (?,'person',?,?,?,?,?)}, undef, $id, $person_first_name, $person_last_name, $person_middle_name,$person_title,$person_company);
296: if (!$rc) {
297: $dbh->rollback;
298: $dbh->disconnect;
299: die "Unable to insert new person into person: $dbh->errstr \n";
300: }
301: return $rc;
302: }
303:
304: sub OAIc_insert_org {
305: my ($dbh,$publisher_reg_key,$submitter_key,$entity_email_address,$person_company,$entity_address,$entity_city,$entity_state,$entity_postal_code,$entity_home_page_url,$entity_phone,$entity_fax,$entity_country) = @_;
306: my $rc = $dbh->do(q{INSERT INTO entity (entity_type,name,email_address,privacy_flags,object_type,address,city,state,postal_code,home_page_url,phone,fax,country) VALUES (1,?,?,0,'organization',?,?,?,?,?,?,?,?)}, undef, $person_company,$entity_email_address,$entity_address,$entity_city,$entity_state,$entity_postal_code,$entity_home_page_url,$entity_phone,$entity_fax,$entity_country);
307: if (!$rc) {
308: $dbh->rollback;
309: $dbh->disconnect;
310: die "Unable to insert new organization into entity: $dbh->errstr \n";
311: }
312: return $rc;
313: }
314: return 1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to OAIcataloging_v2.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / nsdl / harvestsmete