| 1 | #!cqperl |
| 2 | ################################################################################ |
| 3 | # |
| 4 | # File: pqamerge |
| 5 | # Description: Merge the old TO (Teton) and Prod databases to the new Cont |
| 6 | # (Controller) database. This process assumes the new database |
| 7 | # is empty and that there are two "masterdb"'s named From and To. |
| 8 | # These are Clearquest connection profiles and From and To refer |
| 9 | # to the names given in the Clearquest Maintainance Tool for the |
| 10 | # connections. From contains both the TO and Prod databases and |
| 11 | # the To connection contains the Cont database. |
| 12 | # |
| 13 | # Note that it is also assumed that the Cont database has had it's |
| 14 | # code page set to US ASCII. This script will translate non US |
| 15 | # ASCII characters in the from databases to HTML equivalents. |
| 16 | # |
| 17 | # Author: Andrew@DeFaria.com |
| 18 | # Created: Fri Sep 23 17:27:58 PDT 2005 |
| 19 | # Language: Perl |
| 20 | # |
| 21 | # (c) Copyright 2005, Andrew@DeFaria.com, all rights reserved |
| 22 | # |
| 23 | ################################################################################ |
| 24 | use strict; |
| 25 | use warnings; |
| 26 | use CQPerlExt; |
| 27 | use File::Spec; |
| 28 | |
| 29 | our ($me, $separator); |
| 30 | |
| 31 | my ($abs_path, $lib_path); |
| 32 | |
| 33 | BEGIN { |
| 34 | # Extract relative path and basename from script name. |
| 35 | $0 =~ /(.*)[\/\\](.*)/; |
| 36 | |
| 37 | $abs_path = (!defined $1) ? "." : File::Spec->rel2abs ($1); |
| 38 | $me = (!defined $2) ? $0 : $2; |
| 39 | $me =~ s/\.pl$//; |
| 40 | |
| 41 | # Remove .pl for Perl scripts that have that extension |
| 42 | $me =~ s/\.pl$//; |
| 43 | |
| 44 | # Define the path separator |
| 45 | $separator = ($^O =~ /MSWin/) ? "\\" : "/"; |
| 46 | |
| 47 | # Setup paths |
| 48 | $lib_path = "$abs_path" . $separator . ".." . $separator . "lib"; |
| 49 | |
| 50 | # Add the appropriate path to our modules to @INC array. |
| 51 | unshift (@INC, "$abs_path"); |
| 52 | unshift (@INC, "$lib_path"); |
| 53 | } # BEGIN |
| 54 | |
| 55 | use PQA; |
| 56 | use Display; |
| 57 | use Logger; |
| 58 | use TimeUtils; |
| 59 | |
| 60 | my $from_db_connection_name = "2003.06.00"; |
| 61 | my $to_db_connection_name = "2005.02.00"; |
| 62 | my $id; |
| 63 | |
| 64 | sub Usage { |
| 65 | my $msg = shift; |
| 66 | |
| 67 | display "ERROR: $msg\n" if defined $msg; |
| 68 | |
| 69 | display "Usage: $me\t[-u] [-v] [-d] [-id ] |
| 70 | [-from ] |
| 71 | [-to ] |
| 72 | |
| 73 | Where: |
| 74 | |
| 75 | -u: Display usage |
| 76 | -v: Turn on verbose mode |
| 77 | -d: Turn on debug mode |
| 78 | -id : Process only the specified defect |
| 79 | (Default: Process all defects) |
| 80 | -from : Specify the from connection name |
| 81 | (Default: $from_db_connection_name) |
| 82 | -to : Specify the to connection name |
| 83 | (Default: $to_db_connection_name)"; |
| 84 | exit 1; |
| 85 | } # Usage |
| 86 | |
| 87 | sub BurnIDsTil { |
| 88 | my $log = shift; |
| 89 | my $to = shift; |
| 90 | my $record_name = shift; |
| 91 | my $current_id = shift; |
| 92 | my $dest_id = shift; |
| 93 | |
| 94 | my $entity; |
| 95 | |
| 96 | while ($current_id < $dest_id) { |
| 97 | # Create a new entity and get it's ID until we reach $dest_id |
| 98 | $entity = $to->BuildEntity ($record_name); |
| 99 | $current_id = $entity->GetFieldValue ("id")->GetValue; |
| 100 | |
| 101 | # Change $current_id to just the number portion |
| 102 | $current_id = substr $current_id, 4, 8; |
| 103 | |
| 104 | # Burn the id if it is not equal to the $dest_id |
| 105 | $entity->Revert if $current_id < $dest_id; |
| 106 | } # while |
| 107 | |
| 108 | return $entity; |
| 109 | } # BurnIDsTil |
| 110 | |
| 111 | sub TransferState { |
| 112 | my $log = shift; |
| 113 | my $record_name = shift; |
| 114 | my $db = shift; |
| 115 | my $id = shift; |
| 116 | my $state = shift; |
| 117 | |
| 118 | # There is no corresponding Submit state in Cont so we cannot |
| 119 | # transition it's state. For now we will leave it Assigned. |
| 120 | return if $state eq "Submit"; |
| 121 | |
| 122 | # State transition matrix: This hash defines a state to get to and |
| 123 | # an array of how to get there. |
| 124 | my %state_transition_matrix = ( |
| 125 | "Assigned" => [ |
| 126 | ], |
| 127 | "Resolved" => [ |
| 128 | "Resolve" |
| 129 | ], |
| 130 | "Unassigned" => [ |
| 131 | "Unassign" |
| 132 | ], |
| 133 | "Data_Pending" => [ |
| 134 | "Data_Pending" |
| 135 | ], |
| 136 | "Verified" => [ |
| 137 | "Resolve", |
| 138 | "Verify" |
| 139 | ], |
| 140 | "Awaiting_Cust_Verify" => [ |
| 141 | "Resolve", |
| 142 | "Verify", |
| 143 | "VerifiedPendingCustVerify" |
| 144 | ], |
| 145 | "Closed" => [ |
| 146 | "Resolve", |
| 147 | "Verify", |
| 148 | "Close" |
| 149 | ], |
| 150 | "Verified_Cust_Accepted" => [ |
| 151 | "Resolve", |
| 152 | "Verify", |
| 153 | "VerifiedPendingCustVerify", |
| 154 | "CustomerVerified" |
| 155 | ], |
| 156 | ); |
| 157 | |
| 158 | # Not transition through the necessary states |
| 159 | my $current_state = $state; |
| 160 | my @actions = @{$state_transition_matrix {$current_state}}; |
| 161 | |
| 162 | debug "Transitioning $id to $current_state State"; |
| 163 | |
| 164 | foreach (@actions) { |
| 165 | debug "Applying action $_"; |
| 166 | |
| 167 | my $new_entity = $db->GetEntity ($record_name, $id); |
| 168 | |
| 169 | $db->EditEntity ($new_entity, $_); |
| 170 | |
| 171 | my $errmsg = $new_entity->Validate; |
| 172 | |
| 173 | if ($errmsg ne "") { |
| 174 | verbose ""; |
| 175 | $log->err ("\n$id\n$errmsg"); |
| 176 | return; |
| 177 | } else { |
| 178 | # Post record to database |
| 179 | $new_entity->Commit; |
| 180 | } # if |
| 181 | } # foreach |
| 182 | } # TransferState |
| 183 | |
| 184 | sub TransferDefects { |
| 185 | my $log = shift; |
| 186 | my $from = shift; |
| 187 | my $to = shift; |
| 188 | my $dbname = shift; |
| 189 | my $record_name = shift; |
| 190 | my $search_id = shift; |
| 191 | my @field_list = @_; |
| 192 | |
| 193 | my $result; |
| 194 | my $new_id; |
| 195 | |
| 196 | if (defined $search_id) { |
| 197 | $result = GetDefectRecord $log, $from, $record_name, $search_id; |
| 198 | } else { |
| 199 | $result = GetAllDefectRecords $log, $from, $record_name; |
| 200 | } # if |
| 201 | |
| 202 | return if !$result; |
| 203 | |
| 204 | my $old_bufffer_status = $|; |
| 205 | $| = 1; # Turn off buffering |
| 206 | |
| 207 | my $nbr = 0; |
| 208 | |
| 209 | # Seed $current_id - IOW what is the current ID in the destination |
| 210 | # database? |
| 211 | my $current_id; |
| 212 | if (!defined $search_id) { |
| 213 | my $entity = $to->BuildEntity ($record_name); |
| 214 | $current_id = $entity->GetFieldValue ("id")->GetValue; |
| 215 | } # if |
| 216 | |
| 217 | # Now for each record returned by the query... |
| 218 | while ($result->MoveNext == $CQPerlExt::CQ_SUCCESS) { |
| 219 | # GetEntity by using $id |
| 220 | my $id = $result->GetColumnValue (1); |
| 221 | my $from_entity = $from->GetEntity ($record_name, $id); |
| 222 | my $title; |
| 223 | my @files_created; |
| 224 | my $history_filename = "history.txt"; |
| 225 | my $to_entity; |
| 226 | |
| 227 | if (!defined $search_id) { |
| 228 | # Check to see if $id > $current_id. If so then we can't |
| 229 | # proceed. If not then we need to burn up some IDs. |
| 230 | my $current_id_nbr = substr $current_id, 4, 8; |
| 231 | my $dest_id_nbr; |
| 232 | |
| 233 | if ($id =~ /^Prod/) { |
| 234 | $dest_id_nbr = substr $id, 4, 8; |
| 235 | } else { |
| 236 | $dest_id_nbr = 20000 + (substr $id, 2, 8); |
| 237 | } # if |
| 238 | |
| 239 | if ($current_id_nbr > $dest_id_nbr) { |
| 240 | error "Unable to sequence merge", 1; |
| 241 | } elsif ($current_id_nbr < $dest_id_nbr) { |
| 242 | $to_entity = BurnIDsTil $log, $to, $record_name, $current_id_nbr, $dest_id_nbr; |
| 243 | } # if |
| 244 | } else { |
| 245 | # Since $search_id is defined we're doing a single ID, in test |
| 246 | # mode, so generate a new $to_entity. IOW there is no sequencing |
| 247 | # going on... |
| 248 | $to_entity = $to->BuildEntity ($record_name); |
| 249 | } # if |
| 250 | |
| 251 | $log->msg (++$nbr . ": Merging ID $id ", "nolf"); |
| 252 | |
| 253 | # Get the fields... |
| 254 | foreach (@field_list) { |
| 255 | my $name = $_; |
| 256 | my $value = $from_entity->GetFieldValue ($name)->GetValue; |
| 257 | |
| 258 | # Here we handle the differences between records.. |
| 259 | if ($dbname eq "TO") { |
| 260 | ## Field Translations |
| 261 | |
| 262 | # TO: defect: AdvancedFeature -> Cont: defect: Advanced_Feature |
| 263 | if ($name eq "AdvancedFeature") { |
| 264 | $name = "Advanced_Feature"; |
| 265 | AddToFieldChoiceList $to, $to_entity, $name, $name, $value; |
| 266 | } # if |
| 267 | |
| 268 | # TO: defect: Fixed_In_Project -> Cont: defect: Fixed_In_Project |
| 269 | # but as a reference to Cont: Project |
| 270 | AddToFieldChoiceList $to, $to_entity, "Project", $name, $value if $name eq "Fixed_In_Project"; |
| 271 | |
| 272 | # TO: defect: Found_In_Project -> Cont: defect: Found_In_Project |
| 273 | # but as a reference to Cont: Project |
| 274 | AddToProject $log, $to, $value if $name eq "Found_In_Project"; |
| 275 | |
| 276 | # TO: defect: Fixed_In_SW_Version -> Cont: defect: Fixed_In_SW_Version |
| 277 | if ($name eq "Fixed_In_SW_Version") { |
| 278 | $value = "N/A" if $value eq ""; |
| 279 | } # if |
| 280 | |
| 281 | # TO: defect: History -> Cont: defect: |
| 282 | # Transfer history item to an attachment |
| 283 | if ($name eq "History") { |
| 284 | TransferHistory ($from_entity, $to_entity, $history_filename); |
| 285 | } # if |
| 286 | |
| 287 | ## Field renames |
| 288 | |
| 289 | # TO: defect: GatingItem -> Cont: defect: Gating_Item_HW |
| 290 | $name = "Gating_Item_SW" if $name eq "GatingItem"; |
| 291 | |
| 292 | # TO: defect: HUT_Version -> Cont: defect: Board_Revision |
| 293 | if ($name eq "HUT_Version") { |
| 294 | $name = "Board_Revision"; |
| 295 | $value = "Not Applicable" if $value eq "N/A"; |
| 296 | AddToFieldChoiceList $to, $to_entity, $name, $name, $value; |
| 297 | } # if |
| 298 | |
| 299 | # TO: defect: ReportedBy -> Cont: defect: Reported_By |
| 300 | if ($name eq "ReportedBy") { |
| 301 | $name = "Reported_By"; |
| 302 | AddToFieldChoiceList $to, $to_entity, $name, $name, $value |
| 303 | } # if |
| 304 | |
| 305 | # TO: defect: NoteBugReview -> Cont: defect: Bug_Review_Note |
| 306 | $name = "Bug_Review_Note" if $name eq "NoteBugReview"; |
| 307 | |
| 308 | # TO: defect: NoteBRCMOnly -> Cont: defect: Broadcom_Only_Note |
| 309 | $name = "Broadcom_Only_Note" if $name eq "NoteBRCMOnly"; |
| 310 | |
| 311 | # TO: defect: Open_Close_Status -> Cont: defect: Active_Deferred_Status |
| 312 | $name = "Active_Deferred_Status" if $name eq "Open_Close_Status"; |
| 313 | |
| 314 | # TO: defect: SQATestCase -> Cont: defect: PQATestCase |
| 315 | if ($name eq "SQATestCase") { |
| 316 | $name = "PQATestCase"; |
| 317 | $value = "N/A" if $value eq ""; |
| 318 | } # if |
| 319 | |
| 320 | # TO: defect: Title_2 -> Cont: defect: Title |
| 321 | if ($name eq "Title_2") { |
| 322 | # There are some blank titles! |
| 323 | $value = "N/A" if $value eq ""; |
| 324 | $title = $value; |
| 325 | $name = "Title"; |
| 326 | } # if |
| 327 | |
| 328 | ## Field deletes |
| 329 | next if $name eq "AttachmentsBRCM" or |
| 330 | $name eq "Project" or |
| 331 | $name eq "PendingHWSWReleases" or |
| 332 | $name eq "TestBlocking"; |
| 333 | } elsif ($dbname eq "Prod") { |
| 334 | ## Field Translations |
| 335 | |
| 336 | # Prod: defect: AdvancedFeature -> Cont: defect: Advanced_Feature |
| 337 | if ($name eq "AdvancedFeature") { |
| 338 | $name = "Advanced_Feature"; |
| 339 | AddToFieldChoiceList $to, $to_entity, $name, $name, $value; |
| 340 | } # if |
| 341 | |
| 342 | # Prod: defect: Fixed_In_Project -> Cont: defect: Project |
| 343 | # but as a reference to Cont: Project |
| 344 | AddToFieldChoiceList $to, $to_entity, "Project", $name, $value if $name eq "Fixed_In_Project"; |
| 345 | |
| 346 | # Prod: defect: Fixed_In_SW_Version -> Cont: defect: Fixed_In_SW_Version |
| 347 | if ($name eq "Fixed_In_SW_Version") { |
| 348 | $value = "N/A" if $value eq ""; |
| 349 | } # if |
| 350 | |
| 351 | # Prod: defect: History -> Cont: defect: |
| 352 | # Transfer history item to an attachment |
| 353 | if ($name eq "History") { |
| 354 | TransferHistory ($from_entity, $to_entity, $history_filename); |
| 355 | } # if |
| 356 | |
| 357 | # Prod: defect: Category -> Cont: defect: Category |
| 358 | if ($name eq "Category") { |
| 359 | # There is no "Hardware" anymore so translating them to "Hardware - Board" |
| 360 | if ($value eq "Hardware") { |
| 361 | $value = "Hardware - Board"; |
| 362 | } # if |
| 363 | } # if |
| 364 | |
| 365 | # Prod: defect: GatingItem -> Cont: defect: Gating_Item_HW |
| 366 | $name = "Gating_Item_SW" if $name eq "GatingItem"; |
| 367 | |
| 368 | # Prod: defect: HUT_Version -> Cont: defect: Board_Revision |
| 369 | if ($name eq "HUT_Version") { |
| 370 | $name = "Board_Revision"; |
| 371 | $value = $value ne "" ? $value : "Not Applicable"; |
| 372 | $value = "Not Applicable" if $value eq "N/A"; |
| 373 | if ($value eq "BCM95704CA40 v1.0 revA0 ") { |
| 374 | # Trailing blank is wrong! - Removing it |
| 375 | $value = "BCM95704CA40 v1.0 revA0"; |
| 376 | } # if |
| 377 | AddToFieldChoiceList $to, $to_entity, $name, $name, $value; |
| 378 | } # if |
| 379 | |
| 380 | # Prod: defect: Issue_Classification -> Cont: defect: Issue_Classification |
| 381 | # There are no: Hardware in the new Cont database so we'll map it to |
| 382 | # "Requirement" |
| 383 | if ($name eq "Issue_Classification") { |
| 384 | $value = "Requirement" if $value eq "Hardware"; |
| 385 | } # if |
| 386 | |
| 387 | # Prod: defect: NoteBugReview -> Cont: defect: Bug_Review_Note |
| 388 | $name = "Bug_Review_Note" if $name eq "NoteBugReview"; |
| 389 | |
| 390 | # Prod: defect: NoteBRCMOnly -> Cont: defect: Broadcom_Only_Note |
| 391 | $name = "Broadcom_Only_Note" if $name eq "NoteBRCMOnly"; |
| 392 | |
| 393 | # Prod: defect: Open_Close_Status -> Cont: defect: Active_Deferred_Status |
| 394 | $name = "Active_Deferred_Status" if $name eq "Open_Close_Status"; |
| 395 | |
| 396 | # Prod: defect: Project -> Cont: defect: Found_In_Project |
| 397 | if ($name eq "Project") { |
| 398 | AddToProject $log, $to, $value; |
| 399 | $name = "Found_In_Project"; |
| 400 | } # if |
| 401 | |
| 402 | # Prod: defect: ReportedBy -> Cont: defect: Reported_By |
| 403 | if ($name eq "ReportedBy") { |
| 404 | $name = "Reported_By"; |
| 405 | AddToFieldChoiceList $to, $to_entity, $name, $name, $value |
| 406 | } # if |
| 407 | |
| 408 | # Prod: defect: Resolution -> Cont: defect: Resolution |
| 409 | if ($name eq "Resolution") { |
| 410 | # There is no "HW Fix" anymore so translating them to "Hw Fix - Board" |
| 411 | if ($value eq "HW Fix") { |
| 412 | $value = "HW Fix - Board"; |
| 413 | } elsif ($value eq "MAC Core") { |
| 414 | $value = "HW Fix - MAC Core"; |
| 415 | }# if |
| 416 | } # if |
| 417 | |
| 418 | # Prod: defect: Software_Version -> Cont: defect: Software_Version |
| 419 | if ($name eq "Software_Version") { |
| 420 | $value = "N/A" if $value eq "" or $value eq " "; |
| 421 | } # if |
| 422 | |
| 423 | # Prod: defect: Title -> Cont: defect: Title |
| 424 | if ($name eq "Title") { |
| 425 | $value = $value ne "" ? $value : ""; |
| 426 | $title = $value; |
| 427 | } # if |
| 428 | |
| 429 | # Prod: defect: SQATestcase -> Cont: defect: PQATestCase |
| 430 | if ($name eq "SQATestCase") { |
| 431 | $name = "PQATestCase"; |
| 432 | $value = "N/A" if $value eq ""; |
| 433 | } # if |
| 434 | |
| 435 | # Prod: defect: Title_2 -> Cont: defect: Title |
| 436 | $name = "Title" if $name eq "Title_2"; |
| 437 | |
| 438 | ## Field deletes |
| 439 | next if $name eq "AttachmentBRCM" or |
| 440 | $name eq "Project_Name" or |
| 441 | $name eq "PendingHWSWReleases" or |
| 442 | $name eq "TestBlocking"; |
| 443 | } # if |
| 444 | |
| 445 | # Check field for non US ASCII characters and fix them |
| 446 | $value = CheckField $dbname, $record_name, $id, $name, $value; |
| 447 | |
| 448 | ## Handle dynamic choice lists |
| 449 | |
| 450 | # While the field name is DeferredToProject, it's corresponding |
| 451 | # Dynamic list name is actually Project |
| 452 | AddToFieldChoiceList $to, $to_entity, "Project", $name, $value if $name eq "DeferredToProject"; |
| 453 | |
| 454 | # While the field name is CommittedToProject, it's corresponding |
| 455 | # Dynamic list name is actually Project |
| 456 | AddToFieldChoiceList $to, $to_entity, "Project", $name, $value if $name eq "CommittedToProject"; |
| 457 | |
| 458 | if ($name eq "HUT") { |
| 459 | $value = "BRCM Copper (do not use)" if $value eq "Broadcom Copper"; |
| 460 | $value = "BRCM Fiber (do not use)" if $value eq "Broadcom Fiber Optic"; |
| 461 | } # if |
| 462 | |
| 463 | AddToFieldChoiceList $to, $to_entity, $name, $name, $value if $name eq "HUT"; |
| 464 | |
| 465 | if ($name eq "HUT_Revision") { |
| 466 | $value = "N/A" |
| 467 | if $value eq "" or |
| 468 | $value eq "\?" or |
| 469 | $value eq "\?\?\?" or |
| 470 | $value eq "A0-A4,B0-B1" or |
| 471 | $value eq "All" or |
| 472 | $value eq "all revisions" or |
| 473 | $value eq "n" or |
| 474 | $value eq "n/" or |
| 475 | $value eq "n\a" or |
| 476 | $value eq "na" or |
| 477 | $value eq "n/a "; |
| 478 | $value = "A0" if $value eq "BCM5752 A0"; |
| 479 | $value = "A1" if $value eq "BCM5752 A1 10x10 package"; |
| 480 | $value = "A2" if $value eq "A2 (A3 Silent)"; |
| 481 | $value = "A3" if $value eq "A3 silent (A2)"; |
| 482 | $value = "B1" if $value eq "B1/A1"; |
| 483 | AddToFieldChoiceList $to, $to_entity, $name, $name, $value; |
| 484 | } # if |
| 485 | |
| 486 | if ($name eq "Service_Pack") { |
| 487 | $value = "Not Applicable" |
| 488 | if $value eq "" or |
| 489 | $value eq "\?" or |
| 490 | $value eq "na" or |
| 491 | $value eq "N/A" or |
| 492 | $value eq "none" or |
| 493 | $value eq "Notice that QA applies to bootcode + Win + Linux d"; |
| 494 | $value = "SP3" if $value eq "SP3 "; |
| 495 | $value = "SP4" if $value eq "SP4 "; |
| 496 | $value = "Suse 9" if $value eq "Suse 9 "; |
| 497 | } # if |
| 498 | |
| 499 | # While the field name is Service_Pack, it's corresponding |
| 500 | # Dynamic list name is actually OS_Service_Pack! |
| 501 | AddToFieldChoiceList $to, $to_entity, "OS_Service_Pack", $name, $value if $name eq "Service_Pack"; |
| 502 | |
| 503 | AddToFieldChoiceList $to, $to_entity, $name, $name, $value if $name eq "Software"; |
| 504 | AddToFieldChoiceList $to, $to_entity, $name, $name, $value if $name eq "Visibility"; |
| 505 | if ($name eq "OS") { |
| 506 | $value = "Novell 6 Pack Beta 3" if $value eq "Novell 6 Pack Beta 3 "; |
| 507 | AddToFieldChoiceList $to, $to_entity, $name, $name, $value if $name eq "OS"; |
| 508 | } # if |
| 509 | |
| 510 | # Set the field's value |
| 511 | $to_entity->SetFieldValue ($name, $value); |
| 512 | } # for |
| 513 | |
| 514 | ## New fields |
| 515 | |
| 516 | # Found_On_Gold: Default to "No" |
| 517 | $to_entity->SetFieldValue ("Found_On_Gold", "No"); |
| 518 | |
| 519 | # Gating_Item_HW: Default to "No" |
| 520 | $to_entity->SetFieldValue ("Gating_Item_HW", "No"); |
| 521 | |
| 522 | # Newly_Introduce: Default to "No" |
| 523 | $to_entity->SetFieldValue ("Newly_Introduce", "No"); |
| 524 | |
| 525 | # Root_Caused: Default to "No" |
| 526 | $to_entity->SetFieldValue ("Root_Caused", "No"); |
| 527 | |
| 528 | # Throw old ID from Prod or TO into old_id. This can then serve |
| 529 | # As a cross reference |
| 530 | $to_entity->SetFieldValue ("old_id", $id); |
| 531 | |
| 532 | # Need to handle attachments differently... |
| 533 | @files_created = TransferAttachments $log, $from_entity, $to_entity; |
| 534 | |
| 535 | # Call the Validate method |
| 536 | my $errmsg = $to_entity->Validate; |
| 537 | |
| 538 | if ($errmsg ne "") { |
| 539 | verbose ""; |
| 540 | $log->err ("\n$id\n$errmsg"); |
| 541 | } else { |
| 542 | # Post record to database |
| 543 | $to_entity->Commit; |
| 544 | $new_id = $to_entity->GetFieldValue ("id")->GetValue; |
| 545 | $log->msg ("-> $new_id"); |
| 546 | } # if |
| 547 | |
| 548 | # Clean up files created by TransferAttachments - if any |
| 549 | foreach (@files_created) { |
| 550 | unlink $_; |
| 551 | } # foreach |
| 552 | |
| 553 | # Clean up files created by TransferHistory |
| 554 | unlink $history_filename; |
| 555 | |
| 556 | # Transfer State: The entity we just created is now in the |
| 557 | # Assigned state. But that's not the same as the state of the |
| 558 | # original entity. The following code attempts to fix this. |
| 559 | my $old_state = $from_entity->GetFieldValue ("State")->GetValue; |
| 560 | |
| 561 | TransferState $log, $record_name, $to, $new_id, $old_state; |
| 562 | } # while |
| 563 | |
| 564 | $| = $old_bufffer_status; # Restore buffering |
| 565 | |
| 566 | return $new_id; |
| 567 | } # TransferDefects |
| 568 | |
| 569 | while ($ARGV [0]) { |
| 570 | if ($ARGV [0] eq "-v") { |
| 571 | Display::set_verbose; |
| 572 | Logger::set_verbose; |
| 573 | } elsif ($ARGV [0] eq "-d") { |
| 574 | set_debug; |
| 575 | } elsif ($ARGV [0] eq "-id") { |
| 576 | shift; |
| 577 | if (!$ARGV [0]) { |
| 578 | Usage "Must specify ID after -id"; |
| 579 | } else { |
| 580 | $id = $ARGV [0]; |
| 581 | } # if |
| 582 | } elsif ($ARGV [0] eq "-from") { |
| 583 | shift; |
| 584 | if (!$ARGV [0]) { |
| 585 | Usage "Must specify after -from"; |
| 586 | } else { |
| 587 | $from_db_connection_name = $ARGV [0]; |
| 588 | } # if |
| 589 | } elsif ($ARGV [0] eq "-to") { |
| 590 | shift; |
| 591 | if (!$ARGV [0]) { |
| 592 | Usage "Must specify after -to"; |
| 593 | } else { |
| 594 | $to_db_connection_name = $ARGV [0]; |
| 595 | } # if |
| 596 | } elsif ($ARGV [0] eq "-u") { |
| 597 | Usage; |
| 598 | } else { |
| 599 | Usage "Unknown argument found: " . $ARGV [0]; |
| 600 | } # if |
| 601 | |
| 602 | shift (@ARGV); |
| 603 | } # while |
| 604 | |
| 605 | my $log = Logger->new (path => "."); |
| 606 | |
| 607 | my $process_start_time = time; |
| 608 | my $start_time; |
| 609 | |
| 610 | $log->msg ("Starting Cont session"); |
| 611 | my $controller = StartSession "Cont", $to_db_connection_name; |
| 612 | |
| 613 | my $do_prod = 1; |
| 614 | my $do_teton = 1; |
| 615 | my $current_id; |
| 616 | my $record_name = "defect"; |
| 617 | |
| 618 | if ($do_prod) { |
| 619 | $log->msg ("Starting Prod session"); |
| 620 | my $prod = StartSession ("Prod", $from_db_connection_name); |
| 621 | |
| 622 | $log->msg ("Transferring Prod:defect -> Cont:defect"); |
| 623 | $start_time = time; |
| 624 | $current_id = TransferDefects $log, $prod, $controller, "Prod", $record_name, $id, @old_Prod_defect_fields; |
| 625 | $log->msg ("Completed transfer of Prod:defect records"); |
| 626 | display_duration $start_time, $log; |
| 627 | |
| 628 | $log->msg ("Ending Prod session"); |
| 629 | EndSession $prod; |
| 630 | } # if |
| 631 | |
| 632 | if ($do_teton) { |
| 633 | $log->msg ("Starting TO session"); |
| 634 | my $teton = StartSession "TO", $from_db_connection_name; |
| 635 | |
| 636 | $log->msg ("Transferring TO:defect -> Cont:defect"); |
| 637 | $start_time = time; |
| 638 | |
| 639 | if (!defined $id) { |
| 640 | my $current_id_nbr = substr $current_id, 4, 8; |
| 641 | # Start numbering TO at 20000 |
| 642 | BurnIDsTil $log, $controller, $record_name, $current_id_nbr, "20000"; |
| 643 | } # if |
| 644 | TransferDefects $log, $teton, $controller, "TO", $record_name, $id, @old_TO_defect_fields; |
| 645 | $log->msg ("Completed transfer of TO:defect records"); |
| 646 | display_duration $start_time, $log; |
| 647 | |
| 648 | $log->msg ("Ending TO session"); |
| 649 | EndSession $teton; |
| 650 | } # if |
| 651 | |
| 652 | $log->msg ("Ending Cont session"); |
| 653 | EndSession $controller; |
| 654 | |
| 655 | verbose "Total processing time:"; |
| 656 | display_duration $process_start_time, $log; |