2 ################################################################################
6 # Description: Perl Module interface to cqd (ClearQuest Daemon). This is used
7 # by cqc and cgi script to talk to cqd.
8 # Author: Andrew@DeFaria.com
9 # Created: Fri May 31 15:34:50 2002
10 # Modified: 2007/05/17 07:45:48
13 # (c) Copyright 2007, ClearSCM, Inc., all rights reserved.
15 ################################################################################
34 my $default_server = "sons-clearcase";
38 my $cqcversion = "1.0";
40 # Reopen STDOUT. This is because cqperl screws around with STDOUT in some
42 open STDOUT, ">-" or die "Unable to reopen STDOUT\n";
43 # Set unbuffered output for the same reason (cqperl)
48 print "@_\n" if defined ($verbose);
56 if (!defined ($host)) {
60 $cqserver = ConnectToServer ($host);
63 verbose "Connected to $host";
64 SendServerAck ($cqserver);
73 if ($cqc::command eq "shutdown") {
74 $msg = "Disconnected from server - shutdown server";
76 $cqc::command = "quit";
77 $msg = "Disconnected from server";
79 SendServerCmd ($cqserver, $cqc::command);
80 GetServerAck ($cqserver);
94 verbose "Not connected to server yet!\n";
95 verbose "Attempting connection to $default_server...\n";
96 $result = Connect ($default_server);
97 return -1 if !defined ($result);
100 SendServerCmd ($cqserver, $bugid);
101 GetServerAck ($cqserver);
102 $result = GetServerResponse ($cqserver, %fields);
103 SendServerAck ($cqserver);
112 sub ConnectToServer {
115 # create a tcp connection to the specified host and port
116 return IO::Socket::INET->new(Proto => "tcp",
124 print $server "ACK\n";
131 while (defined ($srvresp = <$server>)) {
133 if ($srvresp eq "ACK") {
136 print "Received $srvresp from server - expected ACK\n";
140 sub GetServerResponse {
148 while (defined ($srvresp = <$server>)) {
150 last if $srvresp eq "ACK";
151 if ($srvresp =~ m/Bug ID.*was not found/) {
154 $srvresp =~ /(^\w+):\s+(.*)/s;
160 } # GetServerResponse
166 print $server "$command\n";