projects / clearscm.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Some cosmetic edits
[clearscm.git] / lib / Clearquest / DBService.pm
diff --git a/lib/Clearquest/DBService.pm b/lib/Clearquest/DBService.pm
index 6693f14..b1c73c0 100644 (file)
--- a/lib/Clearquest/DBService.pm
+++ b/lib/Clearquest/DBService.pm
@@ -30,7 +30,7 @@ $Date: 2011/12/31 02:13:37 $
 
 Provides an interface to the Clearquest database over the network.
 
 
 Provides an interface to the Clearquest database over the network.
 
-This library implements both the daemon portion of the server and the client 
+This library implements both the daemon portion of the server and the client
 API.
 
 =head1 DESCRIPTION
 API.
 
 =head1 DESCRIPTION
@@ -42,7 +42,7 @@ write to the Clearquest database for write access to succeed.
 A hash is passed into to the execute method, which the client should use to talk
 to the server, that describes relatively simple protocol to tell the server what
 action to perform. In both the read case and the read/write case a field named
 A hash is passed into to the execute method, which the client should use to talk
 to the server, that describes relatively simple protocol to tell the server what
 action to perform. In both the read case and the read/write case a field named
-id should be defined that has a value of "<record>=<id>" (e.g. 
+id should be defined that has a value of "<record>=<id>" (e.g.
 "defect=BUGDB00034429").
 
 For the read case the rest of the keys are the names of the fields to retrieve
 "defect=BUGDB00034429").
 
 For the read case the rest of the keys are the names of the fields to retrieve
@@ -50,7 +50,7 @@ with values that are undef'ed. For read/write, the rest of hash contains name
 value pairs of fields to set and their values.
 
 Execute returns a status and a hash of name value pairs for the read case and an
 value pairs of fields to set and their values.
 
 Execute returns a status and a hash of name value pairs for the read case and an
-array of lines for any error messages for the read/write case. 
+array of lines for any error messages for the read/write case.
 
 =head1 ROUTINES
 
 
 =head1 ROUTINES
 
@@ -83,7 +83,7 @@ our %OPTS = GetConfig $config;
 
 our $VERSION  = '$Revision: 1.2 $';
    ($VERSION) = ($VERSION =~ /\$Revision: (.*) /);
 
 our $VERSION  = '$Revision: 1.2 $';
    ($VERSION) = ($VERSION =~ /\$Revision: (.*) /);
-   
+
 # Override options if in the environment
 $OPTS{CQD_HOST}          = $ENV{CQD_HOST}
   if $ENV{CQD_HOST};
 # Override options if in the environment
 $OPTS{CQD_HOST}          = $ENV{CQD_HOST}
   if $ENV{CQD_HOST};
@@ -116,31 +116,31 @@ sub _tag ($) {
   my $tag  = YMDHMS;
      $tag .= ' ';
      $tag .= $self->{pid} ? "[$self->{pid}] " : '';
   my $tag  = YMDHMS;
      $tag .= ' ';
      $tag .= $self->{pid} ? "[$self->{pid}] " : '';
-  
+
   return "$tag$msg";
 } # _tag
 
   return "$tag$msg";
 } # _tag
 
-sub _verbose ($) {
+ sub _verbose ($) {
   my ($self, $msg) = @_;
 
   verbose $self->_tag ($msg);
   my ($self, $msg) = @_;
 
   verbose $self->_tag ($msg);
-  
+
   return;
 } # _verbose
 
 sub _debug ($) {
   my ($self, $msg) = @_;
   return;
 } # _verbose
 
 sub _debug ($) {
   my ($self, $msg) = @_;
-  
+
   debug $self->_tag ($msg);
   debug $self->_tag ($msg);
-  
+
   return;
 } # _debug
 
 sub _log ($) {
   my ($self, $msg) = @_;
   return;
 } # _debug
 
 sub _log ($) {
   my ($self, $msg) = @_;
-  
+
   display $self->_tag ($msg);
   display $self->_tag ($msg);
-  
+
   return;
 } # log
 
   return;
 } # log
 
