2 ################################################################################
4 # File: ecrd.pm: ECR Daemon Client Library
5 # Description: Perl Module interface to ecrd (ECR Daemon). This is used
6 # by ecrc and cgi scripts to talk to ECR Daemon
7 # Author: Andrew@DeFaria.com
8 # Created: Tue Feb 15 09:40:57 PST 2005
12 # (c) Copyright 2005, LynuxWorks, all rights reserved.
14 ################################################################################
22 @main::ISA = qw (Exporter);
24 @main::EXPORT = qw (Connect GetECRRecord Disconnect);
26 my $default_server = (!defined $ENV {ECRDSERVER}) ? "lynx12" : $ENV {ECRDSERVER};
27 my $default_port = (!defined $ENV {ECRDPORT}) ? 1500 : $ENV {ECRDPORT};
37 sub GetServerResponse;
42 my $ecrcversion = "1.1";
44 # Reopen STDOUT to make sure it's clear
45 open STDOUT, ">-" or die "Unable to reopen STDOUT\n";
47 # Set unbuffered output
60 print "@_\n" if $verbose;
64 print "DEBUG: @_\n" if $debug;
73 $host = $default_server if !defined $host;
74 $port = $default_port if !defined $port;
76 $ecrserver = ConnectToServer $host, $port;
79 verbose "Connected to $host";
80 SendServerAck $ecrserver;
90 if ($command eq "shutdown") {
91 $msg = "Disconnected from server - shutdown server";
94 $msg = "Disconnected from server";
96 SendServerCmd $ecrserver, $command;
97 GetServerAck $ecrserver;
111 verbose "Not connected to server yet!";
112 verbose "Attempting connection to $default_server...";
113 if (!Connect $default_server, $default_port) {
114 print "Unable to connect to server $default_server\n";
119 SendServerCmd $ecrserver, $ecr;
120 GetServerAck $ecrserver;
123 @ecrs = GetServerList $ecrserver;
125 %fields = GetServerResponse $ecrserver;
128 SendServerAck $ecrserver;
130 return $ecr eq "\*" ? @ecrs : %fields;
134 verbose "Sending disconnect command to server";
139 sub ConnectToServer {
143 # create a tcp connection to the specified host and port
144 return IO::Socket::INET->new(Proto => "tcp",
152 print $server "ACK\n";
159 while (defined ($srvresp = <$server>)) {
161 if ($srvresp eq "ACK") {
164 print "Received $srvresp from server - expected ACK\n";
174 while (defined ($srvresp = <$server>)) {
176 last if $srvresp eq "ACK";
177 if ($srvresp =~ m/ECR.*was not found/) {
180 push @ecrs, $srvresp;
187 sub GetServerResponse {
193 while (defined ($srvresp = <$server>)) {
195 last if $srvresp eq "ACK";
196 if ($srvresp =~ m/ECR.*was not found/) {
199 $srvresp =~ /(^\w+):\s+(.*)/s;
201 if (defined $value) {
202 $value =~ s/\\n/\n/g;
206 $fields {$1} = $value;
211 } # GetServerResponse
217 print $server "$command\n";