r14872 - in /branches/upstream/libpoe-filter-ircd-perl: ./ current/ current/lib/ current/lib/POE/ current/lib/POE/Filter/ current/t/
gregoa-guest at users.alioth.debian.org
gregoa-guest at users.alioth.debian.org
Wed Feb 13 20:32:13 UTC 2008
Author: gregoa-guest
Date: Wed Feb 13 20:32:12 2008
New Revision: 14872
URL: http://svn.debian.org/wsvn/?sc=1&rev=14872
Log:
[svn-inject] Installing original source of libpoe-filter-ircd-perl
Added:
branches/upstream/libpoe-filter-ircd-perl/
branches/upstream/libpoe-filter-ircd-perl/current/
branches/upstream/libpoe-filter-ircd-perl/current/Changes
branches/upstream/libpoe-filter-ircd-perl/current/MANIFEST
branches/upstream/libpoe-filter-ircd-perl/current/META.yml
branches/upstream/libpoe-filter-ircd-perl/current/Makefile.PL
branches/upstream/libpoe-filter-ircd-perl/current/README
branches/upstream/libpoe-filter-ircd-perl/current/lib/
branches/upstream/libpoe-filter-ircd-perl/current/lib/POE/
branches/upstream/libpoe-filter-ircd-perl/current/lib/POE/Filter/
branches/upstream/libpoe-filter-ircd-perl/current/lib/POE/Filter/IRCD.pm
branches/upstream/libpoe-filter-ircd-perl/current/t/
branches/upstream/libpoe-filter-ircd-perl/current/t/1.t
branches/upstream/libpoe-filter-ircd-perl/current/t/2.t
branches/upstream/libpoe-filter-ircd-perl/current/t/3.t
Added: branches/upstream/libpoe-filter-ircd-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libpoe-filter-ircd-perl/current/Changes?rev=14872&op=file
==============================================================================
--- branches/upstream/libpoe-filter-ircd-perl/current/Changes (added)
+++ branches/upstream/libpoe-filter-ircd-perl/current/Changes Wed Feb 13 20:32:12 2008
@@ -1,0 +1,14 @@
+POE::Filter::IRCD
+=================
+
+2.0 Makefile.PL was executable. Fixed.
+1.9 Added pod and pod coverage tests. Documentation fixes.
+1.8 Added get_pending() method.
+1.7 Bug in put() that choked when {params} didn't exist.
+1.6 Inherits from POE::Filter now so it won't barf when Stackable
+ is updated.
+1.5 Added colonify options, check pod for details.
+1.4 {raw_line} added to resultant hashref.
+1.3 Documentation amendments.
+1.2 Updated testcase. Should be a bit more robust now.
+1.1 Initial Release
Added: branches/upstream/libpoe-filter-ircd-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libpoe-filter-ircd-perl/current/MANIFEST?rev=14872&op=file
==============================================================================
--- branches/upstream/libpoe-filter-ircd-perl/current/MANIFEST (added)
+++ branches/upstream/libpoe-filter-ircd-perl/current/MANIFEST Wed Feb 13 20:32:12 2008
@@ -1,0 +1,9 @@
+lib/POE/Filter/IRCD.pm
+Changes
+MANIFEST
+Makefile.PL
+README
+t/1.t
+t/2.t
+t/3.t
+META.yml Module meta-data (added by MakeMaker)
Added: branches/upstream/libpoe-filter-ircd-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libpoe-filter-ircd-perl/current/META.yml?rev=14872&op=file
==============================================================================
--- branches/upstream/libpoe-filter-ircd-perl/current/META.yml (added)
+++ branches/upstream/libpoe-filter-ircd-perl/current/META.yml Wed Feb 13 20:32:12 2008
@@ -1,0 +1,11 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: POE-Filter-IRCD
+version: 2.0
+version_from: lib/POE/Filter/IRCD.pm
+installdirs: site
+requires:
+ POE: 0.3202
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.30
Added: branches/upstream/libpoe-filter-ircd-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libpoe-filter-ircd-perl/current/Makefile.PL?rev=14872&op=file
==============================================================================
--- branches/upstream/libpoe-filter-ircd-perl/current/Makefile.PL (added)
+++ branches/upstream/libpoe-filter-ircd-perl/current/Makefile.PL Wed Feb 13 20:32:12 2008
@@ -1,0 +1,13 @@
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+# Blah!
+
+WriteMakefile(
+ 'NAME' => 'POE::Filter::IRCD',
+ 'PREREQ_PM' => {
+ 'POE' => 0.3202,
+ },
+ 'VERSION_FROM' => 'lib/POE/Filter/IRCD.pm', # finds $VERSION
+ 'dist' => { 'COMPRESS' => 'gzip --best' },
+ );
Added: branches/upstream/libpoe-filter-ircd-perl/current/README
URL: http://svn.debian.org/wsvn/branches/upstream/libpoe-filter-ircd-perl/current/README?rev=14872&op=file
==============================================================================
--- branches/upstream/libpoe-filter-ircd-perl/current/README (added)
+++ branches/upstream/libpoe-filter-ircd-perl/current/README Wed Feb 13 20:32:12 2008
@@ -1,0 +1,16 @@
+POE::Filter::IRCD
+=================
+
+A POE filter for the IRC protocol.
+
+For more gorey details consult RFC1812 <http://www.faqs.org/rfcs/rfc2812.html>
+
+Installation:-
+
+perl Makefile.PL
+make
+make test
+su -
+make install
+
+>;o)
Added: branches/upstream/libpoe-filter-ircd-perl/current/lib/POE/Filter/IRCD.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libpoe-filter-ircd-perl/current/lib/POE/Filter/IRCD.pm?rev=14872&op=file
==============================================================================
--- branches/upstream/libpoe-filter-ircd-perl/current/lib/POE/Filter/IRCD.pm (added)
+++ branches/upstream/libpoe-filter-ircd-perl/current/lib/POE/Filter/IRCD.pm Wed Feb 13 20:32:12 2008
@@ -1,0 +1,285 @@
+package POE::Filter::IRCD;
+
+use strict;
+use warnings;
+use Carp;
+use vars qw($VERSION);
+use base qw(POE::Filter);
+
+$VERSION = '2.0';
+
+sub _PUT_LITERAL () { 1 }
+
+# Probably some other stuff should go here.
+
+our $g = {
+ space => qr/\x20+/o,
+ trailing_space => qr/\x20*/o,
+};
+
+our $irc_regex = qr/^
+ (?:
+ \x3a # : comes before hand
+ (\S+) # [prefix]
+ $g->{'space'} # Followed by a space
+ )? # but is optional.
+ (
+ \d{3}|[a-zA-Z]+ # [command]
+ ) # required.
+ (?:
+ $g->{'space'} # Strip leading space off [middle]s
+ ( # [middle]s
+ (?:
+ [^\x00\x0a\x0d\x20\x3a]
+ [^\x00\x0a\x0d\x20]*
+ ) # Match on 1 of these,
+ (?:
+ $g->{'space'}
+ [^\x00\x0a\x0d\x20\x3a]
+ [^\x00\x0a\x0d\x20]*
+ ){0,13} # then match on 0-13 of these,
+ )
+ )? # otherwise dont match at all.
+ (?:
+ $g->{'space'}\x3a # Strip off leading spacecolon for [trailing]
+ ([^\x00\x0a\x0d]*) # [trailing]
+ )? # [trailing] is not necessary.
+ $g->{'trailing_space'}
+$/x;
+
+sub new {
+ my $type = shift;
+ croak "$type requires an even number of parameters" if @_ % 2;
+ my $buffer = { @_ };
+ $buffer->{BUFFER} = [];
+ return bless($buffer, $type);
+}
+
+sub debug {
+ my $self = shift;
+ my $value = shift;
+
+ if ( defined ( $value ) ) {
+ $self->{DEBUG} = $value;
+ return $self->{DEBUG};
+ }
+ if ( $self->{DEBUG} ) {
+ $self->{DEBUG} = 0;
+ } else {
+ $self->{DEBUG} = 1;
+ }
+}
+
+sub get {
+ my ($self, $raw_lines) = @_;
+ my $events = [];
+
+ foreach my $raw_line (@$raw_lines) {
+ warn "->$raw_line \n" if ( $self->{DEBUG} );
+ if ( my($prefix, $command, $middles, $trailing) = $raw_line =~ m/$irc_regex/ ) {
+ my $event = { raw_line => $raw_line };
+ $event->{'prefix'} = $prefix if ($prefix);
+ $event->{'command'} = uc($command);
+ $event->{'params'} = [] if ( defined ( $middles ) || defined ( $trailing ) );
+ push @{$event->{'params'}}, (split /$g->{'space'}/, $middles) if ( defined ( $middles ) );
+ push @{$event->{'params'}}, $trailing if ( defined( $trailing ) );
+ push @$events, $event;
+ } else {
+ warn "Recieved line $raw_line that is not IRC protocol\n";
+ }
+ }
+ return $events;
+}
+
+sub get_one_start {
+ my ($self, $raw_lines) = @_;
+ push @{ $self->{BUFFER} }, $_ for @$raw_lines;
+}
+
+sub get_one {
+ my $self = shift;
+ my $events = [];
+
+ if ( my $raw_line = shift ( @{ $self->{BUFFER} } ) ) {
+ warn "->$raw_line \n" if ( $self->{DEBUG} );
+ if ( my($prefix, $command, $middles, $trailing) = $raw_line =~ m/$irc_regex/ ) {
+ my $event = { raw_line => $raw_line };
+ $event->{'prefix'} = $prefix if ($prefix);
+ $event->{'command'} = uc($command);
+ $event->{'params'} = [] if ( defined ( $middles ) || defined ( $trailing ) );
+ push @{$event->{'params'}}, (split /$g->{'space'}/, $middles) if ( defined ( $middles ) );
+ push @{$event->{'params'}}, $trailing if ( defined( $trailing ) );
+ push @$events, $event;
+ } else {
+ warn "Recieved line $raw_line that is not IRC protocol\n";
+ }
+ }
+ return $events;
+}
+
+sub get_pending {
+ return;
+}
+
+sub put {
+ my ($self, $events) = @_;
+ my $raw_lines = [];
+
+ foreach my $event (@$events) {
+ if (ref $event eq 'HASH') {
+ my $colonify = ( defined $event->{colonify} ? $event->{colonify} : $self->{colonify} );
+ if ( _PUT_LITERAL || _checkargs($event) ) {
+ my $raw_line = '';
+ $raw_line .= (':' . $event->{'prefix'} . ' ') if (exists $event->{'prefix'});
+ $raw_line .= $event->{'command'};
+ if ( $event->{'params'} and ref $event->{'params'} eq 'ARRAY' ) {
+ my $params = [ @{ $event->{'params'} } ];
+ $raw_line .= ' ';
+ my $param = shift @$params;
+ while (@$params) {
+ $raw_line .= $param . ' ';
+ $param = shift @$params;
+ }
+ $raw_line .= ':' if ( $param =~ m/\x20/ or $colonify );
+ $raw_line .= $param;
+ }
+ push @$raw_lines, $raw_line;
+ warn "<-$raw_line \n" if ( $self->{DEBUG} );
+ } else {
+ next;
+ }
+ } else {
+ warn __PACKAGE__ . " non hashref passed to put(): \"$event\"\n";
+ push @$raw_lines, $event if ref $event eq 'SCALAR';
+ }
+ }
+ return $raw_lines;
+}
+
+
+# This thing is far from correct, dont use it.
+sub _checkargs {
+ my $event = shift || return;
+ warn("Invalid characters in prefix: " . $event->{'prefix'} . "\n")
+ if ($event->{'prefix'} =~ m/[\x00\x0a\x0d\x20]/);
+ warn("Undefined command passed.\n")
+ unless ($event->{'command'} =~ m/\S/o);
+ warn("Invalid command: " . $event->{'command'} . "\n")
+ unless ($event->{'command'} =~ m/^(?:[a-zA-Z]+|\d{3})$/o);
+ foreach my $middle (@{$event->{'middles'}}) {
+ warn("Invalid middle: $middle\n")
+ unless ($middle =~ m/^[^\x00\x0a\x0d\x20\x3a][^\x00\x0a\x0d\x20]*$/);
+ }
+ warn("Invalid trailing: " . $event->{'trailing'} . "\n")
+ unless ($event->{'trailing'} =~ m/^[\x00\x0a\x0d]*$/);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+POE::Filter::IRCD -- A POE-based parser for the IRC protocol.
+
+=head1 SYNOPSIS
+
+ use POE::Filter::IRCD;
+
+ my $filter = POE::Filter::IRCD->new( DEBUG => 1, colonify => 0 );
+ my $arrayref = $filter->get( [ $hashref ] );
+ my $arrayref2 = $filter->put( $arrayref );
+
+ use POE qw(Filter::Stackable Filter::Line Filter::IRCD);
+
+ my ($filter) = POE::Filter::Stackable->new();
+ $filter->push( POE::Filter::Line->new( InputRegexp => '\015?\012', OutputLiteral => "\015\012" ),
+ POE::Filter::IRCD->new(), );
+
+=head1 DESCRIPTION
+
+POE::Filter::IRCD provides a convenient way of parsing and creating IRC protocol
+lines.
+
+=head1 CONSTRUCTOR
+
+=over
+
+=item new
+
+Creates a new POE::Filter::IRCD object. Takes two optional arguments: DEBUG which will print
+all lines received to STDERR; 'colonify', set to 1 to force the filter to always colonify the
+last param passed in a put(), default is 0. See below for more detail.
+
+=back
+
+=head1 METHODS
+
+=over
+
+=item get_one_start
+
+=item get_one
+
+=item get_pending
+
+=item get
+
+Takes an arrayref which is contains lines of IRC formatted input. Returns an arrayref of hashrefs
+which represents the lines. The hashref contains the following fields:
+
+ prefix
+ command
+ params ( this is an arrayref )
+ raw_line
+
+For example, if the filter receives the following line, the following hashref is produced:
+
+ LINE: ':moo.server.net 001 lamebot :Welcome to the IRC network lamebot'
+
+ HASHREF: {
+ prefix => ':moo.server.net',
+ command => '001',
+ params => [ 'lamebot', 'Welcome to the IRC network lamebot' ],
+ raw_line => ':moo.server.net 001 lamebot :Welcome to the IRC network lamebot',
+ }
+
+=item put
+
+Takes an arrayref containing hashrefs of IRC data and returns an arrayref containing IRC formatted lines.
+Optionally, one can specify 'colonify' to override the global colonification option.
+eg.
+
+ $hashref = {
+ command => 'PRIVMSG',
+ prefix => 'FooBar!foobar at foobar.com',
+ params => [ '#foobar', 'boo!' ],
+ colonify => 1, # Override the global colonify option for this record only.
+ };
+
+ $filter->put( [ $hashref ] );
+
+=item debug
+
+With a true or false argument, enables or disables debug output respectively. Without an argument the behaviour is to toggle the debug status.
+
+=back
+
+=head1 MAINTAINER
+
+Chris Williams <chris at bingosnet.co.uk>
+
+=head1 AUTHOR
+
+Jonathan Steinert
+
+=head1 SEE ALSO
+
+L<POE>
+
+L<POE::Filter>
+
+L<POE::Filter::Stackable>
+
+=cut
+
Added: branches/upstream/libpoe-filter-ircd-perl/current/t/1.t
URL: http://svn.debian.org/wsvn/branches/upstream/libpoe-filter-ircd-perl/current/t/1.t?rev=14872&op=file
==============================================================================
--- branches/upstream/libpoe-filter-ircd-perl/current/t/1.t (added)
+++ branches/upstream/libpoe-filter-ircd-perl/current/t/1.t Wed Feb 13 20:32:12 2008
@@ -1,0 +1,24 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl 1.t'
+
+#########################
+
+# change 'tests => 1' to 'tests => last_test_to_print';
+
+use Test::More tests => 7;
+BEGIN { use_ok('POE::Filter::IRCD') };
+
+my ($filter) = POE::Filter::IRCD->new();
+
+isa_ok( $filter, 'POE::Filter::IRCD' );
+
+my $original = ':test!test at test.test PRIVMSG #Test :This is a test case';
+foreach my $irc_event ( @{ $filter->get( [ $original ] ) } ) {
+ ok( $irc_event->{prefix} eq 'test!test at test.test', 'Prefix Test' );
+ ok( $irc_event->{params}->[0] eq '#Test', 'Params Test One' );
+ ok( $irc_event->{params}->[1] eq 'This is a test case', 'Params Test Two' );
+ ok( $irc_event->{command} eq 'PRIVMSG', 'Command Test');
+ foreach my $parsed ( @{ $filter->put( [ $irc_event ] ) } ) {
+ ok( $parsed eq $original, 'Self Test' );
+ }
+}
Added: branches/upstream/libpoe-filter-ircd-perl/current/t/2.t
URL: http://svn.debian.org/wsvn/branches/upstream/libpoe-filter-ircd-perl/current/t/2.t?rev=14872&op=file
==============================================================================
--- branches/upstream/libpoe-filter-ircd-perl/current/t/2.t (added)
+++ branches/upstream/libpoe-filter-ircd-perl/current/t/2.t Wed Feb 13 20:32:12 2008
@@ -1,0 +1,4 @@
+use Test::More;
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+all_pod_files_ok();
Added: branches/upstream/libpoe-filter-ircd-perl/current/t/3.t
URL: http://svn.debian.org/wsvn/branches/upstream/libpoe-filter-ircd-perl/current/t/3.t?rev=14872&op=file
==============================================================================
--- branches/upstream/libpoe-filter-ircd-perl/current/t/3.t (added)
+++ branches/upstream/libpoe-filter-ircd-perl/current/t/3.t Wed Feb 13 20:32:12 2008
@@ -1,0 +1,4 @@
+ use Test::More;
+ eval "use Test::Pod::Coverage 1.00";
+ plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@;
+ all_pod_coverage_ok();
More information about the Pkg-perl-cvs-commits
mailing list