File Coverage

blib/lib/Net/Citadel.pm
Criterion Covered Total %
statement 29 180 16.1
branch 1 56 1.7
condition 2 69 2.9
subroutine 9 24 37.5
pod 15 16 93.7
total 56 345 16.2


line stmt bran cond sub pod time code
1             package Net::Citadel;
2              
3 1     1   57037 use strict;
  1         9  
  1         25  
4 1     1   4 use warnings;
  1         1  
  1         31  
5              
6             require Exporter;
7 1     1   4 use base qw(Exporter);
  1         1  
  1         162  
8              
9 1     1   9 use Carp qw( croak );
  1         2  
  1         65  
10              
11 1     1   440 use IO::Socket;
  1         18571  
  1         4  
12 1     1   875 use Data::Dumper;
  1         5717  
  1         54  
13              
14 1     1   483 use Readonly;
  1         3200  
  1         392  
15              
16             =pod
17              
18             =head1 NAME
19              
20             Net::Citadel - Citadel.org protocol coverage
21              
22             =head1 VERSION
23              
24             Version 0.25
25              
26             =cut
27              
28             our $VERSION = '0.25';
29              
30             =head1 SYNOPSIS
31              
32             use Net::Citadel;
33             my $c = new Net::Citadel (host => 'citadel.example.org');
34             $c->login ('Administrator', 'goodpassword');
35             my @floors = $c->floors;
36              
37             eval {
38             $c->assert_floor ('Level 6 (Management)');
39             }; warn $@ if $@;
40              
41             $c->retract_floor ('Level 6 (Management)');
42              
43             $c->logout;
44              
45             =head1 DESCRIPTION
46              
47             Citadel is a "turnkey open-source solution for email and collaboration" (this is as far as marketing
48             can go :-). The main component is the I. To communicate with it you can use either
49             a web interface, or - if you have to automate things - with a protocol
50              
51             L
52              
53             This package tries to do a bit of abstraction (more could be done) and handles some of the protocol
54             handling. The basic idea is that the application using the package deals with Citadel's objects:
55             rooms, floors, users.
56              
57             =head1 CONSTANTS
58              
59             =head2 Configuration
60              
61             =over 4
62              
63             =item CITADEL_PORT
64              
65             The constant $CITADEL_PORT is equal to C<504>, which is the IANA standard Citadel port.
66              
67             =back
68              
69             =cut
70              
71             Readonly our $CITADEL_PORT => 504;
72              
73             =head2 Result Codes
74              
75             =over 4
76              
77             =item LISTING_FOLLOWS
78              
79             The result code $LISTING_FOLLOWS is equal to C<100> and is used by the Citadel
80             server to indicate that after the server response, the server will output a
81             listing of some sort.
82              
83             =cut
84              
85             Readonly our $LISTING_FOLLOWS => 100;
86              
87             =item CIT_OK
88              
89             The result code $CIT_OK is equal to C<200> and is used by the Citadel
90             server to indicate that the requested operation succeeded.
91              
92             =cut
93              
94             Readonly our $CIT_OK => 200;
95              
96             =item MORE_DATA
97              
98             The result code $MORE_DATA is equal to C<300> and is used by the Citadel server
99             to indicate that the requested operation succeeded but that another command is
100             required to complete it.
101              
102             =cut
103              
104             Readonly our $MORE_DATA => 300;
105              
106             =item SEND_LISTING
107              
108             The result code $SEND_LISTING is equal to C<400> and is used by the Citadel
109             server to indicate that the requested operation is progressing and it is now
110             expecting zero or more lines of text.
111              
112             =cut
113              
114             Readonly our $SEND_LISTING => 400;
115              
116             =item ERROR
117              
118             The result code $ERROR is equal to C<500> and is used by the Citadel server to
119             indicate that the requested operation failed. The second and third digits of
120             the error code and/or the error message following it describes why.
121              
122             =cut
123              
124             Readonly our $ERROR => 500;
125              
126              
127             =item BINARY_FOLLOWS
128              
129             The result code $BINARY_FOLLOWS is equal to C<600> and is used by the Citadel server to
130             indicate that after this line, read C bytes. ( follows after a blank)
131              
132             =cut
133              
134             Readonly our $BINARY_FOLLOWS => 600;
135              
136             =item SEND_BINARY
137              
138             The result code $SEND_BINARY is equal to C<700> and is used by the Citadel server to
139             indicate that C bytes of binary data can now be sent. (C follows after a blank.
140              
141             =cut
142              
143             Readonly our $SEND_BINARY => 700;
144              
145             =item START_CHAT_MODE
146              
147             The result code $START_CHAT_MODE is equal to C<800> and is used by the Citadel
148             server to indicate that the system is in chat mode now. Every line sent will be
149             broadcasted.
150              
151             =cut
152              
153             Readonly our $START_CHAT_MODE => 800;
154              
155             =item ASYNC_MSG
156              
157             The result code $ASYC_MSG is equal to C<900> and is used by the Citadel
158             server to indicate that there is a page waiting that needs to be fetched.
159              
160             =back
161              
162             =cut
163              
164             Readonly our $ASYNC_MSG => 900;
165              
166             =head2 Room Access
167              
168             =over 4
169              
170             =item PUBLIC
171              
172             The room access code $PUBLIC is equal to C<0> and is used to indicate that a
173             room is to have public access.
174              
175             =cut
176              
177             Readonly our $PUBLIC => 0;
178              
179             =item PRIVATE
180              
181             The room access code $PRIVATE is equal to C<1> and is used to indicate that a
182             room is to have private access.
183              
184             =cut
185              
186             Readonly our $PRIVATE => 1;
187              
188             =item PRIVATE_PASSWORD
189              
190             The room access code $PRIVATE_PASSWORD is equal to C<2> and is used to indicate
191             that a room is to have private access using a password.
192              
193             =cut
194              
195             Readonly our $PRIVATE_PASSWORD => 2;
196              
197             =item PRIVATE_INVITATION
198              
199             The room access code $PRIVATE_INVITATION is equal to C<3> and is used to indicate
200             that a room is to have private access by invitation.
201              
202             =cut
203              
204             Readonly our $PRIVATE_INVITATION => 3;
205              
206             =item PERSONAL
207              
208             The room access code $PERSONAL is equal to C<4> and is used to indicate
209             that a room is to be a private mailbox only for a particular user.
210              
211             =back
212              
213             =cut
214              
215             Readonly our $PERSONAL => 4;
216              
217             =head2 User related
218              
219             =over 4
220              
221             =item DELETED_USER
222              
223             The room access code $DELETED_USER is equal to C<0>.
224              
225             =cut
226              
227             Readonly our $DELETED_USER => 0;
228              
229             =item NEW_USER
230              
231             The User related constant $NEW_USER is equal to C<1>.
232              
233             =cut
234              
235             Readonly our $NEW_USER => 1;
236              
237             =item PROBLEM_USER
238              
239             The User related constant $PROBLEM_USER is equal to C<2>.
240              
241             =cut
242              
243             Readonly our $PROBLEM_USER => 2;
244              
245             =item LOCAL_USER
246              
247             The User related constant $LOCAL_USER is equal to C<3>.
248              
249             =cut
250              
251             Readonly our $LOCAL_USER => 3;
252              
253             =item NETWORK_USER
254              
255             The User related constant $NETWORK_USER is equal to C<4>.
256              
257             =cut
258              
259             Readonly our $NETWORK_USER => 4;
260              
261             =item PREFERRED_USER
262              
263             The User related constant $PREFERRED_USER is equal to C<5>.
264              
265             =cut
266              
267             Readonly our $PREFERRED_USER => 5;
268              
269             =item AIDE_USER
270              
271             The User related constant $AIDE user is equal to C<6>.
272              
273             =back
274              
275             =cut
276              
277             Readonly our $AIDE => 6;
278              
279             =pod
280              
281             =head1 INTERFACE
282              
283             =head2 Constructor
284              
285             C<$c = new Net::Citadel (host => $ctdl_host)>
286              
287             The constructor creates a handle to the citadel server (and creates the TCP
288             connection). It uses the following named parameters:
289              
290             =over
291              
292             =item I (default: C)
293              
294             The hostname (or IP address) where the citadel server is running. Defaults
295             to C.
296              
297             =item I (default: C<$CITADEL_PORT>)
298              
299             The port where the citadel server is running. Defaults to the standard Citadel
300             port number C<504>.
301              
302             =back
303              
304             The constructor will croak if no connection can be established.
305              
306             =cut
307              
308             sub new {
309 1     1 0 14455 my $class = shift;
310 1         4 my $self = bless { @_ }, $class;
311 1   50     9 $self->{host} ||= 'localhost';
312 1   33     13 $self->{port} ||= $CITADEL_PORT;
313 1     1   7 use IO::Socket::INET;
  1         2  
  1         10  
314             $self->{socket} = IO::Socket::INET->new (PeerAddr => $self->{host},
315             PeerPort => $self->{port},
316 1 50       21 Proto => 'tcp',
317             Type => SOCK_STREAM) or croak "cannot connect to $self->{host}:$self->{port} ($@)";
318 0           my $s = $self->{socket}; <$s>; # consume banner
  0            
319 0           return $self;
320             }
321              
322             =pod
323              
324             =head2 Methods
325              
326             =head3 Authentication
327              
328             =over
329              
330             =item I
331              
332             I<$c>->login (I<$user>, I<$pwd>)
333              
334             Logs in this user, or will croak if that fails.
335              
336             =cut
337              
338             sub login {
339 0     0 1   my $self = shift;
340 0           my $user = shift;
341 0           my $pwd = shift;
342 0           my $s = $self->{socket};
343              
344 0           print $s "USER $user\n";
345 0 0 0       <$s> =~ /(\d).. (.*)/ and ($1 == 3 or croak $2);
346              
347 0           print $s "PASS $pwd\n";
348 0 0 0       <$s> =~ /(\d).. (.*)/ and ($1 == 2 or croak $2);
349              
350 0           return 1;
351             }
352              
353             =pod
354              
355             =item I
356              
357             I<$c>->logout
358              
359             Well, logs out the current user.
360              
361             =cut
362              
363             sub logout {
364 0     0 1   my $self = shift;
365 0           my $s = $self->{socket};
366              
367 0           print $s "LOUT\n";
368 0 0 0       <$s> =~ /(\d).. (.*)/ and ($1 == 2 or croak $2);
369              
370 0           return 1;
371             }
372              
373             =pod
374              
375             =back
376              
377             =head3 Floors
378              
379             =over
380              
381             =item I
382              
383             I<@floors> = I<$c>->floors
384              
385             Retrieves a list (ARRAY) of known floors. Each entry is a hash reference with the name, the number
386             of rooms in that floor and the index as ID. The index within the array is also the ID of the floor.
387              
388             =cut
389              
390             sub floors {
391 0     0 1   my $self = shift;
392 0           my $s = $self->{socket};
393              
394 0           print $s "LFLR\n";
395 0 0 0       <$s> =~ /(\d).. (.*)/ and ($1 == 1 or croak $2);
396              
397 0           my @floors;
398 0           while (($_ = <$s>) !~ /^000/) {
399             #warn "_floors $_";
400 0           my ($nr, $name, $nr_rooms) = /(.+)\|(.+)\|(.+)/;
401 0           push @floors, { id => $nr, name => $name, nr_rooms => $nr_rooms };
402             }
403 0           return @floors;
404             #100 Known floors:
405             #0|Main Floor|33
406             #1|SecondLevel|1
407             #000
408             }
409              
410             =pod
411              
412             =item I
413              
414             I<$c>->assert_floor (I<$floor_name>)
415              
416             Creates the floor with the name provided, or if it already exists simply returns. This only croaks if
417             there are insufficient privileges.
418              
419             =cut
420              
421             sub assert_floor {
422 0     0 1   my $self = shift;
423 0           my $name = shift;
424              
425 0           my $s = $self->{socket};
426 0           print $s "CFLR $name|1\n"; # we really want to create it
427 0 0 0       <$s> =~ /(\d).. (.*)/ and ($1 == 1 or $1 == 2 or $2 =~ /already exists/ or croak $2);
      0        
      0        
428             #CFLR XXX|1
429             #550 This command requires Aide access.
430 0           return 1;
431             }
432              
433             =pod
434              
435             =item I
436              
437             I<$c>->retract_floor (I<$floor_name>)
438              
439             Retracts a floor with this name. croaks if that fails because of insufficient privileges. Does
440             not croak if the floor did not exist.
441              
442             B: Citadel server (v7.20) seems to have the bug that you cannot
443             delete an empty floor without restarting the server. Not much I can do
444             here about that.
445              
446             =cut
447              
448             sub retract_floor {
449 0     0 1   my $self = shift;
450 0           my $name = shift;
451              
452 0           my @floors = $self->floors;
453 0           for (my $i = 0; $i <= $#floors; $i++) {
454 0 0         if ($floors[$i]->{name} eq $name) {
455 0           my $s = $self->{socket};
456 0           print $s "KFLR $i|1\n"; # we really want to delete it
457 0 0 0       <$s> =~ /(\d).. (.*)/ and ($1 == 2 or $2 =~ /not in use/ or croak $2);
      0        
458 0           return;
459             }
460             }
461 0           return 1;
462             }
463              
464             =pod
465              
466             =item I
467              
468             I<@rooms> = I<$c>->rooms (I<$floor_name>)
469              
470             Retrieves the rooms on that given floor.
471              
472             =cut
473              
474             sub rooms {
475 0     0 1   my $self = shift;
476 0           my $name = shift;
477              
478 0           my $s = $self->{socket};
479              
480 0           my @floors = $self->floors;
481             #warn "looking for $name rooms ". Dumper \@floors;
482 0 0         my ($floor) = grep { $_->{name} eq $name } @floors or croak "no floor '$name' known";
  0            
483             #warn "found floor: ".Dumper $floor;
484              
485 0           print $s "LKRA ".$floor->{id}."\n";
486 0 0 0       <$s> =~ /(\d).. (.*)/ and ($1 == 1 or croak $2);
487 0           my @rooms;
488 0           while (($_ = <$s>) !~ /^000/) {
489             #warn "processing $_";
490 0           my %room;
491 0           @room{ ('name', 'qr_flags', 'qr2_flags', 'floor', 'order', 'ua_flags', 'view', 'default', 'last_mod') } = split /\|/, $_;
492 0           push @rooms, \%room;
493             }
494 0           return @rooms;
495             #LKRA
496             #100 Known rooms:
497             #Calendar|16390|0|0|0|230|3|3|1191241353|
498             #Contacts|16390|0|0|0|230|2|2|1191241353|
499             #..
500             #ramsti|2|1|64|0|230|0|0|1191241691|
501             #000
502             }
503              
504             =pod
505              
506             =back
507              
508             =head3 Rooms
509              
510             =over
511              
512             =item I
513              
514             I<$c>->assert_room (I<$floor_name>, I<$room_name>, [ I<$room_attributes> ])
515              
516             Creates the room on the given floor. If the room already exists there, nothing
517             else happens. If the floor does not exist, it will complain.
518              
519             The optional room attributes are provided as hash with the following fields
520              
521             =over
522              
523             =item C (default: C)
524              
525             One of the constants C, C, C, C or
526             C.
527              
528             =item C (default: empty)
529              
530             =item C (default: empty)
531              
532             =back
533              
534             =cut
535              
536             sub assert_room {
537 0     0 1   my $self = shift;
538 0           my $fname = shift;
539 0           my @floors = $self->floors;
540 0 0         my ($floor) = grep { $_->{name} eq $fname } @floors or croak "no floor '$fname' known";
  0            
541              
542 0           my $name = shift;
543 0           my $attrs = shift;
544 0   0       $attrs->{access} ||= $PUBLIC;
545 0   0       $attrs->{password} ||= '';
546 0   0       $attrs->{default_view} ||= '';
547              
548 0           my $s = $self->{socket};
549              
550             print $s "CRE8 1|$name|".
551             $attrs->{access}.'|'.
552             $attrs->{password}.'|'.
553             $floor->{id}.'|'.
554             '|'. # no idea what this is
555 0           $attrs->{default_view}.'|'.
556             "\n";
557 0 0 0       <$s> =~ /(\d).. (.*)/ and ($1 == 2 or $2 =~ /already exists/ or croak $2);
      0        
558              
559 0           return 1;
560             }
561              
562             #CRE8 1|Bumsti|0||0|||
563             #200 'Bumsti' has been created.
564              
565             =pod
566              
567             =item I
568              
569             I<$c>->retract_room (I<$floor_name>, I<$room_name>)
570              
571             B: Not implemented yet.
572              
573             =cut
574              
575             sub retract_room {
576 0     0 1   my $self = shift;
577 0           my $name = shift;
578 0           my $s = $self->{socket};
579 0           print $s "GOTO $name\n";
580             #GOTO Bumsti
581 0 0 0       <$s> =~ /(\d).. (.*)/ and ($1 == 2 or croak $2);
582             #200 Lobby|0|0|0|2|0|0|0|1|0|0|0|0|0|0|
583 0           print $s "KILL 1\n";
584             #KILL 1
585 0 0 0       <$s> =~ /(\d).. (.*)/ and ($1 == 2 or croak $2);
586             #200 'Bumsti' deleted.
587 0           return 1;
588             }
589              
590             =pod
591              
592             =back
593              
594             =head3 Users
595              
596             =over
597              
598             =item I
599              
600             I<$c>->create_user (I<$username>, I<$password>)
601              
602             Tries to create a user with name and password. Fails if this user already exists (or some other
603             reason).
604              
605             =cut
606              
607             sub create_user {
608 0     0 1   my $self = shift;
609 0           my $name = shift;
610 0           my $pwd = shift;
611 0           my $s = $self->{socket};
612 0           print $s "CREU $name|$pwd\n";
613             #CREU TestUser|xxx
614 0 0 0       <$s> =~ /(\d).. (.*)/ and ($1 == 2 or croak $2);
615             #200 User 'TestUser' created and password set.
616 0           return 1;
617             }
618              
619             =pod
620              
621             =item I
622              
623             I<$c>->change_user (I<$user_name>, I<$aspect> => I<$value>)
624              
625             Changes certain aspects of a user. Currently understood aspects are
626              
627             =over
628              
629             =item C (string)
630              
631             =item C (0..6, constants available)
632              
633             =back
634              
635             =cut
636              
637             sub change_user {
638 0     0 1   my $self = shift;
639 0           my $name = shift;
640 0           my %changes = @_;
641 0           my $s = $self->{socket};
642              
643 0           print $s "AGUP $name\n";
644             #AGUP TestUser
645 0 0 0       <$s> =~ /(\d).. (.*)/ and ($1 == 2 or croak $2);
646             #200 TestUser|ggg|10768|1|0|4|4|1191255938|0
647 0           my %user;
648 0           my @attrs = ('name', 'password', 'flags', 'times_called', 'messages_posted', 'access_level', 'user_number', 'timestamp', 'purge_time');
649 0           @user{ @attrs } = split /\|/, $2;
650              
651 0 0         $user{password} = $changes{password} if $changes{password};
652 0 0         $user{access_level} = $changes{access_level} if $changes{access_level};
653              
654 0           print $s "ASUP ".(join "|", @user{ @attrs })."\n";
655 0 0 0       <$s> =~ /(\d).. (.*)/ and ($1 == 2 or croak $2);
656              
657 0           return 1;
658             }
659              
660             =pod
661              
662             =item I
663              
664             I<$c>->remove_user (I<$name>)
665              
666             Removes the user (actually sets level to C).
667              
668             =cut
669              
670             sub remove_user {
671 0     0 1   my $self = shift;
672 0           my $name = shift;
673              
674 0           my $s = $self->{socket};
675              
676 0           print $s "AGUP $name\n";
677             #AGUP TestUser
678 0 0 0       <$s> =~ /(\d).. (.*)/ and ($1 == 2 or croak $2);
679             #200 TestUser|ggg|10768|1|0|4|4|1191255938|0
680 0           my %user;
681 0           my @attrs = ('name', 'password', 'flags', 'times_called', 'messages_posted', 'access_level', 'user_number', 'timestamp', 'purge_time');
682 0           @user{ @attrs } = split /\|/, $2;
683              
684 0           $user{access_level} = $DELETED_USER;
685              
686 0           print $s "ASUP ".(join "|", @user{ @attrs })."\n";
687 0 0 0       <$s> =~ /(\d).. (.*)/ and ($1 == 2 or croak $2);
688              
689 0           return 1;
690             }
691              
692             =pod
693              
694             =back
695              
696             =head3 Miscellaneous
697              
698             =over
699              
700             =item I
701              
702             I<$c>->citadel_echo (I<$string>)
703              
704             Tests a connection to the Citadel server by sending a message string to it and
705             then checking to see if that same string is echoed back.
706              
707             =cut
708              
709             sub citadel_echo {
710 0     0 1   my $self = shift;
711 0           my $msg = shift;
712 0           my $s = $self->{socket};
713              
714 0           print $s "ECHO $msg\n";
715 0 0         croak "message not echoed ($msg)" unless <$s> =~ /2.. $msg/;
716              
717 0           return 1;
718             }
719              
720             =item I
721              
722             $info_aref = I<$c>->citadel_info()
723              
724             Sends the C command to the Citadel server and returns the lines it receives
725             from that as a reference to an array. An example of getting and then displaying the
726             server information lines the following:
727              
728             my $c = new Net::Citadel (host => $host_name);
729             my $info_aref = $c->citadel_info;
730             foreach $line (@{$info_aref}) {
731             print $line;
732             }
733              
734             For more details about the server information lines that are returned, see the
735             C entry at L.
736              
737             =cut
738              
739             sub citadel_info {
740 0     0 1   my $self = shift;
741 0           my $s = $self->{socket};
742 0           my ( @info, $line );
743              
744 0           print $s "INFO\n";
745              
746 0 0         if ((<$s>) !~ /1../) { croak "Incorrect response from Citadel INFO command." };
  0            
747              
748 0           while ($line = <$s>) {
749 0 0         if ( $line !~ /^000/ ) {
750 0           push @info, $line;
751             }
752 0           else { last; }
753             }
754              
755 0           return \@info;
756             }
757              
758             =item I
759              
760             %mrtg_hash = I<$c>->citadel_mrtg($type)
761              
762             Sends the C command to the Citadel server. It expects a type of either
763             C or C to be passed to it and returns a hash containing the
764             information from the server.
765              
766             =over 4
767              
768             =item ActiveUsers
769             Number of active users on the system. Only returned for type C.
770              
771             =item ConnectedUsers
772              
773             Number of connected users on the system. Only returned for type C.
774              
775             =item HighMsg
776              
777             Highest message number on the system. Only returned for type C.
778              
779             =item SystemUptime
780              
781             The uptime for the system formatted as days, hours, minutes.
782              
783             =item SystemName
784              
785             Human readable name of the Citadel system.
786              
787             =back
788              
789             =cut
790              
791             sub citadel_mrtg {
792 0     0 1   my $self = shift;
793 0           my $type = shift;
794 0           my $s = $self->{socket};
795 0           my ( %mrtg, @mrtg_lines, $line );
796              
797 0           print $s "MRTG $type\n";
798              
799 0 0         if ((<$s>) !~ /1../) { croak "Incorrect response from Citadel MRTG command." };
  0            
800              
801             # Get the listing of the MRTG information from the server.
802 0           while ($line = <$s>) {
803 0 0         if ( $line !~ /^000/ ) {
804 0           push @mrtg_lines, $line;
805             }
806 0           else { last; }
807             }
808              
809             # Create the %mrtg hash from the information in the @mrtg_lines array
810 0 0         if ( lc($type) eq q{users} ) {
811 0           $mrtg{'ConnectedUsers'} = $mrtg_lines[0];
812 0           $mrtg{'ActiveUsers'} = $mrtg_lines[1];
813             } else {
814 0           $mrtg{'HighMsg'} = $mrtg_lines[0];
815             }
816 0           $mrtg{'SystemUptime'} = $mrtg_lines[2];
817 0           $mrtg{'SystemName'} = $mrtg_lines[3];
818              
819             # Return the MRTG information as the mrtg hash.
820 0           return %mrtg;
821             }
822              
823             =pod
824              
825             =item I
826              
827             I<$t> = I<$c>->citadel_time
828              
829             Gets the current system time and time zone offset from UTC in UNIX timestamp format from the Citadel server.
830              
831             C: Rewrite function to return the unpacked parameters as a hash upon success.
832              
833             =cut
834              
835             sub citadel_time {
836 0     0 1   my $self = shift;
837 0           my $s = $self->{socket};
838 0           print $s "TIME\n";
839 0 0         croak "protocol: citadel_time failed" unless <$s> =~ /2.. (.*)\|(.*)\|(.*)/; # not sure what the others are
840 0           return $1;
841             }
842              
843             =pod
844              
845             =back
846              
847             =head1 TODOs
848              
849             - Decent GUI using Mason + AJAX
850              
851             =head1 SEE ALSO
852              
853             L
854              
855             =head1 AUTHORS
856              
857             Robert Barta, Edrrho@cpan.orgE
858             Robert James Clay, Ejame@rocasa.usE
859              
860             =head1 COPYRIGHT AND LICENSE
861              
862             Copyright (C) 2007-2008 by Robert Barta
863             Copyright (C) 2012-2018 by Robert James Clay
864              
865             This library is free software; you can redistribute it and/or modify
866             it under the same terms as Perl itself, either Perl version 5.8.8 or,
867             at your option, any later version of Perl 5 you may have available.
868              
869              
870             =cut
871              
872              
873             1;
874              
875             __END__