X-Git-Url: https://defaria.com/gitweb/?a=blobdiff_plain;f=lib%2FClearquest%2FDBService.pm;h=b1c73c0ffdf639a5b9b601119ae624db0a312f9f;hb=7ddf095f187ca60d9a70fb83b2bc3c2b6d91f088;hp=0ca5300927c71b945a9103c6b00d7dbf145bd9c8;hpb=020a4a5ea2be725b155cae3a2cadc9aba3911b9b;p=clearscm.git diff --git a/lib/Clearquest/DBService.pm b/lib/Clearquest/DBService.pm index 0ca5300..b1c73c0 100644 --- 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. -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 @@ -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 -id should be defined that has a value of "=" (e.g. +id should be defined that has a value of "=" (e.g. "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 -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 @@ -83,7 +83,7 @@ our %OPTS = GetConfig $config; our $VERSION = '$Revision: 1.2 $'; ($VERSION) = ($VERSION =~ /\$Revision: (.*) /); - + # 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}] " : ''; - + return "$tag$msg"; } # _tag -sub _verbose ($) { + sub _verbose ($) { my ($self, $msg) = @_; verbose $self->_tag ($msg); - + return; } # _verbose sub _debug ($) { my ($self, $msg) = @_; - + debug $self->_tag ($msg); - + return; } # _debug sub _log ($) { my ($self, $msg) = @_; - + display $self->_tag ($msg); - + return; } # log @@ -149,9 +149,9 @@ sub _funeral () { while (my $childpid = waitpid (-1, WNOHANG) > 0) { my $status = $?; - + debug "childpid: $childpid - status: $status"; - + if ($childpid != -1) { local $SIG{CHLD} = \&_funeral; @@ -164,21 +164,21 @@ sub _funeral () { debug "All children reaped"; } # if } # while - + return; } # _funeral sub _endServer () { display "CQDService V$VERSION shutdown at " . localtime; - + # Kill process group kill 'TERM', -$$; - + # Wait for all children to die while (wait != -1) { # do nothing - } # while - + } # while + # 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'; - + return; } # _restartServer @@ -211,7 +211,7 @@ sub connectToServer (;$$) { $host ||= $OPTS{CQD_HOST}; $port ||= $OPTS{CQD_PORT}; - + $self->{socket} = IO::Socket::INET->new ( Proto => 'tcp', PeerAddr => $host, @@ -219,7 +219,7 @@ sub connectToServer (;$$) { ); return unless $self->{socket}; - + $self->{socket}->autoflush; $self->{host} = $host; @@ -233,10 +233,10 @@ sub disconnectFromServer () { if ($self->{socket}) { close $self->{socket}; - + undef $self->{socket}; } # if - + return; } # disconnectFromServer @@ -249,7 +249,7 @@ sub _serviceClient ($$) { # Set autoflush for client $client->autoflush if $client; - + # Input is simple and consists of the following: # # = @@ -260,69 +260,69 @@ sub _serviceClient ($$) { # # Notes: can be . Also a += means append this fieldvalue to # the existing value for the field. - + # First get record line my $line = <$client>; - + if ($line) { chomp $line; chop $line if $line =~ /\r$/; } else { $self->_verbose ("Host $host went away!"); - + close $client; - + return; } # if - + 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'); - + print $client "CQDService Status: 0\n"; - + exit; } # if } # if my ($record, $id) = split /=/, $line; - + unless ($id) { $self->_verbose ('Garbled record line - rejected request'); - + close $client; - + return; } # unless - + $self->_verbose ("Client wishes to deal with $id"); - + my $scope; - + if ($id =~ /_(\S+)/) { $scope = $1; } # if - + $self->_debug ("$host wants $record:$id"); - + my ($read, %fields); - - # Now read name/value pairs + + # Now read name/value pairs 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!"); - + close $client; - + 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; - + 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"); - } # if - + } # if + $fields{$name} = $value; } # while - + # Get record my $entity; - + $self->_verbose ("Getting $record:$id"); - + eval { $entity = $self->{session}->GetEntity ($record, $id) }; - + unless ($entity) { print $client "Unable to GetEntity $record:$id\n"; - + close $client; - + return; } # unless if ($read) { print $client "$_@@" . $entity->GetFieldValue ($_)->GetValue . "\n" - foreach (keys %fields); + for (keys %fields); print $client "CQD Status: 0\n"; - + close $client; - + return; } # if - + # Edit record $self->_verbose ("Editing $id"); - + $entity->EditEntity ('Backend'); - + my $status; - - foreach my $fieldName (keys %fields) { + + for my $fieldName (keys %fields) { if ($fieldName =~ /(.+)\*$/) { my $newValue = delete $fields{$fieldName}; $fieldName = $1; - + $fields{$fieldName} = $entity->GetFieldValue ($fieldName)->GetValue . $newValue; } # if $self->_verbose ("Setting $fieldName to $fields{$fieldName}"); - + $status = $entity->SetFieldValue ($fieldName, $fields{$fieldName}); - + if ($status ne '') { $self->_verbose ($status); - + print $client "$status\n"; print $client "CQD Status: 1\n"; - + close $client; - + return; } # if - } # foreach - + } # for + $self->_verbose ("Validating $id"); - + $status = $entity->Validate; - + if ($status eq '') { $self->_verbose ('Committing'); $entity->Commit; - + 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 - + close $client; - + $self->_verbose ("Serviced requests from $host"); - + 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}; - + my ($status, @output) = (-1, ()); - + my $server = $self->{socket}; - + my $id = delete $request{id}; - + print $server "$id\n"; - + my $read; - - foreach (keys %request) { + + for (keys %request) { if ($request{$_}) { print $server "$_=$request{$_}\n"; } else { $read = 1; print $server "$_\n"; } # if - } # foreach + } # for print $server "end\n"; - + my ($response, %output); - + while (defined ($response = <$server>)) { if ($response =~ /CQD Status: (-*\d+)/) { $status = $1; last; } # if - + if ($read) { chomp $response; chop $response if $response =~ /\r$/; - + my ($field, $value) = split /\@\@/, $response; - + $output{$field} = $value; } else { push @output, $response; } # if } # while - + chomp @output unless $read; - + $self->disconnectFromServer; - + if ($status != 0 or $read == 0) { return ($status, @output); } else { @@ -487,9 +487,9 @@ sub execute (%) { } # execute sub startServer (;$$$$$) { - + require 'Clearquest.pm'; - + 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}; - + # 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); - + # Now wait for an incoming request LOOP: my $client; @@ -538,7 +538,7 @@ sub startServer (;$$$$$) { error "Can't fork: $!" unless defined ($childpid = fork); - + if ($childpid) { $self->{pid} = $$; @@ -600,7 +600,7 @@ L =head2 ClearSCM Perl Modules -=begin man +=begin man DateUtils Display @@ -611,9 +611,9 @@ L =begin html
-DateUtils
-Display
-GetConf
+DateUtils
+Display
+GetConf
=end html