Added client work scripts

[clearscm.git] / clients / LynuxWorks / lib / ecrc.pm

diff --git a/clients/LynuxWorks/lib/ecrc.pm b/clients/LynuxWorks/lib/ecrc.pm
new file mode 100644 (file)
index 0000000..456edc3
--- /dev/null
+++ b/clients/LynuxWorks/lib/ecrc.pm
@@ -0,0 +1,220 @@
+#!/usr/bin/perl
+################################################################################
+#
+# File:                ecrd.pm: ECR Daemon Client Library
+# Description:  Perl Module interface to ecrd (ECR Daemon). This is used
+#              by ecrc and cgi scripts to talk to ECR Daemon
+# Author:       Andrew@DeFaria.com
+# Created:      Tue Feb 15 09:40:57 PST 2005
+# Modified:
+# Language:     Perl
+#
+# (c) Copyright 2005, LynuxWorks, all rights reserved.
+#
+################################################################################
+use strict;
+use warnings;
+
+use IO::Socket;
+
+package ecrc;
+  require Exporter;
+  @main::ISA = qw (Exporter);
+
+  @main::EXPORT = qw (Connect GetECRRecord Disconnect);
+
+  my $default_server   = (!defined $ENV {ECRDSERVER}) ? "lynx12" : $ENV {ECRDSERVER};
+  my $default_port     = (!defined $ENV {ECRDPORT})   ? 1500     : $ENV {ECRDPORT};
+  my $verbose          = 0;
+  my $debug            = 0;
+  my $command;
+  my $ecrserver;
+
+  # Forwards
+  sub ConnectToServer;
+  sub GetServerAck;
+  sub GetServerList;
+  sub GetServerResponse;
+  sub SendServerAck;
+  sub SendServerCmd;
+
+  BEGIN {
+    my $ecrcversion = "1.1";
+
+    # Reopen STDOUT to make sure it's clear
+    open STDOUT, ">-" or die "Unable to reopen STDOUT\n";
+
+    # Set unbuffered output
+    $| = 1;
+  } # BEGIN
+
+  sub set_verbose {
+    $verbose = 1;
+  } # set_verbose
+
+  sub set_debug {
+    $debug = 1;
+  } # set_debug
+
+  sub verbose {
+    print "@_\n" if $verbose;
+  } # verbose
+
+  sub debug {
+    print "DEBUG: @_\n" if $debug;
+  } # debug
+
+  sub Connect {
+    my $host = shift;
+    my $port = shift;
+
+    my $result;
+
+    $host = $default_server if !defined $host;
+    $port = $default_port   if !defined $port;
+
+    $ecrserver = ConnectToServer $host, $port;
+
+    if ($ecrserver) {
+      verbose "Connected to $host";
+      SendServerAck $ecrserver;
+    } # if
+
+    return $ecrserver;
+  } # Connect
+
+  sub Disconnect {
+    my $msg;
+
+    if ($ecrserver) {
+      if ($command eq "shutdown") {
+       $msg = "Disconnected from server - shutdown server";
+      } else {
+       $command = "quit";
+       $msg     = "Disconnected from server";
+      } # if
+      SendServerCmd $ecrserver, $command;
+      GetServerAck  $ecrserver;
+      verbose "$msg";
+      close $ecrserver;
+      undef $ecrserver;
+    } # if
+  } # Disconnect
+
+  sub GetECRRecord {
+    my $ecr = shift;
+
+    my %fields;
+    my @ecrs;
+
+    if (!$ecrserver) {
+      verbose "Not connected to server yet!";
+      verbose "Attempting connection to $default_server...";
+      if (!Connect $default_server, $default_port) {
+       print "Unable to connect to server $default_server\n";
+       exit 1;
+      } # if
+    } # if
+
+    SendServerCmd $ecrserver, $ecr;
+    GetServerAck  $ecrserver;
+
+    if ($ecr eq "\*") {
+      @ecrs = GetServerList $ecrserver;
+    } else {
+      %fields = GetServerResponse $ecrserver;
+    } # if
+
+   SendServerAck $ecrserver;
+
+    return $ecr eq "\*" ? @ecrs : %fields;
+  } # GetECRRecord
+
+  END {
+    verbose "Sending disconnect command to server";
+    $command = "quit";
+    Disconnect;
+  } # END
+
+  sub ConnectToServer {
+    my $host = shift;
+    my $port = shift;
+
+    # create a tcp connection to the specified host and port
+    return IO::Socket::INET->new(Proto     => "tcp",
+                                PeerAddr  => $host,
+                                PeerPort  => $port);
+  } # ConnectToServer
+
+  sub SendServerAck {
+    my $server = shift;
+
+    print $server "ACK\n";
+  } # SendServerAck
+
+  sub GetServerAck {
+    my $server = shift;
+    my $srvresp;
+
+    while (defined ($srvresp = <$server>)) {
+      chomp $srvresp;
+      if ($srvresp eq "ACK") {
+       return;
+      } # if
+      print "Received $srvresp from server - expected ACK\n";
+    } # while
+  } # GetServerAck
+
+  sub GetServerList {
+    my $server = shift;
+
+    my @ecrs;
+    my $srvresp;
+
+    while (defined ($srvresp = <$server>)) {
+      chomp $srvresp;
+      last if $srvresp eq "ACK";
+      if ($srvresp =~ m/ECR.*was not found/) {
+       return ();
+      } else {
+       push @ecrs, $srvresp;
+      } # if
+    } # while
+
+    return @ecrs;
+  } # GetServerList
+
+  sub GetServerResponse {
+    my $server = shift;
+
+    my %fields;
+    my $srvresp;
+
+    while (defined ($srvresp = <$server>)) {
+      chomp $srvresp;
+      last if $srvresp eq "ACK";
+      if ($srvresp =~ m/ECR.*was not found/) {
+       return ();
+      } else {
+       $srvresp =~ /(^\w+):\s+(.*)/s;
+        my $value = $2;
+       if (defined $value) {
+         $value =~ s/\\n/\n/g;
+       } else {
+         $value = "";
+       } # if
+       $fields {$1} = $value;
+      } # if
+    } # while
+
+    return %fields;
+  } # GetServerResponse
+
+  sub SendServerCmd {
+    my $server  = shift;
+    my $command = shift;
+
+    print $server "$command\n";
+  } # SendServerCmd
+
+1;