@@ -149,9 +149,9 @@ sub _funeral () {
 
   while (my $childpid = waitpid (-1, WNOHANG) > 0) {
     my $status = $?;
 
   while (my $childpid = waitpid (-1, WNOHANG) > 0) {
     my $status = $?;
-  
+
     debug "childpid: $childpid - status: $status";
     debug "childpid: $childpid - status: $status";
-  
+
     if ($childpid != -1) {
       local $SIG{CHLD} = \&_funeral;
 
     if ($childpid != -1) {
       local $SIG{CHLD} = \&_funeral;
 
@@ -164,21 +164,21 @@ sub _funeral () {
       debug "All children reaped";
     } # if
   } # while
       debug "All children reaped";
     } # if
   } # while
-  
+
   return;
 } # _funeral
 
 sub _endServer () {
   display "CQDService V$VERSION shutdown at " . localtime;
   return;
 } # _funeral
 
 sub _endServer () {
   display "CQDService V$VERSION shutdown at " . localtime;
-  
+
   # Kill process group
   kill 'TERM', -$$;
   # Kill process group
   kill 'TERM', -$$;
-  
+
   # Wait for all children to die
   while (wait != -1) {
     # do nothing
   # Wait for all children to die
   while (wait != -1) {
     # do nothing
-  } # while 
-  
+  } # while
+
   # Now that we are alone, we can simply exit
   exit;
 } # _endServer
   # Now that we are alone, we can simply exit
   exit;
 } # _endServer
