Net-Citadel-0.24/0000755000175000017500000000000013162245425012146 5ustar jamejameNet-Citadel-0.24/README0000644000175000017500000000203713162034564013030 0ustar jamejameNet-Citadel =========== This package is a Perl extension to support the Citadel application protocol as defined in: http://www.citadel.org/doku.php?id=documentation:appproto:app_proto At this stage the package supports only some basic functionality, but more can be added easily. Also the API is only a first (quick) shot. Of course, you can make it a bit more 'computer sciency'. INSTALLATION To install this module type the following: perl Makefile.PL make make test make install # NOTE: Since I cannot rely on a Citadel installation to exist, the test # will silently (and successfully) terminate if no connection to a Citadel # server can be made. See test.yaml for configuration options and rerun # the test(s). COPYRIGHT AND LICENCE Copyright (C) 2007-2008 by Robert Barta Copyright (C) 2012-2016 by Robert James Clay This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. Net-Citadel-0.24/Changes0000644000175000017500000001151013162242776013445 0ustar jamejameRevision history for Perl extension Net::Citadel. 0.24 14:07 25 September 2017 - Add t/02critic.t for an Author test using Test::Perl::Critic. - Updated lib/Net/Citadel/ToDo.pod for new version. 0.23 13:55 25 August 2016 - Change the default IP in t/test.yaml to be '127.0.0.1'. - Add "lib/Net/Citadel/ToDo.pod" to the PODs being checked in t/00pods.t. 0.22 18:46 22 August 2016 - Add line missing from the 0.21 Changes regarding the MANIFEST file. - Correct spelling of 'formated' to 'formatted' in lib/Net/Citadel.pm. - Add a "dist" line including a 'ZIPFLAGS' option to the Makefile.PL file. 0.21 14:44 16 August 2016 - Add 'META.json' to the MANIFEST file. - Set MIN_PERL_VERSION in Makefile.PL to '5.6.0'. 0.20 10:55 5 June 2013 - Correct number of info lines tested for in t/01citadel.t to '24'. - Add a META_MERGE repository resources item to WriteMakefile in Makefile.PL. 0.19 09:17 13 February 2013 - Correct mis-spelled words in the Changes file. - Change the name of the testing user from RobertBarta to TestUser in the t/01citadel.t and lib/Net/Citadel.pm files. 0.18 22:23 21 October 2012 - Add capability for the MRTG command as the function citadel_mrtg. - Add testing for the citadel_mrtg function to the t/01citadel.t script. - Remove unneeded variable assignment from the citadel_info function. 0.17 18:12 21 October 2012 - Add capability for the INFO command as the function citadel_info. - Add testing for the citadel_info function to the t/01citadel.t script. 0.16 15:31 16 October 2012 - Correct the mcpani authorid used in Makefile.PL from DRRHO to JAME. - Tab/whitespace cleanup and update the documentation for the 'new' function. 0.15 08:05 6 October 2012 - Correct the definition of the constant BINARY_FOLLOWS. - Add a LICENSE line to the WriteMakefile configuration in Makefile.PL - Correct usage of the DELETE_USER constant in the remove_user function. 0.14 06:47 6 October 2012 - Have the following functions explicitly return true to indicate success: login, logout, assert_floor, retract_floor, assert_room, retract_room, create_user, change_user, and remove_user. 0.13 15:59 5 October 2012 - Change to use the Readonly module for the User related constants: NEW_USER, DELETED_USER, PROBLEM_USER, LOCAL_USER, NETWORK_USER, PREFERRED_USER, AIDE. 0.12 14:44 5 October 2012 - Change to use the Readonly module for the Room Access constants: PUBLIC, PRIVATE, PRIVATE_PASSWORD, PRIVATE_INVITATION, and PERSONAL. 0.11 12:53 5 October 2012 - Add a ReadOnly constant for the ASYNC_MSG result code. - Change to use the Readonly module for the Result Codes constants: CIT_OK, LISTING_FOLLOWS, MORE_DATA, SEND_LISTING, BINARY_FOLLOWS, SEND_BINARY, ERROR, and START_CHAT_MODE. 0.10 17:54 23 September 2012 - Rename 'echo' function in Citadel.pm to 'citadel_echo'. - Add an explicit 'return' line to the citadel_echo function. - Rename 'echo' function call in t/01citadel.t to 'citadel_echo'. - Rewrite the citadel_echo function POD documentation. RT#71743 0.09 14:46 23 September 2012 - Change AUTHOR parameter in Makefile.PL to be a string. - Fix a tabs issue in the 'package MY' section of the Makefile.PL file. - Update the README file and add current version of lib/Net/Citadel/ToDo.pod documentation file. 0.08 17:51 17 September 2012 Changes to Makefile.PL: - Clean up of whitespace and tabs. - Add the Readonly module to the PREREQ_PM section. - Add a 'clean' configuration item to the Makefile.PL file. - Move AUTHOR and ABSTRACT_FROM to earlier in the Makefile.PL file. - Move Config::YAML plus add TEST::MORE and TEST::Pod to BUILD_REQUIRES. 0.07 16:13 17 September 2012 - Correct URLs for the Citadel Application API information in the JAM.pm file. - Move the VERSION code line in and add a VERSION POD documentation section to the JAM.pm file. 0.06 13:34 17 September 2012 - Change to using Readonly for the constant CITADEL_PORT. - Update usage of the constant CITADEL_PORT to '$CITADEL_PORT'. - Add POD documentation for the constant $CITADEL_PORT. 0.05 08:53 14 September 2012 - Rename the 'time' function in Citadel.pm to 'citadel_time'. - Rename the 'time' function call in t/01citadel.t to 'citadel_time'. - Rewrite the POD documentation for the citadel_time function. 0.04 13:36 12 September 2012 - Use the Carp module in the lib/Net/Citadel.pm file. - Use 'croak' instead of 'die' in the lib/Net/Citadel.pm file. 0.03 12:46 12 September 2012 - As the new maintainer; add Robert James Clay to the COPYRIGHT AND LICENSE section in the README file and to the AUTHORS and COPYRIGHT AND LICENSE sections in Citadel.pm. 0.02 So 3. Feb 10:56:28 CET 2008 - some typos fixes 0.01 Mon Oct 1 09:07:58 2007 - first, very rough cut to get something working Net-Citadel-0.24/MANIFEST0000644000175000017500000000022613162232461013273 0ustar jamejameChanges Makefile.PL MANIFEST README t/test.yaml t/00pods.t t/01citadel.t t/02critic.t lib/Net/Citadel.pm lib/Net/Citadel/ToDo.pod META.json META.yml Net-Citadel-0.24/lib/0000755000175000017500000000000013162245425012714 5ustar jamejameNet-Citadel-0.24/lib/Net/0000755000175000017500000000000013162245425013442 5ustar jamejameNet-Citadel-0.24/lib/Net/Citadel.pm0000644000175000017500000004333713162233063015352 0ustar jamejamepackage Net::Citadel; use strict; use warnings; require Exporter; use base qw(Exporter); use Carp qw( croak ); use IO::Socket; use Data::Dumper; use Readonly; =pod =head1 NAME Net::Citadel - Citadel.org protocol coverage =head1 VERSION Version 0.24 =cut our $VERSION = '0.24'; =head1 SYNOPSIS use Net::Citadel; my $c = new Net::Citadel (host => 'citadel.example.org'); $c->login ('Administrator', 'goodpassword'); my @floors = $c->floors; eval { $c->assert_floor ('Level 6 (Management)'); }; warn $@ if $@; $c->retract_floor ('Level 6 (Management)'); $c->logout; =head1 DESCRIPTION Citadel is a "turnkey open-source solution for email and collaboration" (this is as far as marketing can go :-). The main component is the I. To communicate with it you can use either a web interface, or - if you have to automate things - with a protocol L This package tries to do a bit of abstraction (more could be done) and handles some of the protocol handling. The basic idea is that the application using the package deals with Citadel's objects: rooms, floors, users. =head1 CONSTANTS =head2 Configuration =over 4 =item CITADEL_PORT The constant $CITADEL_PORT is equal to C<504>, which is the IANA standard Citadel port. =back =cut Readonly our $CITADEL_PORT => 504; =head2 Result Codes =over 4 =item LISTING_FOLLOWS The result code $LISTING_FOLLOWS is equal to C<100> and is used by the Citadel server to indicate that after the server response, the server will output a listing of some sort. =cut Readonly our $LISTING_FOLLOWS => 100; =item CIT_OK The result code $CIT_OK is equal to C<200> and is used by the Citadel server to indicate that the requested operation succeeded. =cut Readonly our $CIT_OK => 200; =item MORE_DATA The result code $MORE_DATA is equal to C<300> and is used by the Citadel server to indicate that the requested operation succeeded but that another command is required to complete it. =cut Readonly our $MORE_DATA => 300; =item SEND_LISTING The result code $SEND_LISTING is equal to C<400> and is used by the Citadel server to indicate that the requested operation is progressing and it is now expecting zero or more lines of text. =cut Readonly our $SEND_LISTING => 400; =item ERROR The result code $ERROR is equal to C<500> and is used by the Citadel server to indicate that the requested operation failed. The second and third digits of the error code and/or the error message following it describes why. =cut Readonly our $ERROR => 500; =item BINARY_FOLLOWS The result code $BINARY_FOLLOWS is equal to C<600> and is used by the Citadel server to indicate that after this line, read C bytes. ( follows after a blank) =cut Readonly our $BINARY_FOLLOWS => 600; =item SEND_BINARY The result code $SEND_BINARY is equal to C<700> and is used by the Citadel server to indicate that C bytes of binary data can now be sent. (C follows after a blank. =cut Readonly our $SEND_BINARY => 700; =item START_CHAT_MODE The result code $START_CHAT_MODE is equal to C<800> and is used by the Citadel server to indicate that the system is in chat mode now. Every line sent will be broadcasted. =cut Readonly our $START_CHAT_MODE => 800; =item ASYNC_MSG The result code $ASYC_MSG is equal to C<900> and is used by the Citadel server to indicate that there is a page waiting that needs to be fetched. =back =cut Readonly our $ASYNC_MSG => 900; =head2 Room Access =over 4 =item PUBLIC The room access code $PUBLIC is equal to C<0> and is used to indicate that a room is to have public access. =cut Readonly our $PUBLIC => 0; =item PRIVATE The room access code $PRIVATE is equal to C<1> and is used to indicate that a room is to have private access. =cut Readonly our $PRIVATE => 1; =item PRIVATE_PASSWORD The room access code $PRIVATE_PASSWORD is equal to C<2> and is used to indicate that a room is to have private access using a password. =cut Readonly our $PRIVATE_PASSWORD => 2; =item PRIVATE_INVITATION The room access code $PRIVATE_INVITATION is equal to C<3> and is used to indicate that a room is to have private access by invitation. =cut Readonly our $PRIVATE_INVITATION => 3; =item PERSONAL The room access code $PERSONAL is equal to C<4> and is used to indicate that a room is to be a private mailbox only for a particular user. =back =cut Readonly our $PERSONAL => 4; =head2 User related =over 4 =item DELETED_USER The room access code $DELETED_USER is equal to C<0>. =cut Readonly our $DELETED_USER => 0; =item NEW_USER The User related constant $NEW_USER is equal to C<1>. =cut Readonly our $NEW_USER => 1; =item PROBLEM_USER The User related constant $PROBLEM_USER is equal to C<2>. =cut Readonly our $PROBLEM_USER => 2; =item LOCAL_USER The User related constant $LOCAL_USER is equal to C<3>. =cut Readonly our $LOCAL_USER => 3; =item NETWORK_USER The User related constant $NETWORK_USER is equal to C<4>. =cut Readonly our $NETWORK_USER => 4; =item PREFERRED_USER The User related constant $PREFERRED_USER is equal to C<5>. =cut Readonly our $PREFERRED_USER => 5; =item AIDE_USER The User related constant $AIDE user is equal to C<6>. =back =cut Readonly our $AIDE => 6; =pod =head1 INTERFACE =head2 Constructor C<$c = new Net::Citadel (host => $ctdl_host)> The constructor creates a handle to the citadel server (and creates the TCP connection). It uses the following named parameters: =over =item I (default: C) The hostname (or IP address) where the citadel server is running. Defaults to C. =item I (default: C<$CITADEL_PORT>) The port where the citadel server is running. Defaults to the standard Citadel port number C<504>. =back The constructor will croak if no connection can be established. =cut sub new { my $class = shift; my $self = bless { @_ }, $class; $self->{host} ||= 'localhost'; $self->{port} ||= $CITADEL_PORT; use IO::Socket::INET; $self->{socket} = IO::Socket::INET->new (PeerAddr => $self->{host}, PeerPort => $self->{port}, Proto => 'tcp', Type => SOCK_STREAM) or croak "cannot connect to $self->{host}:$self->{port} ($@)"; my $s = $self->{socket}; <$s>; # consume banner return $self; } =pod =head2 Methods =head3 Authentication =over =item I I<$c>->login (I<$user>, I<$pwd>) Logs in this user, or will croak if that fails. =cut sub login { my $self = shift; my $user = shift; my $pwd = shift; my $s = $self->{socket}; print $s "USER $user\n"; <$s> =~ /(\d).. (.*)/ and ($1 == 3 or croak $2); print $s "PASS $pwd\n"; <$s> =~ /(\d).. (.*)/ and ($1 == 2 or croak $2); return 1; } =pod =item I I<$c>->logout Well, logs out the current user. =cut sub logout { my $self = shift; my $s = $self->{socket}; print $s "LOUT\n"; <$s> =~ /(\d).. (.*)/ and ($1 == 2 or croak $2); return 1; } =pod =back =head3 Floors =over =item I I<@floors> = I<$c>->floors Retrieves a list (ARRAY) of known floors. Each entry is a hash reference with the name, the number of rooms in that floor and the index as ID. The index within the array is also the ID of the floor. =cut sub floors { my $self = shift; my $s = $self->{socket}; print $s "LFLR\n"; <$s> =~ /(\d).. (.*)/ and ($1 == 1 or croak $2); my @floors; while (($_ = <$s>) !~ /^000/) { #warn "_floors $_"; my ($nr, $name, $nr_rooms) = /(.+)\|(.+)\|(.+)/; push @floors, { id => $nr, name => $name, nr_rooms => $nr_rooms }; } return @floors; #100 Known floors: #0|Main Floor|33 #1|SecondLevel|1 #000 } =pod =item I I<$c>->assert_floor (I<$floor_name>) Creates the floor with the name provided, or if it already exists simply returns. This only croaks if there are insufficient privileges. =cut sub assert_floor { my $self = shift; my $name = shift; my $s = $self->{socket}; print $s "CFLR $name|1\n"; # we really want to create it <$s> =~ /(\d).. (.*)/ and ($1 == 1 or $1 == 2 or $2 =~ /already exists/ or croak $2); #CFLR XXX|1 #550 This command requires Aide access. return 1; } =pod =item I I<$c>->retract_floor (I<$floor_name>) Retracts a floor with this name. croaks if that fails because of insufficient privileges. Does not croak if the floor did not exist. B: Citadel server (v7.20) seems to have the bug that you cannot delete an empty floor without restarting the server. Not much I can do here about that. =cut sub retract_floor { my $self = shift; my $name = shift; my @floors = $self->floors; for (my $i = 0; $i <= $#floors; $i++) { if ($floors[$i]->{name} eq $name) { my $s = $self->{socket}; print $s "KFLR $i|1\n"; # we really want to delete it <$s> =~ /(\d).. (.*)/ and ($1 == 2 or $2 =~ /not in use/ or croak $2); return; } } return 1; } =pod =item I I<@rooms> = I<$c>->rooms (I<$floor_name>) Retrieves the rooms on that given floor. =cut sub rooms { my $self = shift; my $name = shift; my $s = $self->{socket}; my @floors = $self->floors; #warn "looking for $name rooms ". Dumper \@floors; my ($floor) = grep { $_->{name} eq $name } @floors or croak "no floor '$name' known"; #warn "found floor: ".Dumper $floor; print $s "LKRA ".$floor->{id}."\n"; <$s> =~ /(\d).. (.*)/ and ($1 == 1 or croak $2); my @rooms; while (($_ = <$s>) !~ /^000/) { #warn "processing $_"; my %room; @room{ ('name', 'qr_flags', 'qr2_flags', 'floor', 'order', 'ua_flags', 'view', 'default', 'last_mod') } = split /\|/, $_; push @rooms, \%room; } return @rooms; #LKRA #100 Known rooms: #Calendar|16390|0|0|0|230|3|3|1191241353| #Contacts|16390|0|0|0|230|2|2|1191241353| #.. #ramsti|2|1|64|0|230|0|0|1191241691| #000 } =pod =back =head3 Rooms =over =item I I<$c>->assert_room (I<$floor_name>, I<$room_name>, [ I<$room_attributes> ]) Creates the room on the given floor. If the room already exists there, nothing else happens. If the floor does not exist, it will complain. The optional room attributes are provided as hash with the following fields =over =item C (default: C) One of the constants C, C, C, C or C. =item C (default: empty) =item C (default: empty) =back =cut sub assert_room { my $self = shift; my $fname = shift; my @floors = $self->floors; my ($floor) = grep { $_->{name} eq $fname } @floors or croak "no floor '$fname' known"; my $name = shift; my $attrs = shift; $attrs->{access} ||= $PUBLIC; $attrs->{password} ||= ''; $attrs->{default_view} ||= ''; my $s = $self->{socket}; print $s "CRE8 1|$name|". $attrs->{access}.'|'. $attrs->{password}.'|'. $floor->{id}.'|'. '|'. # no idea what this is $attrs->{default_view}.'|'. "\n"; <$s> =~ /(\d).. (.*)/ and ($1 == 2 or $2 =~ /already exists/ or croak $2); return 1; } #CRE8 1|Bumsti|0||0||| #200 'Bumsti' has been created. =pod =item I I<$c>->retract_room (I<$floor_name>, I<$room_name>) B: Not implemented yet. =cut sub retract_room { my $self = shift; my $name = shift; my $s = $self->{socket}; print $s "GOTO $name\n"; #GOTO Bumsti <$s> =~ /(\d).. (.*)/ and ($1 == 2 or croak $2); #200 Lobby|0|0|0|2|0|0|0|1|0|0|0|0|0|0| print $s "KILL 1\n"; #KILL 1 <$s> =~ /(\d).. (.*)/ and ($1 == 2 or croak $2); #200 'Bumsti' deleted. return 1; } =pod =back =head3 Users =over =item I I<$c>->create_user (I<$username>, I<$password>) Tries to create a user with name and password. Fails if this user already exists (or some other reason). =cut sub create_user { my $self = shift; my $name = shift; my $pwd = shift; my $s = $self->{socket}; print $s "CREU $name|$pwd\n"; #CREU TestUser|xxx <$s> =~ /(\d).. (.*)/ and ($1 == 2 or croak $2); #200 User 'TestUser' created and password set. return 1; } =pod =item I I<$c>->change_user (I<$user_name>, I<$aspect> => I<$value>) Changes certain aspects of a user. Currently understood aspects are =over =item C (string) =item C (0..6, constants available) =back =cut sub change_user { my $self = shift; my $name = shift; my %changes = @_; my $s = $self->{socket}; print $s "AGUP $name\n"; #AGUP TestUser <$s> =~ /(\d).. (.*)/ and ($1 == 2 or croak $2); #200 TestUser|ggg|10768|1|0|4|4|1191255938|0 my %user; my @attrs = ('name', 'password', 'flags', 'times_called', 'messages_posted', 'access_level', 'user_number', 'timestamp', 'purge_time'); @user{ @attrs } = split /\|/, $2; $user{password} = $changes{password} if $changes{password}; $user{access_level} = $changes{access_level} if $changes{access_level}; print $s "ASUP ".(join "|", @user{ @attrs })."\n"; <$s> =~ /(\d).. (.*)/ and ($1 == 2 or croak $2); return 1; } =pod =item I I<$c>->remove_user (I<$name>) Removes the user (actually sets level to C). =cut sub remove_user { my $self = shift; my $name = shift; my $s = $self->{socket}; print $s "AGUP $name\n"; #AGUP TestUser <$s> =~ /(\d).. (.*)/ and ($1 == 2 or croak $2); #200 TestUser|ggg|10768|1|0|4|4|1191255938|0 my %user; my @attrs = ('name', 'password', 'flags', 'times_called', 'messages_posted', 'access_level', 'user_number', 'timestamp', 'purge_time'); @user{ @attrs } = split /\|/, $2; $user{access_level} = $DELETED_USER; print $s "ASUP ".(join "|", @user{ @attrs })."\n"; <$s> =~ /(\d).. (.*)/ and ($1 == 2 or croak $2); return 1; } =pod =back =head3 Miscellaneous =over =item I I<$c>->citadel_echo (I<$string>) Tests a connection to the Citadel server by sending a message string to it and then checking to see if that same string is echoed back. =cut sub citadel_echo { my $self = shift; my $msg = shift; my $s = $self->{socket}; print $s "ECHO $msg\n"; croak "message not echoed ($msg)" unless <$s> =~ /2.. $msg/; return 1; } =item I $info_aref = I<$c>->citadel_info() Sends the C command to the Citadel server and returns the lines it receives from that as a reference to an array. An example of getting and then displaying the server information lines the following: my $c = new Net::Citadel (host => $host_name); my $info_aref = $c->citadel_info; foreach $line (@{$info_aref}) { print $line; } For more details about the server information lines that are returned, see the C entry at L. =cut sub citadel_info { my $self = shift; my $s = $self->{socket}; my ( @info, $line ); print $s "INFO\n"; if ((<$s>) !~ /1../) { croak "Incorrect response from Citadel INFO command." }; while ($line = <$s>) { if ( $line !~ /^000/ ) { push @info, $line; } else { last; } } return \@info; } =item I %mrtg_hash = I<$c>->citadel_mrtg($type) Sends the C command to the Citadel server. It expects a type of either C or C to be passed to it and returns a hash containing the information from the server. =over 4 =item ActiveUsers Number of active users on the system. Only returned for type C. =item ConnectedUsers Number of connected users on the system. Only returned for type C. =item HighMsg Higest message number on the system. Only returned for type C. =item SystemUptime The uptime for the system formatted as days, hours, minutes. =item SystemName Human readable name of the Citadel system. =back =cut sub citadel_mrtg { my $self = shift; my $type = shift; my $s = $self->{socket}; my ( %mrtg, @mrtg_lines, $line ); print $s "MRTG $type\n"; if ((<$s>) !~ /1../) { croak "Incorrect response from Citadel MRTG command." }; # Get the listing of the MRTG information from the server. while ($line = <$s>) { if ( $line !~ /^000/ ) { push @mrtg_lines, $line; } else { last; } } # Create the %mrtg hash from the information in the @mrtg_lines array if ( lc($type) eq q{users} ) { $mrtg{'ConnectedUsers'} = $mrtg_lines[0]; $mrtg{'ActiveUsers'} = $mrtg_lines[1]; } else { $mrtg{'HighMsg'} = $mrtg_lines[0]; } $mrtg{'SystemUptime'} = $mrtg_lines[2]; $mrtg{'SystemName'} = $mrtg_lines[3]; # Return the MRTG information as the mrtg hash. return %mrtg; } =pod =item I I<$t> = I<$c>->citadel_time Gets the current system time and time zone offset from UTC in UNIX timestamp format from the Citadel server. C: Rewrite function to return the unpacked parameters as a hash upon success. =cut sub citadel_time { my $self = shift; my $s = $self->{socket}; print $s "TIME\n"; croak "protocol: citadel_time failed" unless <$s> =~ /2.. (.*)\|(.*)\|(.*)/; # not sure what the others are return $1; } =pod =back =head1 TODOs - Decent GUI using Mason + AJAX =head1 SEE ALSO L =head1 AUTHORS Robert Barta, Edrrho@cpan.orgE Robert James Clay, Ejame@rocasa.usE =head1 COPYRIGHT AND LICENSE Copyright (C) 2007-2008 by Robert Barta Copyright (C) 2012-2017 by Robert James Clay This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1; __END__ Net-Citadel-0.24/lib/Net/Citadel/0000755000175000017500000000000013162245425015007 5ustar jamejameNet-Citadel-0.24/lib/Net/Citadel/ToDo.pod0000644000175000017500000001601413162236532016361 0ustar jamejame=pod =head1 NAME Net::Citadel::ToDo - To Do items for the Net::Citadel Perl extension. =head1 TODO =head2 General Add a note in the documentation about the Net::Citadel repository and home page at GitHub? Also include a reference to where it is available at the C CPAN mirror at GitHub? Add capability to use SSL encrypted communications with the Citadel server, perhaps using IO::Socket::SSL? Change to using the jame@cpan.org address for Robert James Clay instead of the jame@rocasa.us address? =head2 Constants There are some numbers being used that are actually constants; change to using Readonly to define them for use in the code, unless there are other standard constants that can be used, like those for the flock operations. A "000" string constant is used quite often by Citadel but is not defined in the module. There is a set of follow up reply codes noted in the documentation that are not yet in the module. Add a link to the online documentation for the status codes: http://www.citadel.org/doku.php?id=documentation:appproto:statuscodes A C return code is mentioned in the command documentation (for the USER command, for instance,) but the module does not currently appear to define it. Add a paragraph to the documentation after the CONSTANTS header. Add a paragraph to the documentation after the 'Results Code' header, perhaps including a link to the online status codes page in Citadel Documentation. Add a paragraph to the documentation after the 'Room Access' header, perhaps including a link to the online page in Citadel Documentation that refers to them. =head2 Functions There does not seem to an explicit function to close the connection; i.e., close the socket being used to communicate with the server. Create an internal function to handle LISTING_FOLLOWS return lines from the server? Perhaps called something like C<_get_listing>? =over 4 =item C function Is the C command coming up with the correct floor information? Is the C function sending the parameters for the CRE8 command properly? (There is a note in the code indicating an uncertainty about what should be sent.) =item C function In the existing test code for the C function, there is a comment saying C; investigate if it an issue with the function itself, an actual issue with Citadel, and/or just something to do with the test script. The documentation for the function itself refers back to Citadel v7.20, so there may not be any issue with it now. =item function C The line just before the 'return $self' line actually has two commands on it, not just one. The second one is just "<$s>;" and that has the comment "# consume banner". That 'banner' is something like the following: "200 Citadel server ready." Instead of not doing anything with that, save it somewhere? At least the part of it? (The first command on that line just establishes the $s variable for that read.) At least, put them on separate lines. Resolve the following from the Perl Critic testing: Always unpack @_ first at line 308, column 1. See page 178 of PBP.(Severity: 4) =item C function Always unpack @_ first at line 637, column 1. See page 178 of PBP. (Severity: 4) =item C function The current C function only returns the first two parameters from the TIME command: C<1347624956|-14400>. The Citadel TIME command itself actually returns a line like this: C<200 1347625545|-14400|1|1347537300>, with the '200' being the OK code and the rest being the four fields that it returns (which also needs to be documented). So as currently written, the function does not return the daylight savings time indication and the actual citadel server start information. Function first needs to be changed to at least return all parameters. Rewrite the C function to unpack the parameters that the TIME command returns when it is successful, and then return them to the calling program in a hash? Could also then return the hash with a key named 'error' or 'Error' if it is not successful. Update its POD to reflect the changes. =item C function It appears to test if what was sent, was actually received back but it only returns true if it does not fail because there is no match. Add an explicit return of the value returned from the ECHO command? =back =head2 Documentation Add something like Net::Citadel::Tutorial for examples of the use and configuration of the module? =head2 Testing Change the default name for the Citadel administration user to 'admin' in the t/test.yaml file? It does seem to be the default name in the Citadel setup. Will the differences with the newer Citadels justify or neccessitate checking the version of the Citadel being tested and doing different tests depending on that version? Change the names of the test floors and rooms to something like C and C? Update the testing for the C function to at least check the number of parameters returned? Three of the parameters are Unix timestamps; validate those in some way? The other parameter being returned is a Boolean and is used to indicate Daylight Savings Time and should be a '0' or a '1'. When testing for a floor, it looks for C
: that exists on a default install but may not be on an working system. Make it another configuration item, which if not configured would default to C
? Separate the testing to: functions that do not require a log in, those that do require a log in, those that are read only, those that write to the server. Or use the separation given in the documentation for the different Sections for the commands? Since Config::YAML is already a build-depends and is used by the main test script, add a C section of some sort to the test.yaml file and check that for the various options for testing instead of just attempting to reach a Citadel server? Instead of having the debugging 'warning' lines commented out, use a DEBUG environment variable and/or a test.yaml configuration item for it. Same for the 'use Data::Dumper' line itself. Use Config::YAML::Tiny instead of Config::YAML? (Does not appear to be in Debian as yet, although YAML::Tiny is.) Use something like Test::MockObject to do at least basic testing of the various functions? And/or Test::TCP? Could use Test::TCP::CheckPort to first check if there is even something up on the standard Citadel port 504. Testing of the citadel_info function currently just checks the number of information lines returned by the server. That could change over time and different Citadel versions. Make that a testing configuration item? Do more extensive checking of what is returned by the citadel_info function? =head1 SEE ALSO L =head1 AUTHOR Robert James Clay, C<< >> =head1 COPYRIGHT AND LICENSE Copyright 2017 Robert James Clay, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Net-Citadel-0.24/t/0000755000175000017500000000000013162245425012411 5ustar jamejameNet-Citadel-0.24/t/00pods.t0000644000175000017500000000071413162055434013704 0ustar jamejameuse strict; use warnings; use Data::Dumper; #== TESTS ===================================================================== use strict; use Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; my @PODs = qw( lib/Net/Citadel.pm lib/Net/Citadel/ToDo.pod ); plan tests => scalar @PODs; map { pod_file_ok ( $_, "$_ pod ok" ) } @PODs; __END__ use Test::Pod; Net-Citadel-0.24/t/02critic.t0000644000175000017500000000070513162232316014212 0ustar jamejameuse strict; use warnings; use File::Spec; use Test::More; use English qw(-no_match_vars); if ( not $ENV{TEST_AUTHOR} ) { my $msg = 'Author test. Set $ENV{TEST_AUTHOR} to a true value to run.'; plan( skip_all => $msg ); } eval { require Test::Perl::Critic; }; if ( $EVAL_ERROR ) { my $msg = 'Test::Perl::Critic required to criticise code'; plan( skip_all => $msg ); } Test::Perl::Critic->import( -severity => 4 ); all_critic_ok(); Net-Citadel-0.24/t/test.yaml0000644000175000017500000000011413162055404014244 0ustar jamejamehost : 127.0.0.1 account : username : Administrator password : xxx Net-Citadel-0.24/t/01citadel.t0000644000175000017500000000752113162034564014351 0ustar jamejame# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl Net-Citadel.t' ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use Test::More qw(no_plan); BEGIN { use_ok('Net::Citadel') }; use Data::Dumper; use Config::YAML; my $config = Config::YAML->new( config => "t/test.yaml" ); my $c; eval { $c = new Net::Citadel (host => $config->{host}); }; exit if $@; eval { $c->login ($config->{account}->{username}, 'zzz'); }; ok ($@, 'login failed'); # login/out $c->login ($config->{account}->{username}, $config->{account}->{password}); $c->logout and pass ('logout'); $c->login ($config->{account}->{username}, $config->{account}->{password}); $c->citadel_echo ('rrrrrr') and pass ('echo'); $c->citadel_time and pass ('time'); my $inforef = $c->citadel_info; is_deeply( $#{$inforef}, q{24}, "Expected 0 thru 23 information lines." ); my (%mrtg_info, $key_count); %mrtg_info = $c->citadel_mrtg ('users'); $key_count = grep { defined } values %mrtg_info; TODO: { local $TODO ='Getting undefined when testing?'; is( $keycount, q{4}, 'citadel_mrtg returns 4 keys for type users.' ); } %mrtg_info = $c->citadel_mrtg ('messages'); $key_count = grep { defined } values %mrtg_info; TODO: { local $TODO ='Getting undefined when testing?'; is( $keycount, q{3}, 'citadel_mrtg returns 3 keys for type messages.' ); } # try to get rid of any testing artefacts eval { $c->retract_room ('ramsti'); $c->retract_room ('rimsti'); }; eval { $c->retract_floor ('rumsti'); }; # testing flooring my @floors = $c->floors; #warn Dumper \@floors; ok (grep ($_->{name} eq 'Main Floor', @floors), 'Main Floor found'); $c->assert_floor ('rumsti'); my @floors2 = $c->floors; ok (scalar @floors2 == scalar @floors + 1 && grep ($_->{name} eq 'rumsti', @floors2), 'create floor'); # close enough $c->assert_floor ('rumsti') and pass ('recreation of same floor'); #warn Dumper \@floors2; $c->retract_floor ('rumsti'); @floors2 = $c->floors; ok (scalar @floors2 == scalar @floors && grep ($_->{name} ne 'rumsti', @floors2), 'floor removed'); # close enough my @rooms = $c->rooms ('Main Floor'); ok (scalar @rooms && grep ($_->{name} eq 'Lobby', @rooms), 'some rooms in main floor'); $c->retract_floor ('rumsti') and pass ('floor re-removal'); $c->assert_floor ('remsti'); my @rooms2 = $c->rooms ('remsti'); #warn "before assert". Dumper \@rooms2; $c->assert_room ('remsti', 'ramsti'); $c->assert_room ('remsti', 'rimsti'); my @rooms3 = $c->rooms ('remsti'); #warn "after assert". Dumper \@rooms3; ok (scalar @rooms2 + 2 == scalar @rooms3 && grep ($_->{name} eq 'ramsti', @rooms3), 'room created'); # close enough $c->assert_room ('remsti', 'ramsti') and pass ('recreate room'); $c->retract_room ('ramsti'); my @rooms4 = $c->rooms ('remsti'); #warn "after retract". Dumper \@rooms4; ok (scalar @rooms2 + 1 == scalar @rooms4 && grep ($_->{name} ne 'ramsti', @rooms4), 'room removed'); # close enough $c->retract_room ('rimsti'); eval { ############# CITADEL BUG $c->retract_floor ('remsti'); }; # users $c->create_user ('TestUser', 'xxx'); { my $c2 = new Net::Citadel (host => $config->{host}); $c2->login ('TestUser', 'xxx') and pass ('login new user'); $c2->logout and pass ('logout new user'); } $c->change_user ('TestUser', password => 'yyy'); { my $c2 = new Net::Citadel (host => $config->{host}); $c2->login ('TestUser', 'yyy') and pass ('login new password'); $c2->logout and pass ('logout new password'); } $c->remove_user ('TestUser'); { my $c2 = new Net::Citadel (host => $config->{host}); eval { $c2->login ('TestUser', 'yyy'); }; ok ($@, 'user does not exist any more'); } $c->logout; __END__ eval { }; like ($@, qr/already exists/, 'floor rumsti already existed'); Net-Citadel-0.24/META.json0000644000175000017500000000222313162245425013566 0ustar jamejame{ "abstract" : "Citadel.org protocol coverage", "author" : [ "Robert Barta , Robert James Clay " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.1002, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Net-Citadel", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "Config::YAML" : "1.42", "Test::More" : "0", "Test::Pod" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Readonly" : "0", "perl" : "5.006000" } } }, "release_status" : "stable", "resources" : { "repository" : { "url" : "https://github.com/jame/Net-Citadel" } }, "version" : "0.24", "x_serialization_backend" : "JSON::PP version 2.27300_01" } Net-Citadel-0.24/Makefile.PL0000644000175000017500000000257713162052760014131 0ustar jamejameuse 5.008008; use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( NAME => 'Net::Citadel', VERSION_FROM => 'lib/Net/Citadel.pm', # finds $VERSION ABSTRACT_FROM => 'lib/Net/Citadel.pm', # retrieve abstract from module AUTHOR => 'Robert Barta , Robert James Clay ', LICENSE => 'perl', MIN_PERL_VERSION => '5.6.0', PREREQ_PM => { 'Readonly' => '0', }, BUILD_REQUIRES => { 'Config::YAML' => '1.42', 'Test::More' => '0', 'Test::Pod' => '0', }, META_MERGE => { resources => { repository => 'https://github.com/jame/Net-Citadel', }, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', ZIPFLAGS => '-or9',}, clean => { FILES => 'Net-Citadel-*' }, ); package MY; sub depend { return <, Robert James Clay ' build_requires: Config::YAML: '1.42' Test::More: '0' Test::Pod: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.1002, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Net-Citadel no_index: directory: - t - inc requires: Readonly: '0' perl: '5.006000' resources: repository: https://github.com/jame/Net-Citadel version: '0.24' x_serialization_backend: 'CPAN::Meta::YAML version 0.018'