cq/cqquery.pl

   1 #!/usr/bin/perl
   2 use strict;
   3 use warnings;
   4
   5 =pod
   6
   7 =head1 NAME $RCSfile: cqquery.pl,v $
   8
   9 Clearquest Query
  10
  11 This command line tool allows for a simplified access to Clearquest database
  12 and supports an SQL like syntax to allow you to select and update data quickly.
  13 It has the ability to talk to a running Clearquest::Server process so you can
  14 use it on systems that do not have Clearques installed.
  15
  16 Currently the command langauge is limited - no joins or multiple tables, only
  17 very simple where conditions, etc. This may improve over time.
  18
  19 All actions are logged to cqquery.log.
  20
  21 Note that CmdLine is in use so you have a fully command history stack (subject,
  22 of course, to whether or not you have Term::ReadLine::Gnu installed. For cqperl
  23 that's a no go. For Cygwin's Perl or Linux based Perl's you do or can install it
  24 from CPAN) as well as CmdLine builtins like history and help.
  25
  26 Control-C handling is also supported.
  27
  28 =head1 VERSION
  29
  30 =over
  31
  32 =item Author
  33
  34 Andrew DeFaria <Andrew@ClearSCM.com>
  35
  36 =item Revision
  37
  38 $Revision: 1.3 $
  39
  40 =item Created:
  41
  42 Mon Oct 24 16:19:15 PDT 2011
  43
  44 =item Modified:
  45
  46 $Date: 2012/12/18 19:44:10 $
  47
  48 =back
  49
  50 =head1 SYNOPSIS
  51
  52  Usage: cqquery [-u|sage] [-v|erbose] [-d|ebug]
  53                 [-username <username>] [-password <password>]
  54                 [-database <database>] [-dbset <dbset>]
  55                 [-histfile <histfile>]
  56                 [-[no]c|qd]
  57
  58  Where:
  59    -usa|ge:     Displays usage
  60    -v|erbose:   Be verbose
  61    -de|bug:     Output debug messages
  62
  63    -h|istfile <histfile>: History file to use
  64
  65    -use|rname <username>: Username name to use
  66    -p|assword <password>: Password to use
  67    -da|tabase <database>: Database to use
  68    -db|set    <dbset>:    DB Set to use
  69    -[no]c|qd:             If set then look for a Clearquest::Server
  70
  71 =head1 FILES
  72
  73 Configuration data is stored in ../etc/cqdservice.conf which defines the
  74 defaults for things like username/password/db, etc. These are overridden by the
  75 environent (-username is CQD_USERNAME, -password is CQDPASSWORD, etc.  for
  76 server based connections, CQ_USERNAME, CQPASSWORD, etc. for direct connections).
  77 Command line options (e.i. -username) override both the environment and the
  78 config file.
  79
  80 =cut
  81
  82 # TODO: This needs major revision...
  83
  84 use FindBin;
  85 use Term::ANSIColor;
  86 use Getopt::Long;
  87
  88 use lib "$FindBin::Bin/../lib";
  89
  90 use CmdLine;
  91 use Display;
  92 use Logger;
  93 use Utils;
  94
  95 my $VERSION  = '$Revision: 1.3 $';
  96   ($VERSION) = ($VERSION =~ /\$Revision: (.*) /);
  97
  98 my %cmds = (
  99   select => {
 100     help        => 'select <fields> from <table> [where <condition>]',
 101     description => 'Selects fields from a table with an optional condiiton.
 102 Currently conditions are limited.
 103 ',
 104   },
 105
 106   update => {
 107     help        => 'update <table> set <field> = <expr> [where <condition>]',
 108     description => 'Update a field in a table based on an optional condition',
 109   },
 110
 111   insert => {
 112     help        => 'insert [into] <table> <fields> values <values>',
 113     description => 'Insert a new record into table',
 114   },
 115
 116   delete => {
 117     help        => 'delete [from] <table> [where <condition>]',
 118     description => 'Delete records from table based on condition (not implemented)',
 119   },
 120 );
 121
 122 my (%opts, $cq, $log, $pipe);
 123
 124 sub interrupt () {
 125   display_nolf
 126     color ('yellow')
 127   . '<Control-C>'
 128   . color ('reset')
 129   . '... '
 130   . color ('red')
 131   . "Abort current operation (y/N)?"
 132   . color ('reset');
 133
 134   my $response = <STDIN>;
 135   chomp $response;
 136
 137   die "Operation aborted\n"  if $response =~ /^\s*(y|yes)/i;
 138
 139   display color ('cyan') . 'Continuing...' . color ('reset');
 140 } # interrupt
 141
 142 sub pipeInterrupt () {
 143   StopPipe $pipe;
 144
 145   undef $pipe;
 146 } # pipeInterrupt
 147
 148 sub findRecords ($$;@) {
 149   my ($table, $condition, @fields) = @_;
 150
 151   my ($result, $nbrRecs) = $cq->find ($table, $condition, @fields);
 152
 153   $nbrRecs ||= 0;
 154
 155   my $msg = "$nbrRecs records qualified";
 156
 157   $SIG{PIPE} = \&pipeInterrupt;
 158
 159   $pipe = StartPipe $ENV{PAGER};
 160
 161   PipeOutput $msg, $pipe;
 162
 163   $log->log ($msg);
 164
 165   return ($result, $nbrRecs);
 166 } # findRecords
 167
 168 sub select ($$@) {
 169   my ($table, $condition, @fields) = @_;
 170
 171   my ($result, $nbrRecs) = findRecords ($table, $condition, @fields);
 172
 173   if ($cq->errnbr) {
 174     error $result;
 175
 176     return;
 177   } # if
 178
 179   while (my %record = $cq->getNext ($result)) {
 180     last unless $pipe;
 181
 182     foreach (@fields) {
 183       last unless $pipe;
 184
 185       my $line = $record{$_} ? "$_: $record{$_}" : "$_ <undef>";
 186
 187       $log->log ($line);
 188
 189       PipeOutput $line, $pipe;
 190     } # foreach
 191   } # while
 192
 193   StopPipe $pipe;
 194
 195   undef $pipe;
 196 } # select
 197
 198 sub update ($$%) {
 199   my ($table, $condition, %update) = @_;
 200
 201   my ($result, $nbrRecs) = findRecords ($table, $condition);
 202
 203   if ($cq->errnbr) {
 204     error $result;
 205
 206     return;
 207   } # if
 208
 209   $nbrRecs ||= 0;
 210
 211   $log->disp ("$nbrRecs records qualified");
 212
 213   my ($processed, $updated) = (0, 0);
 214
 215   while (my %record = $cq->getNext ($result)) {
 216     $processed++;
 217
 218     my $key = $cq->key ($table, $record{dbid});
 219
 220     $log->disp ("Updating $key", 1);
 221
 222     my $errmsg = $cq->updateRec ($table, $record{dbid}, %update);
 223
 224     if ($errmsg ne '') {
 225       $log->disp (color ('red') . ' failed!!' . color ('reset'));
 226       $log->incrementErr;
 227       $log->log ($errmsg);
 228     } else {
 229       $log->disp (color ('green' ). ' succeeded.' . color ('reset'));
 230
 231       $updated++;
 232     } # if
 233   } # while
 234
 235   my $errors = $log->errors;
 236
 237   return unless $processed;
 238
 239   my $msg;
 240
 241   $msg = $processed;
 242
 243   if ($processed == 1) {
 244     $log->disp ('One record processed');
 245   } else {
 246     $log->disp ("$processed records processed");
 247   } # if
 248
 249   if ($updated == 1) {
 250     $log->disp ('One record updated');
 251   } else {
 252     $log->disp ("$updated records updated");
 253   } # if
 254
 255   if ($errors == 1) {
 256     $log->disp ('One error (Check ' . $log->fullname . ' for more info)');
 257   } elsif ($errors > 1) {
 258     $log->disp ("$errors errors (Check " . $log->fullname . ' for more info)');
 259   } else {
 260     $log->disp ("$errors errors");
 261   } # if
 262 } # update
 263
 264 sub insert ($%) {
 265   my ($table, %values) = @_;
 266
 267   my $errmsg = $cq->insert ($table, %values);
 268
 269   if ($errmsg ne '') {
 270     $log->err ("Unable to insert record:\n$errmsg");
 271   } else {
 272     $log->disp ("Inserted record");
 273   } # if
 274 } # insert
 275
 276 sub evaluate ($) {
 277   my ($line) = @_;
 278
 279   my @fields;
 280
 281   # Mimic simple SQL statements...
 282   if ($line =~ /^\s*select\s+([\w, ]+)\s+from\s+(\S+)(.*)\;*/i) {
 283     my ($table, $condition, $rest);
 284
 285     @fields = split (/\s*,\s*/, $1);
 286     $table  = $2;
 287     $rest   = $3;
 288
 289     # Trim any trailing ';' from table in case the person didn't enter a where
 290     # clause
 291     $table =~ s/\;$//;
 292
 293     if ($rest =~ /\s*where\s+(.*?)\;*$/i) {
 294       $condition = $1;
 295     } elsif ($rest !~ /^\s*$/) {
 296       error "Syntax error in select statement\n\n\t$line";
 297
 298       return 1;
 299     } # if
 300
 301     return ::select ($table, $condition, @fields);
 302   } elsif ($line =~ /^\s*update\s+(\S+)\s+set\s+(\S+)\s*=\s*(.*)/i) {
 303     my ($table, $condition, %update, $rest);
 304
 305     $table = $1;
 306     $rest  = $3;
 307
 308     my $fieldName = $2;
 309
 310     my $value;
 311
 312     if ($rest =~ /(.*)\s+where\s+(.*)/) {
 313       $value     = $1;
 314       $condition = $2;
 315     } else {
 316       $value = $rest;
 317     } # if
 318
 319     # Fix up $value;
 320     $value =~ s/^\s*["'](.*)/$1/;
 321     $value =~ s/(.*)["']\s*$/$1/;
 322
 323     $update{$fieldName} = $value;
 324
 325     return update ($table, $condition, %update);
 326   } elsif ($line =~ /^\s*insert\s+(into)*\s+(\S+)\s+([\w, ]+)\s+values*\s+([\w, ]+)\;*/i) {
 327     my ($table, @values);
 328
 329     $table  = $2;
 330     @fields = split /\s*,\s*/, $3;
 331     @values = split /\s*,\s*/, $4;
 332
 333     my %values;
 334
 335     $values{$_} = shift @values foreach (@fields);
 336
 337     return ::insert ($table, %values);
 338   } elsif ($line =~/^\s*shutdown\s*$/) {
 339     $cq->shutdown;
 340
 341     exit;
 342   } elsif ($line =~ /^\s*$/) {
 343     return;
 344   } else {
 345     $log->err ("Unknown command: $line");
 346
 347     return 1;
 348   } # if
 349 } # evaluate
 350
 351 ## Main
 352 $| = 1;
 353
 354 # Use test database for now...
 355 $opts{database} = 'mobct';
 356 $opts{histfile} = $ENV{CQQUERY_HISTFILE} || "./${FindBin::Script}_hist";
 357 $opts{cqd} = 1;
 358
 359 GetOptions (
 360   \%opts,
 361   usage   => sub { Usage },
 362   verbose => sub { set_verbose },
 363   debug   => sub { set_debug },
 364   'cqd!',
 365   'username=s',
 366   'database=s',
 367   'password=s',
 368   'histfile=s',
 369   'dbset=s',
 370 ) || Usage;
 371
 372 display "$FindBin::Script v$VERSION";
 373
 374 $SIG{INT} = \&interrupt;
 375
 376 if ($opts{cqd}) {
 377   require Clearquest::Client;
 378   $cq  = Clearquest::Client->new (%opts);
 379 } else {
 380   require Clearquest;
 381   $cq  = Clearquest->new (\%opts);
 382 } # if
 383
 384 $log = Logger->new;
 385
 386 my $me = $FindBin::Script;
 387    $me =~ s/\.pl$//;
 388
 389 my $prompt = color ('bold green') . "$me:" . color ('reset');
 390 $prompt="$me:";
 391
 392 $CmdLine::cmdline->set_histfile ($opts{histfile});
 393 $CmdLine::cmdline->set_prompt ($prompt);
 394 $CmdLine::cmdline->set_cmds (%cmds);
 395 $CmdLine::cmdline->set_eval (\&evaluate);
 396
 397 my ($line, $result);
 398
 399 my $dbconnection = $cq->username . '@' . $cq->database . '/' . $cq->dbset;
 400    $dbconnection .= ' (Server: ' . $cq->host . ':' . $cq->port . ')'
 401      if ref $cq eq 'Clearquest::Client';
 402
 403 my $msg = "Opening database $dbconnection";
 404
 405 verbose_nolf color ('dark white') . "$msg..." . color ('reset');
 406 $log->log ($msg, 1);
 407
 408 unless ($cq->connect) {
 409   $log->msg (color ('red') . ' Failed!' . color ('reset'));
 410
 411   $log->err ("Unable to connect to database $dbconnection", 1);
 412 } else {
 413   verbose color ('dark white') . ' connected' . color ('reset');
 414   $log->log (' connected');
 415 } # unless
 416
 417 # Single execution from command line
 418 if ($ARGV[0]) {
 419   my $result = evaluate join ' ', @ARGV;
 420
 421   $result ||= 1;
 422
 423   exit $result;
 424 } # if
 425
 426 while (($line, $result) = $CmdLine::cmdline->get ()) {
 427   last unless defined $line;
 428
 429   $log->log ("$me: $line");
 430
 431   last if $line =~ /exit|quit/i;
 432
 433   my $result = evaluate ($line);
 434 } # while
 435
 436 $cq->disconnect;
 437
 438 exit;