@@ -186,7 +186,7 @@ sub _endServer () {
 sub _restartServer () {
   # Not sure what to do on a restart server
   display 'Entered _restartServer';
 sub _restartServer () {
   # Not sure what to do on a restart server
   display 'Entered _restartServer';
-  
+
   return;
 } # _restartServer
 
   return;
 } # _restartServer
 
@@ -211,7 +211,7 @@ sub connectToServer (;$$) {
 
   $host ||= $OPTS{CQD_HOST};
   $port ||= $OPTS{CQD_PORT};
 
   $host ||= $OPTS{CQD_HOST};
   $port ||= $OPTS{CQD_PORT};
-  
+
   $self->{socket} = IO::Socket::INET->new (
     Proto       => 'tcp',
     PeerAddr    => $host,
   $self->{socket} = IO::Socket::INET->new (
     Proto       => 'tcp',
     PeerAddr    => $host,
@@ -219,7 +219,7 @@ sub connectToServer (;$$) {
   );
 
   return unless $self->{socket};
   );
 
   return unless $self->{socket};
-  
+
   $self->{socket}->autoflush;
 
   $self->{host} = $host;
   $self->{socket}->autoflush;
 
   $self->{host} = $host;
@@ -233,10 +233,10 @@ sub disconnectFromServer () {
 
   if ($self->{socket}) {
    close $self->{socket};
 
   if ($self->{socket}) {
    close $self->{socket};
-   
+
    undef $self->{socket};
   } # if
    undef $self->{socket};
   } # if
-  
+
   return;
 } # disconnectFromServer
 
   return;
 } # disconnectFromServer
 
@@ -249,7 +249,7 @@ sub _serviceClient ($$) {
   # Set autoflush for client
   $client->autoflush
     if $client;
   # Set autoflush for client
   $client->autoflush
     if $client;
-  
+
   # Input is simple and consists of the following:
   #
   # <recordType>=<ID>
   # Input is simple and consists of the following:
   #
   # <recordType>=<ID>
@@ -260,69 +260,69 @@ sub _serviceClient ($$) {
   #
   # Notes: <ID> can be <ID_scope>. Also a += means append this fieldvalue to
   # the existing value for the field.
   #
   # Notes: <ID> can be <ID_scope>. Also a += means append this fieldvalue to
   # the existing value for the field.
-  
+
   # First get record line
   my $line = <$client>;
   # First get record line
   my $line = <$client>;
-  
+
   if ($line) {
     chomp $line; chop $line if $line =~ /\r$/;
   } else {
     $self->_verbose ("Host $host went away!");
   if ($line) {
     chomp $line; chop $line if $line =~ /\r$/;
   } else {
     $self->_verbose ("Host $host went away!");
-    
+
     close $client;
     close $client;
-    
+
     return;
   } # if
     return;
   } # if
-  
+
   if ($line =~ /stopserver/i) {
     if ($self->{server}) {
       $self->_verbose ("$host requested to stop server [$self->{server}]");
   if ($line =~ /stopserver/i) {
     if ($self->{server}) {
       $self->_verbose ("$host requested to stop server [$self->{server}]");
-                
+
       # Send server hangup signal
       kill 'HUP', $self->{server};
     } else {
       $self->_verbose ('Shutting down server');
       # Send server hangup signal
       kill 'HUP', $self->{server};
     } else {
       $self->_verbose ('Shutting down server');
-        
+
       print $client "CQDService Status: 0\n";
       print $client "CQDService Status: 0\n";
-        
+
       exit;
     } # if
   } # if
 
   my ($record, $id) = split /=/, $line;
       exit;
     } # if
   } # if
 
   my ($record, $id) = split /=/, $line;
-  
+
   unless ($id) {
     $self->_verbose ('Garbled record line - rejected request');
   unless ($id) {
     $self->_verbose ('Garbled record line - rejected request');
-    
+
     close $client;
     close $client;
-    
+
     return;
   } # unless
     return;
   } # unless
-  
+
   $self->_verbose ("Client wishes to deal with $id");
   $self->_verbose ("Client wishes to deal with $id");
-  
+
   my $scope;
   my $scope;
-  
+
   if ($id =~ /_(\S+)/) {
     $scope = $1;
   } # if
   if ($id =~ /_(\S+)/) {
     $scope = $1;
   } # if
-  
+
   $self->_debug ("$host wants $record:$id");
   $self->_debug ("$host wants $record:$id");
-  
+
   my ($read, %fields);
   my ($read, %fields);
-    
-  # Now read name/value pairs  
+
+  # Now read name/value pairs
   while () {
     # Read command from client
   while () {
     # Read command from client
-    $line = <$client>; 
-    
+    $line = <$client>;
+
     if ($line) {
       chomp $line; chop $line if $line =~ /\r$/;
     } else {
       $self->_verbose ("Host $host went away!");
     if ($line) {
       chomp $line; chop $line if $line =~ /\r$/;
     } else {
       $self->_verbose ("Host $host went away!");
-      
+
       close $client;
       close $client;
-      
+
       return;
     } # if
 
       return;
     } # if
 
@@ -331,86 +331,86 @@ sub _serviceClient ($$) {
     # Collect name/values. Note if only names are requested then we will instead
     # return data.
     my ($name, $value) = split /=/, $line;
     # Collect name/values. Note if only names are requested then we will instead
     # return data.
     my ($name, $value) = split /=/, $line;
-      
+
     if ($value) {
       # Transform %0A's back to \n
       $value =~ s/\%0A/\n/g;
     if ($value) {
       # Transform %0A's back to \n
       $value =~ s/\%0A/\n/g;
-    
+
       $self->_verbose ("Will set $name to $value");
     } else {
       $read = 1;
       $self->_verbose ("Will retrieve $name");
       $self->_verbose ("Will set $name to $value");
     } else {
       $read = 1;
       $self->_verbose ("Will retrieve $name");
-    } # if 
-            
+    } # if
+
     $fields{$name} = $value;
   } # while
     $fields{$name} = $value;
   } # while
-  
+
   # Get record
   my $entity;
   # Get record
   my $entity;
-  
+
   $self->_verbose ("Getting $record:$id");
   $self->_verbose ("Getting $record:$id");
-  
+
   eval { $entity = $self->{session}->GetEntity ($record, $id) };
   eval { $entity = $self->{session}->GetEntity ($record, $id) };
-  
+
   unless ($entity) {
     print $client "Unable to GetEntity $record:$id\n";
   unless ($entity) {
     print $client "Unable to GetEntity $record:$id\n";
-    
+
     close $client;
     close $client;
-    
+
     return;
   } # unless
 
   if ($read) {
     print $client "$_@@" . $entity->GetFieldValue ($_)->GetValue . "\n"
     return;
   } # unless
 
   if ($read) {
     print $client "$_@@" . $entity->GetFieldValue ($_)->GetValue . "\n"
-      foreach (keys %fields);
+      for (keys %fields);
     print $client "CQD Status: 0\n";
     print $client "CQD Status: 0\n";
-    
+
     close $client;
     close $client;
-    
+
     return;
   } # if
     return;
   } # if
-    
+
   # Edit record
   $self->_verbose ("Editing $id");
   # Edit record
   $self->_verbose ("Editing $id");
-  
+
   $entity->EditEntity ('Backend');
   $entity->EditEntity ('Backend');
-  
+
   my $status;
   my $status;
-  
-  foreach my $fieldName (keys %fields) {
+
+  for my $fieldName (keys %fields) {
     if ($fieldName =~ /(.+)\*$/) {
       my $newValue = delete $fields{$fieldName};
 
       $fieldName = $1;
     if ($fieldName =~ /(.+)\*$/) {
       my $newValue = delete $fields{$fieldName};
 
       $fieldName = $1;
-      
+
       $fields{$fieldName} = $entity->GetFieldValue ($fieldName)->GetValue
                           . $newValue;
     } # if
 
     $self->_verbose ("Setting $fieldName to $fields{$fieldName}");
       $fields{$fieldName} = $entity->GetFieldValue ($fieldName)->GetValue
                           . $newValue;
     } # if
 
     $self->_verbose ("Setting $fieldName to $fields{$fieldName}");
-        
+
     $status = $entity->SetFieldValue ($fieldName, $fields{$fieldName});
     $status = $entity->SetFieldValue ($fieldName, $fields{$fieldName});
-    
+
     if ($status ne '') {
       $self->_verbose ($status);
     if ($status ne '') {
       $self->_verbose ($status);
-      
+
       print $client "$status\n";
       print $client "CQD Status: 1\n";
       print $client "$status\n";
       print $client "CQD Status: 1\n";
-      
+
       close $client;
       close $client;
-      
+
       return;
     } # if
       return;
     } # if
-  } # foreach
-  
+  } # for
+
   $self->_verbose ("Validating $id");
   $self->_verbose ("Validating $id");
-  
+
   $status = $entity->Validate;
   $status = $entity->Validate;
-  
+
   if ($status eq '') {
     $self->_verbose ('Committing');
     $entity->Commit;
   if ($status eq '') {
     $self->_verbose ('Committing');
     $entity->Commit;
-    
+
     print $client "Successfully updated $id\n";
     print $client "CQD Status: 0\n";
   } else {
     print $client "Successfully updated $id\n";
     print $client "CQD Status: 0\n";
   } else {
@@ -419,66 +419,66 @@ sub _serviceClient ($$) {
     print $client "$status\n";
     print $client "CQD Status: 1\n";
   } # if
     print $client "$status\n";
     print $client "CQD Status: 1\n";
   } # if
-  
+
   close $client;
   close $client;
-  
+
   $self->_verbose ("Serviced requests from $host");
   $self->_verbose ("Serviced requests from $host");
-  
+
   return;
 }  # _serviceClient
 
 sub execute (%) {
   my ($self, %request) = @_;
   return;
 }  # _serviceClient
 
 sub execute (%) {
   my ($self, %request) = @_;
-  
+
   $self->connectToServer or croak 'Unable to connect to CQD Service';
 
   return (-1, 'Unable to talk to server')
     unless $self->{socket};
   $self->connectToServer or croak 'Unable to connect to CQD Service';
 
   return (-1, 'Unable to talk to server')
     unless $self->{socket};
-  
+
   my ($status, @output) = (-1, ());
   my ($status, @output) = (-1, ());
-  
+
   my $server = $self->{socket};
   my $server = $self->{socket};
-  
+
   my $id = delete $request{id};
   my $id = delete $request{id};
-  
+
   print $server "$id\n";
   print $server "$id\n";
-  
+
   my $read;
   my $read;
-  
-  foreach (keys %request) {
+
+  for (keys %request) {
     if ($request{$_}) {
       print $server "$_=$request{$_}\n";
     } else {
       $read = 1;
       print $server "$_\n";
     } # if
     if ($request{$_}) {
       print $server "$_=$request{$_}\n";
     } else {
       $read = 1;
       print $server "$_\n";
     } # if
-  } # foreach
+  } # for
 
   print $server "end\n";
 
   print $server "end\n";
-  
+
   my ($response, %output);
   my ($response, %output);
-  
+
   while (defined ($response = <$server>)) {
     if ($response =~ /CQD Status: (-*\d+)/) {
       $status = $1;
       last;
     } # if
   while (defined ($response = <$server>)) {
     if ($response =~ /CQD Status: (-*\d+)/) {
       $status = $1;
       last;
     } # if
-    
+
     if ($read) {
       chomp $response; chop $response if $response =~ /\r$/;
     if ($read) {
       chomp $response; chop $response if $response =~ /\r$/;
-      
+
       my ($field, $value) = split /\@\@/, $response;
       my ($field, $value) = split /\@\@/, $response;
-      
+
       $output{$field} = $value;
     } else {
       push @output, $response;
     } # if
   } # while
       $output{$field} = $value;
     } else {
       push @output, $response;
     } # if
   } # while
-  
+
   chomp @output unless $read;
   chomp @output unless $read;
-  
+
   $self->disconnectFromServer;
   $self->disconnectFromServer;
-  
+
   if ($status != 0 or $read == 0) {
     return ($status, @output);
   } else {
   if ($status != 0 or $read == 0) {
     return ($status, @output);
   } else {
@@ -487,9 +487,9 @@ sub execute (%) {
 } # execute
 
 sub startServer (;$$$$$) {
 } # execute
 
 sub startServer (;$$$$$) {
-  
+
   require 'Clearquest.pm';
   require 'Clearquest.pm';
-  
+
   my ($self, $port, $username, $password, $db, $dbset) = @_;
 
   $port     ||= $OPTS{CQD_PORT};
   my ($self, $port, $username, $password, $db, $dbset) = @_;
 
   $port     ||= $OPTS{CQD_PORT};
@@ -497,7 +497,7 @@ sub startServer (;$$$$$) {
   $password ||= $OPTS{CQD_PASSWORD};
   $db       ||= $OPTS{CQD_DATABASE};
   $dbset    ||= $OPTS{CQD_DBSET};
   $password ||= $OPTS{CQD_PASSWORD};
   $db       ||= $OPTS{CQD_DATABASE};
   $dbset    ||= $OPTS{CQD_DBSET};
-  
+
   # Create new socket to communicate to clients with
   $self->{socket} = IO::Socket::INET->new(
     Proto     => 'tcp',
   # Create new socket to communicate to clients with
   $self->{socket} = IO::Socket::INET->new(
     Proto     => 'tcp',
@@ -518,7 +518,7 @@ sub startServer (;$$$$$) {
 
   # Announce ourselves
   $self->_log ("CQD V$VERSION accepting clients at " . localtime);
 
   # Announce ourselves
   $self->_log ("CQD V$VERSION accepting clients at " . localtime);
-  
+
   # Now wait for an incoming request
   LOOP:
   my $client;
   # Now wait for an incoming request
   LOOP:
   my $client;
@@ -538,7 +538,7 @@ sub startServer (;$$$$$) {
 
       error "Can't fork: $!"
         unless defined ($childpid = fork);
 
       error "Can't fork: $!"
         unless defined ($childpid = fork);
-        
+
       if ($childpid) {
         $self->{pid} = $$;
 
       if ($childpid) {
         $self->{pid} = $$;
 
@@ -600,7 +600,7 @@ L<POSIX>
 
 =head2 ClearSCM Perl Modules
 
 
 =head2 ClearSCM Perl Modules
 
-=begin man 
+=begin man
 
  DateUtils
  Display
 
  DateUtils
  Display
ClearSCM Source Repository. Note parts of this repo are under GPL. Other parts are copyright ClearSCM, Inc.