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
29our $VERSION = '0.04';
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;
212    my $host = Amiga::ARexx->new('HostName' => "PERLREXX" );
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
265    my $host = Amiga::ARexx->new( HostName => "PERLREXX");
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
312Retreive the message "command" as a string;
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
356