Permalink
Browse files

first commit

  • Loading branch information...
0 parents commit c2492cf0a90dc8c2b2eced109f4a2cb41e39705e @yappo committed Sep 14, 2010
Showing with 422 additions and 0 deletions.
  1. +2 −0 .shipit
  2. +4 −0 Changes
  3. +28 −0 MANIFEST
  4. +19 −0 MANIFEST.SKIP
  5. +13 −0 Makefile.PL
  6. +27 −0 README
  7. +15 −0 eg/TwitterSan.pl
  8. +48 −0 eg/XppaiSan.pl
  9. +61 −0 lib/AnySan.pm
  10. +87 −0 lib/AnySan/Provider/IRC.pm
  11. +59 −0 lib/AnySan/Provider/Twitter.pm
  12. +31 −0 lib/AnySan/Receive.pm
  13. +4 −0 t/00_compile.t
  14. +10 −0 xt/01_podspell.t
  15. +8 −0 xt/02_perlcritic.t
  16. +4 −0 xt/03_pod.t
  17. +2 −0 xt/perlcriticrc
2 .shipit
@@ -0,0 +1,2 @@
+steps = FindVersion, ChangeVersion, CheckChangeLog, DistTest, Commit, Tag, MakeDist, UploadCPAN
+svk.tagpattern = release-%v
4 Changes
@@ -0,0 +1,4 @@
+Revision history for Perl extension AnySan
+
+0.01 Tue Oct 27 16:30:31 2009
+ - original version
28 MANIFEST
@@ -0,0 +1,28 @@
+Changes
+inc/Module/Install.pm
+inc/Module/Install/AuthorTests.pm
+inc/Module/Install/Base.pm
+inc/Module/Install/Can.pm
+inc/Module/Install/Fetch.pm
+inc/Module/Install/Include.pm
+inc/Module/Install/Makefile.pm
+inc/Module/Install/Metadata.pm
+inc/Module/Install/TestBase.pm
+inc/Module/Install/Win32.pm
+inc/Module/Install/WriteAll.pm
+inc/Spiffy.pm
+inc/Test/Base.pm
+inc/Test/Base/Filter.pm
+inc/Test/Builder.pm
+inc/Test/Builder/Module.pm
+inc/Test/More.pm
+lib/AnySan.pm
+Makefile.PL
+MANIFEST This list of files
+META.yml
+README
+t/00_compile.t
+xt/01_podspell.t
+xt/02_perlcritic.t
+xt/03_pod.t
+xt/perlcriticrc
19 MANIFEST.SKIP
@@ -0,0 +1,19 @@
+\bRCS\b
+\bCVS\b
+^MANIFEST\.
+^Makefile$
+~$
+^#
+\.old$
+^blib/
+^pm_to_blib
+^MakeMaker-\d
+\.gz$
+\.cvsignore
+^t/9\d_.*\.t
+^t/perlcritic
+^tools/
+\.svn/
+^[^/]+\.yaml$
+^[^/]+\.pl$
+^\.shipit$
13 Makefile.PL
@@ -0,0 +1,13 @@
+use inc::Module::Install;
+name 'AnySan';
+all_from 'lib/AnySan.pm';
+
+# requires '';
+
+tests 't/*.t';
+author_tests 'xt';
+
+build_requires 'Test::More';
+use_test_base;
+auto_include;
+WriteAll;
27 README
@@ -0,0 +1,27 @@
+This is Perl module AnySan.
+
+INSTALLATION
+
+AnySan installation is straightforward. If your CPAN shell is set up,
+you should just be able to do
+
+ % cpan AnySan
+
+Download it, unpack it, then build it as per the usual:
+
+ % perl Makefile.PL
+ % make && make test
+
+Then install it:
+
+ % make install
+
+DOCUMENTATION
+
+AnySan documentation is available as in POD. So you can do:
+
+ % perldoc AnySan
+
+to read the documentation online with your favorite pager.
+
+Kazuhiro Osawa
15 eg/TwitterSan.pl
@@ -0,0 +1,15 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use lib 'lib';
+
+use AnySan;
+use AnySan::Provider::Twitter;
+
+my $twitter = twitter
+ consumer_key => '',
+ consumer_secret => '',
+ token => '',
+ token_secret => '',
+ method => 'sample',
+ ;
48 eg/XppaiSan.pl
@@ -0,0 +1,48 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use lib 'lib';
+
+use AnySan;
+use AnySan::Provider::IRC;
+
+
+my $irc = irc
+ 'chat.example.net',
+ key => 'example1',
+ nickname => 'AnySan1',
+ channels => {
+ '#anysan1' => {},
+ '#anysan2' => {},
+ };
+
+my $irc2 = irc
+ 'chat.example.net',
+ key => 'example2',
+ nickname => 'AnySan2',
+ channels => {
+ '#anysan1' => {},
+ '#anysan2' => {},
+ };
+
+my $timer; $timer = AnyEvent->timer(
+ interval => 55,
+ cb => sub {
+ for (qw( #anysan1 #anysan2 )) {
+ $irc->send_chan( $_, "NOTICE", $_, "??" );
+ $irc2->send_chan( $_, "NOTICE", $_, "????" );
+ }
+ }
+);
+
+AnySan->register_listener(
+ yappo => {
+ cb => sub {
+ my $msg = shift;
+ return unless $msg =~ /^!yappo/;
+ return 'yes!';
+ },
+ },
+);
+
+AnySan->run;
61 lib/AnySan.pm
@@ -0,0 +1,61 @@
+package AnySan;
+use strict;
+use warnings;
+our $VERSION = '0.01';
+
+use AnyEvent;
+
+my $condvar = AE::cv;
+
+sub cv { $condvar }
+
+sub run {
+ $condvar->recv;
+}
+
+
+my @hooks = ();
+sub register_listener {
+ my($class, $name, $args) = @_;
+ $args->{event} ||= 'privmsg';
+ push @hooks, $args;
+}
+
+sub broadcast_message {
+ my($class, $receive) = @_;
+
+ for my $hook (@hooks) {
+ next unless $hook->{event} eq $receive->event;
+ $hook->{cb}->($receive);
+ }
+}
+
+1;
+__END__
+
+=encoding utf8
+
+=head1 NAME
+
+AnySan -
+
+=head1 SYNOPSIS
+
+ use AnySan;
+
+=head1 DESCRIPTION
+
+AnySan is
+
+=head1 AUTHOR
+
+Kazuhiro Osawa E<lt>yappo <at> shibuya <döt> plE<gt>
+
+=head1 SEE ALSO
+
+=head1 LICENSE
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
87 lib/AnySan/Provider/IRC.pm
@@ -0,0 +1,87 @@
+package AnySan::Provider::IRC;
+use strict;
+use warnings;
+use base 'Exporter';
+our @EXPORT = qw(irc);
+use AnySan;
+use AnySan::Receive;
+use AnyEvent::IRC::Client;
+use AnyEvent::IRC::Util qw/mk_msg/;
+use Encode;
+
+my %connections;
+
+sub irc {
+ my($host, %config) = @_;
+
+ my $port = $config{port} || 6667;
+ my $nickname = $config{nickname};
+ my $instance_key = $config{key} || "$host:$port";
+
+ my @channels = keys %{ $config{channels} };
+
+ my $con = AnyEvent::IRC::Client->new;
+ $con->reg_cb(
+ connect =>sub {
+ my ($con, $err) = @_;
+ if (defined $err) {
+ warn "connect error: $err\n";
+ return;
+ }
+ }
+ );
+
+ $con->reg_cb (
+ 'irc_privmsg' => sub {
+ my(undef, $param) = @_;
+ my($channel, $message) = @{ $param->{params} };
+ my($nickname, ) = split '!', $param->{prefix};
+
+ my $receive; $receive = AnySan::Receive->new(
+ provider => 'irc',
+ event => 'privmsg',
+ message => $message,
+ nickname => $config{nickname},
+ from_nickname => $nickname,
+ attribute => {
+ channel => $channel,
+ },
+ cb => sub { event_callback($receive, $con, @_) },
+ );
+ AnySan->broadcast_message($receive);
+ }
+ );
+
+ # connect server
+ $con->connect ($host, $port, { nick => $nickname });
+
+ # join channels
+ for my $channel (@channels) {
+ my $conf = $config{channels}->{$channel};
+ warn "join channel: $channel";
+ $con->send_srv( JOIN => $channel, $conf->{key} );
+ }
+
+ $connections{$instance_key} = $con;
+}
+
+
+sub event_callback {
+ my($receive, $con, $type, @args) = @_;
+
+ if ($type eq 'reply') {
+ my $cmd = $receive->attribute('send_command') || 'NOTICE';
+ my $send = '';
+ my $msg = $args[0];
+ $msg = encode( utf8 => $msg ) if Encode::is_utf8($msg);
+ if ($receive->nickname eq $receive->attribute('channel')) {
+ $send = mk_msg undef, $cmd => $receive->from_nickname, $msg;
+ } else {
+ $send = mk_msg undef, $cmd => $receive->attribute('channel'), $msg;
+ }
+ $con->send_raw($send);
+ }
+}
+
+1;
+__END__
59 lib/AnySan/Provider/Twitter.pm
@@ -0,0 +1,59 @@
+package AnySan::Provider::Twitter;
+use strict;
+use warnings;
+use base 'Exporter';
+our @EXPORT = qw(twitter);
+use AnySan;
+use AnySan::Receive;
+use AnyEvent::Twitter;
+use AnyEvent::Twitter::Stream;
+
+use Net::Twitter::Lite;
+
+sub twitter {
+ my(%config) = @_;
+
+ my $poster = Net::Twitter::Lite->new(
+ consumer_key => $config{consumer_key},
+ consumer_secret => $config{consumer_secret},
+ access_token => $config{token},
+ access_token_secret => $config{token_secret},
+ );
+
+ my $listener = AnyEvent::Twitter::Stream->new(
+ consumer_key => $config{consumer_key},
+ consumer_secret => $config{consumer_secret},
+ token => $config{token},
+ token_secret => $config{token_secret},
+ method => $config{method} || 'userstream',
+ on_tweet => sub {
+ my $tweet = shift;
+ my $receive; $receive = AnySan::Receive->new(
+ provider => 'twitter',
+ event => 'timeline',
+ message => $tweet->{text},
+ nickname => $config{nickname},
+ from_nickname => $tweet->{user}->{screen_name},
+ attribute => {
+ geo => $tweet->{geo},
+ icon_url => $tweet->{user}->{profile_image_url},
+ },
+ cb => sub { event_callback($receive, $poster, @_) },
+ );
+ AnySan->broadcast_message($receive);
+
+ },
+ timeout => $config{timeout} || 120,
+ );
+}
+
+sub event_callback {
+ my($receive, $poster, $type, @args) = @_;
+
+ if ($type eq 'reply') {
+ $poster->update({ status => $args[0] });
+ }
+}
+
+
+1;
31 lib/AnySan/Receive.pm
@@ -0,0 +1,31 @@
+package AnySan::Receive;
+use strict;
+use warnings;
+
+sub new {
+ my($class, %args) = @_;
+ bless { %args }, $class;
+}
+
+sub provider { $_[0]->{provider} }
+sub event { $_[0]->{event} }
+sub nickname { $_[0]->{nickname} }
+sub from_nickname { $_[0]->{from_nickname} }
+sub message { $_[0]->{message} }
+
+sub attribute {
+ my($self, $name, $value) = @_;
+ return $self->{attribute}->{$name} = $value if defined $name && defined $value;
+ return $self->{attribute}->{$name} if defined $name;
+ return $self->{attribute};
+}
+
+sub send_replay {
+ my($self, $message) = @_;
+ $self->{cb}->(
+ reply => $message
+ );
+}
+
+1;
+
4 t/00_compile.t
@@ -0,0 +1,4 @@
+use strict;
+use Test::More tests => 1;
+
+BEGIN { use_ok 'AnySan' }
10 xt/01_podspell.t
@@ -0,0 +1,10 @@
+use Test::More;
+eval q{ use Test::Spelling };
+plan skip_all => "Test::Spelling is not installed." if $@;
+add_stopwords(map { split /[\s\:\-]/ } <DATA>);
+$ENV{LANG} = 'C';
+all_pod_files_spelling_ok('lib');
+__DATA__
+Kazuhiro Osawa
+yappo <at> shibuya <döt> pl
+AnySan
8 xt/02_perlcritic.t
@@ -0,0 +1,8 @@
+use strict;
+use Test::More;
+eval {
+ require Test::Perl::Critic;
+ Test::Perl::Critic->import( -profile => 'xt/perlcriticrc');
+};
+plan skip_all => "Test::Perl::Critic is not installed." if $@;
+all_critic_ok('lib');
4 xt/03_pod.t
@@ -0,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();
2 xt/perlcriticrc
@@ -0,0 +1,2 @@
+[TestingAndDebugging::ProhibitNoStrict]
+allow=refs

0 comments on commit c2492cf

Please sign in to comment.