Annotation of nsdl/harvestsmete/OAIcataloging_v2.pm, revision 1.1
1.1 ! www 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