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