| 1 | #!cqperl |
| 2 | ################################################################################ |
| 3 | # |
| 4 | # File: pqaclean |
| 5 | # Description: Cleans destination PQA Cont database by removing all defects |
| 6 | # then Customer and Project stateless records. Useful when |
| 7 | # debugging and performing multiple runs of pqamerge. |
| 8 | # |
| 9 | # Author: Andrew@DeFaria.com |
| 10 | # Created: Fri Sep 23 17:27:58 PDT 2005 |
| 11 | # Language: Perl |
| 12 | # |
| 13 | # (c) Copyright 2005, Andrew@DeFaria.com, all rights reserved |
| 14 | # |
| 15 | ################################################################################ |
| 16 | use strict; |
| 17 | use warnings; |
| 18 | use CQPerlExt; |
| 19 | use File::Spec; |
| 20 | |
| 21 | our ($me, $separator); |
| 22 | |
| 23 | my ($abs_path, $lib_path); |
| 24 | |
| 25 | BEGIN { |
| 26 | # Extract relative path and basename from script name. |
| 27 | $0 =~ /(.*)[\/\\](.*)/; |
| 28 | |
| 29 | $abs_path = (!defined $1) ? "." : File::Spec->rel2abs ($1); |
| 30 | $me = (!defined $2) ? $0 : $2; |
| 31 | $me =~ s/\.pl$//; |
| 32 | |
| 33 | # Remove .pl for Perl scripts that have that extension |
| 34 | $me =~ s/\.pl$//; |
| 35 | |
| 36 | # Define the path separator |
| 37 | $separator = ($^O =~ /MSWin/) ? "\\" : "/"; |
| 38 | |
| 39 | # Setup paths |
| 40 | $lib_path = "$abs_path" . $separator . ".." . $separator . "lib"; |
| 41 | |
| 42 | # Add the appropriate path to our modules to @INC array. |
| 43 | unshift (@INC, "$abs_path"); |
| 44 | unshift (@INC, "$lib_path"); |
| 45 | } # BEGIN |
| 46 | |
| 47 | use PQA; |
| 48 | use Display; |
| 49 | use Logger; |
| 50 | use TimeUtils; |
| 51 | |
| 52 | my $from_db_connection_name = "2005.02.00"; |
| 53 | |
| 54 | sub Usage { |
| 55 | my $msg = shift; |
| 56 | |
| 57 | display "ERROR: $msg\n" if defined $msg; |
| 58 | |
| 59 | display "Usage: $me\t[-u] [-v] [-d] [-from ] |
| 60 | |
| 61 | Where: |
| 62 | -u: Display usage |
| 63 | -v: Turn on verbose mod |
| 64 | -d: Turn on debug mode |
| 65 | -from : Specify the from connaction name |
| 66 | (Default $from_db_connection_name)"; |
| 67 | exit 1; |
| 68 | } # Usage |
| 69 | |
| 70 | |
| 71 | my $log = Logger->new (path => "."); |
| 72 | |
| 73 | while ($ARGV [0]) { |
| 74 | if ($ARGV [0] eq "-v") { |
| 75 | Display::set_verbose; |
| 76 | Logger::set_verbose; |
| 77 | } elsif ($ARGV [0] eq "-d") { |
| 78 | set_debug; |
| 79 | } elsif ($ARGV [0] eq "-from") { |
| 80 | shift; |
| 81 | if (!$ARGV [0]) { |
| 82 | Usage "Must specify after -from"; |
| 83 | } else { |
| 84 | $from_db_connection_name = $ARGV [0]; |
| 85 | } # if |
| 86 | } elsif ($ARGV [0] eq "-u") { |
| 87 | Usage; |
| 88 | } else { |
| 89 | Usage "Unknown argument found: " . $ARGV [0]; |
| 90 | } # if |
| 91 | |
| 92 | shift (@ARGV); |
| 93 | } # while |
| 94 | |
| 95 | my $process_start_time = time; |
| 96 | my $controller = StartSession "Cont", $from_db_connection_name; |
| 97 | $log->msg ("Opened Controller (Cont) database from \"$from_db_connection_name\" connection"); |
| 98 | |
| 99 | my $start_time; |
| 100 | |
| 101 | $start_time = time; |
| 102 | DeleteRecords $log, $controller, "defect"; |
| 103 | display_duration $start_time, $log; |
| 104 | |
| 105 | $start_time = time; |
| 106 | DeleteRecords $log, $controller, "Customer"; |
| 107 | display_duration $start_time, $log; |
| 108 | |
| 109 | $start_time = time; |
| 110 | DeleteRecords $log, $controller, "Project"; |
| 111 | display_duration $start_time, $log; |
| 112 | |
| 113 | $start_time = time; |
| 114 | DeleteDynamicLists $log, $controller; |
| 115 | display_duration $start_time, $log; |
| 116 | |
| 117 | EndSession $controller; |
| 118 | display_duration $process_start_time, $log; |