/[scire]/branches/new-fu/client/Scire.pm
Gentoo

Contents of /branches/new-fu/client/Scire.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 328 - (show annotations) (download) (as text)
Sat Jan 5 05:24:56 2008 UTC (6 years, 7 months ago) by agaffney
File MIME type: text/x-perl
File size: 3093 byte(s)
only import open2 from IPC::Open2
1 package Scire::Job;
2
3 sub new {
4 my $proto = shift;
5 my $class = ref($proto) || $proto;
6 my $filename = shift;
7 my $self = {};
8 bless ($self, $class);
9 if(defined $filename) {
10 $self->set_filename($filename);
11 }
12 return $self;
13 }
14
15 sub set_filename {
16 my $self = shift;
17 my $filename = shift;
18 $self->{filename} = $filename;
19 my $jobcontents;
20 my $jobdata;
21 open JOB, "< ${filename}" or die "Can't open file ${filename}";
22 $jobcontents = join("", <JOB>);
23 close JOB;
24 $jobdata = eval($jobcontents);
25 ($@) and print "ERROR: Could not parse job file ${filename}!\n";
26 if(defined $jobdata->{script}) {
27 for(keys %{$jobdata->{script}}) {
28 $self->{$_} = $jobdata->{script}->{$_};
29 }
30 }
31 for(keys %{$jobdata}) {
32 $self->{$_} = $jobdata->{$_} unless($_ eq "script");
33 }
34 }
35
36 package Scire::Communicator;
37
38 use IPC::Open2 (open2);
39
40 sub new {
41 my $proto = shift;
42 my $class = ref($proto) || $proto;
43 my $self = {
44 port => 22,
45 user => scire,
46 server_script => "/usr/bin/scireserver.pl",
47 SERVER_STDOUT => undef,
48 SERVER_STDIN => undef,
49 @_
50 };
51 bless ($self, $class);
52 $self->build_connection_command();
53 return $self;
54 }
55
56 sub send_command {
57 my $self = shift;
58 my $cmd = shift;
59 my @args = @_;
60 my $tosend = "${cmd}";
61
62 for my $arg (@args) {
63 if($arg =~ /^[0-9]+$/) {
64 $tosend .= " ${arg}";
65 } else {
66 $arg =~ s/"/\\"/g;
67 $tosend .= " \"${arg}\"";
68 }
69 }
70 $tosend .= "\n";
71
72 my ($tmpin, $tmpout) = ($self->{SERVER_STDIN}, $self->{SERVER_STDOUT});
73 print $tmpin $tosend;
74 #FIXME WE NEED A TIMEOUT HERE OF SOME SORT!!
75 #if the server doesn't give you a newline this just hangs!
76 my $response = <$tmpout>;
77 return $self->parse_response($response);
78 }
79
80 sub parse_response {
81 my $self = shift;
82 my $response = shift;
83 $response =~ /^(OK|ERROR)(?: (.+?))?\s*$/;
84 my ($status, $message) = ($1, $2);
85 return ($status, $message);
86 }
87
88 sub create_connection {
89 my $self = shift;
90 # XXX: How do we capture this error? $pid has a valid value even if the
91 # process fails to run, since it just returns the PID of the forked perl
92 # process. I tried adding 'or die' after it, but it didn't help since it
93 # doesn't fail in the main process. When it fails, it outputs an error
94 # to STDERR:
95 # open2: exec of ../server/scireserver.pl failed at ./scireclient.pl line 116
96 $self->{connection_pid} = open2($self->{SERVER_STDOUT}, $self->{SERVER_STDIN}, $self->{connection_command});
97 }
98
99 sub build_connection_command {
100 my $self = shift;
101 # This will eventually be something like "ssh scire@${scireserver} /usr/bin/scireserver.pl"
102 my $connection_command = "ssh ";
103 $connection_command .= "-o BatchMode yes ";
104 $connection_command .= "-o SendEnv 'SCIRE_*' ";
105 $connection_command .= "-o ServerAliveInterval 15 -o ServerAliveCountMax 4 ";
106 if(defined($self->{port})) {
107 $connection_command .= "-o Port=$conf{port} ";
108 }
109 $connection_command .= "$self->{user}\@$self->{host} $self->{server_script}";
110
111 if (-d ".svn") {
112 # Overwrite $connection_command in the case of a dev environment for now
113 $connection_command = "../server/scireserver.pl";
114 }
115 $self->{connection_command} = $connection_command;
116 }
117
118
119 1;

Properties

Name Value
svn:keywords Id

  ViewVC Help
Powered by ViewVC 1.1.20