This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix typos
[perl5.git] / ext / Amiga-ARexx / ARexx.pm
CommitLineData
4ceeac64
AB
1package Amiga::ARexx;
2
3use 5.016000;
4use strict;
5use warnings;
6use Carp;
7
8require Exporter;
9#use AutoLoader;
10
11our @ISA = qw(Exporter);
12
13# Items to export into callers namespace by default. Note: do not export
14# names by default without a very good reason. Use EXPORT_OK instead.
15# Do not simply export all your public functions/methods/constants.
16
17# This allows declaration use Amiga::Classes::ARexx ':all';
18# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
19# will save memory.
20our %EXPORT_TAGS = ( 'all' => [ qw(
21DoRexx
22) ] );
23
24our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
25
26our @EXPORT = qw(
27);
28
f1460a66 29our $VERSION = '0.05';
4ceeac64
AB
30
31require XSLoader;
32XSLoader::load('Amiga::ARexx', $VERSION);
33
34sub new
35{
36 my $class = shift;
37 my $self = bless {}, $class;
38 return $self->__init(@_);
39}
40
41sub __init
42{
43 my $self = shift;
44 my %params = @_;
45 my @tags = ();
46
47 if(exists $params{'HostName'})
48 {
49 $self->{'__hostname'} = $params{'HostName'};
50 } else { croak "HostName required";}
51
52 $self->{'__host'} = Amiga::ARexx::Host_init($self->{'__hostname'});
53 if (defined $self->{'__host'} && $self->{'__host'} != 0)
54 {
55 }
56 else
57 {
58 croak "Unabel to initialise Arexx Host";
59 }
60 return $self;
61}
62
63sub wait
64{
65 my $self = shift;
66 my %params = @_;
67 my $timeout = -1;
68 if ((exists $params{'TimeOut'}) && (defined $params{'TimeOut'}))
69 {
70 $timeout = $params{'TimeOut'};
71 $timeout += 0; # force number
72 }
73 Amiga::ARexx::Host_wait($self->{'__host'},$timeout);
74
75}
76
77sub signal
78{
79 my $self = shift;
80 return Amiga::ARexx::Host_signal($self->{'__host'});
81}
82
83sub getmsg
84{
85 my $self = shift;
86 my $msg;
87 my $msgobj;
88
89 if(defined $self->{'__host'})
90 {
91 $msg = Amiga::ARexx::Host_getmsg($self->{'__host'});
92 if($msg)
93 {
94 $msgobj = Amiga::ARexx::Msg->new('Message' => $msg);
95 }
96 }
97 return $msgobj;
98}
99
100sub DESTROY
101{
102 my $self = shift;
103 if(exists $self->{'__host'} && defined $self->{'__host'})
104 {
105 Amiga::ARexx::Host_delete($self->{'__host'});
106 delete $self->{'__host'};
107 }
108}
109
110sub DoRexx($$)
111{
112 my ($port,$command) = @_;
113 my $rc = 0;
114 my $rc2 = 0;
115 my $result = Amiga::ARexx::_DoRexx($port,$command,$rc,$rc2);
116 return ($rc,$rc2,$result);
117}
118
119package Amiga::ARexx::Msg;
120
121use strict;
122use warnings;
123use Carp;
124
125sub new
126{
127 my $class = shift;
128 my $self = bless {}, $class;
129 return $self->__init(@_);
130}
131
132sub __init
133{
134 my $self = shift;
135 my %params = @_;
136
137 if(exists $params{'Message'})
138 {
139 $self->{'__msg'} = $params{'Message'};
140 } else { croak "Message required";}
141
142 $self->{'__message'} = Amiga::ARexx::Msg_argstr($self->{'__msg'});
143 return $self;
144}
145
146sub message
147{
148 my $self = shift;
149 return $self->{'__message'};
150}
151
152sub reply($$$$)
153{
154 my ($self,$rc,$rc2,$result) = @_;
155 if(exists $self->{'__msg'} && defined $self->{'__msg'})
156 {
157 Amiga::ARexx::Msg_reply($self->{'__msg'},$rc,$rc2,$result);
158 }
159}
160
161sub setvar($$$)
162{
163 my ($self,$varname,$value) = @_;
164 if(exists $self->{'__msg'} && defined $self->{'__msg'})
165 {
166 Amiga::ARexx::Msg_setvar($self->{'__msg'},$varname,$value);
167 }
168}
169
170sub getvar($$)
171{
172 my ($self,$varname) = @_;
173 if(exists $self->{'__msg'} && defined $self->{'__msg'})
174 {
175 return Amiga::ARexx::Msg_getvar($self->{'__msg'},$varname);
176 }
177}
178
179sub DESTROY
180{
181 my $self = shift;
182 if(exists $self->{'__msg'} && defined $self->{'__msg'})
183 {
184 Amiga::ARexx::Msg_delete($self->{'__msg'});
185 delete $self->{'__msg'};
186 }
187}
188
189# Preloaded methods go here.
190
191# Autoload methods go after =cut, and are processed by the autosplit program.
192
1931;
194__END__
195# Below is stub documentation for your module. You'd better edit it!
196
197=head1 NAME
198
199Amiga::ARexx - Perl extension for ARexx support
200
201=head1 ABSTRACT
202
203This a perl class / module to enable you to use ARexx with
204your perlscript. Creating a function host or executing scripts in other hosts.
205The API is loosley modeled on the python arexx module supplied by with AmigaOS4.1
206
207=head1 SYNOPSIS
208
209 # Create a new host
210
211 use Amiga::ARexx;
e46aa1dd 212 my $host = Amiga::ARexx->new('HostName' => "PERLREXX" );
4ceeac64
AB
213
214 # Wait for and process rexxcommands
215
216 my $alive = 1;
217
218 while ($alive)
219 {
220 $host->wait();
221 my $msg = $host->getmsg();
222 while($msg)
223 {
224 my $rc = 0;
225 my $rc2 = 0;
226 my $result = "";
227
228 print $msg->message . "\n";
229 given($msg->message)
230 {
231 when ("QUIT")
232 {
233 $alive = 0;
234 $result = "quitting!";
235 }
236 default {
237 $rc = 10;
238 $rc2 = 22;
239 }
240 }
241 $msg->reply($rc,$rc2,$result);
242
243 $msg = $host->getmsg();
244 }
245
246 }
247
248 # Send a command to a host
249
250 my $port = "SOMEHOST";
251 my $command = "SOMECOMMAND";
252 my ($rc,$rc2,$result) = Amiga::ARexx->DoRexx($port,$command);
253
254
255
256=head1 DESCRIPTION
257
258The interface to the arexx.class in entirely encapsulated within the perl class, there
259is no need to access the low level methods directly and they are not exported by default.
260
261=head1 Amiga::ARexx METHODS
262
263=head2 new
264
e46aa1dd 265 my $host = Amiga::ARexx->new( HostName => "PERLREXX");
4ceeac64
AB
266
267
268Create an ARexx host for your script / program.
269
270=head3 HostName
271
272The HostName for the hosts command port. This is madatory, the program will fail if not
273provided.
274
275
276=head2 wait
277
278 $host->wait('TimeOut' => $timeoutinusecs );
279
280Wait for a message to arive at the port.
281
282=head3 TimeOut
283
284optional time out in microseconds.
285
286
287=head2 getmsg
288
289 $msg = $host->getmsg();
290
291
292Fetch an ARexx message from the host port. Returns an objrct of class Amiga::ARexx::Msg
293
294=head2 signal
295
296 $signal = $host->signal()
297
298Retrieve the signal mask for the host port for use with Amiga::Exec Wait()
299
300=head2 DoRexx
301
302 ($rc,$rc2,$result) = DoRexx("desthost","commandstring");
303
304Send the "commandstring" to host "desthost" for execution. Commandstring might be a specific command or scriptname.
305
306=head1 Amiga::ARexx::Msg METHODS
307
308=head2 message
309
310 $m = $msg->message();
311
f1460a66 312Retrieve the message "command" as a string;
4ceeac64
AB
313
314
315=head2 reply
316
317 $msg->reply($rc,$rc2,$result)
318
319Reply the message returning the results of any command. Set $rc = 0 for success and $result to the result string if appropriate.
320
321Set $rc to non zero for error and $rc2 for an additional error code if appropriate.
322
323=head2 setvar
324
325 $msg->setvar($varname,$value)
326
327Set a variable in the language context sending this message.
328
329=head2 getvar
330
331 $value = $msg->getvar($varname)
332
333Get the value of a variable in the language context sending this message.
334
335
336=head2 EXPORT
337
338None by default.
339
340=head2 Exportable constants
341
342None
343
344=head1 AUTHOR
345
346Andy Broad <andy@broad.ology.org.uk>
347
348=head1 COPYRIGHT AND LICENSE
349
350Copyright (C) 2013 by Andy Broad.
351
352=cut
353
354
355