Index: /bot/trunk/Changes
===================================================================
--- /bot/trunk/Changes	(revision 302)
+++ /bot/trunk/Changes	(revision 302)
@@ -0,0 +1,6 @@
+Revision history for Perl extension Sophie::IrcBot.
+
+0.01  Fri Dec  3 01:44:40 2010
+	- original version; created by h2xs 1.23 with options
+		Sophie::IrcBot --skip-exporter --skip-autoloader --skip-ppport -X
+
Index: /bot/trunk/MANIFEST
===================================================================
--- /bot/trunk/MANIFEST	(revision 302)
+++ /bot/trunk/MANIFEST	(revision 302)
@@ -0,0 +1,6 @@
+Changes
+Makefile.PL
+MANIFEST
+README
+t/Sophie-IrcBot.t
+lib/Sophie/IrcBot.pm
Index: /bot/trunk/Makefile.PL
===================================================================
--- /bot/trunk/Makefile.PL	(revision 302)
+++ /bot/trunk/Makefile.PL	(revision 302)
@@ -0,0 +1,12 @@
+use 5.012002;
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+    NAME              => 'Sophie::Bot',
+    VERSION_FROM      => 'lib/Sophie/Bot.pm', # finds $VERSION
+    PREREQ_PM         => {}, # e.g., Module::Name => 1.1
+    ($] >= 5.005 ?     ## Add these new keywords supported since 5.005
+      (ABSTRACT_FROM  => 'lib/Sophie/Bot.pm', # retrieve abstract from module
+       AUTHOR         => 'Olivier Thauvin <nanardon@nanardon.zarb.org>') : ()),
+);
Index: /bot/trunk/README
===================================================================
--- /bot/trunk/README	(revision 302)
+++ /bot/trunk/README	(revision 302)
@@ -0,0 +1,40 @@
+Sophie-IrcBot version 0.01
+==========================
+
+The README is used to introduce the module and provide instructions on
+how to install the module, any machine dependencies it may have (for
+example C compilers and installed libraries) and any other information
+that should be provided before the module is installed.
+
+A README file is required for CPAN modules since CPAN extracts the
+README file from a module distribution so that people browsing the
+archive can use it get an idea of the modules uses. It is usually a
+good idea to provide version information here so that people can
+decide whether fixes for the module are worth downloading.
+
+INSTALLATION
+
+To install this module type the following:
+
+   perl Makefile.PL
+   make
+   make test
+   make install
+
+DEPENDENCIES
+
+This module requires these other modules and libraries:
+
+  blah blah blah
+
+COPYRIGHT AND LICENCE
+
+Put the correct copyright and licence information here.
+
+Copyright (C) 2010 by Olivier Thauvin
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.12.2 or,
+at your option, any later version of Perl 5 you may have available.
+
+
Index: /bot/trunk/bin/sophie-bot
===================================================================
--- /bot/trunk/bin/sophie-bot	(revision 302)
+++ /bot/trunk/bin/sophie-bot	(revision 302)
@@ -0,0 +1,99 @@
+#! /bin/env perl
+
+use strict;
+use warnings;
+use Sophie::Bot;
+use Getopt::Long;
+use Pod::Usage;
+use Config::General;
+use File::Temp;
+
+GetOptions(
+    'c=s' => \my $configfile,
+    'u=s' => \my $url,
+    'l=s' => \my $login,
+    'p=s' => \my $pass,
+    't=s' => \my $type,
+    'd=s' => \my @options,
+    'proxy' => \my $proxy,
+    'daemon' => \my $daemon,
+
+    # Command option:
+    'set-password=s' => \my $password,
+    'edit-var=s'       => \my $data,
+) or pod2usage;
+
+my %options;
+foreach (@options) {
+    m/([^=]+)\s*=\s*(.*)/ or next;
+    $options{$1} = $2;
+}
+
+$configfile ||= "/etc/sophie/sophie-bot.conf";
+
+if (my $conf = Config::General->new($configfile)) {
+    my %config = $conf->getall;
+    $url         ||= $config{url};
+    $login       ||= $config{login};
+    $pass        ||= $config{pass};
+    $daemon      ||= $config{daemon};
+    $proxy       ||= $config{proxy};
+}
+
+my $sc = Sophie::Bot->new(
+    server => $url,
+    login => $login,
+    password => $pass,
+    type => $type || 'Term',
+    proxy => $proxy,
+);
+
+if ($password) {
+    my $res = $sc->send_request('user.set_password', $password);
+    if (ref $res && !$res->is_fault) {
+        print $res->value . "\n";
+        exit(0);
+    } else {
+        print( (ref $res ? $res->string : $res) . "\n");
+        exit(1);
+    }
+} elsif ($data) {
+    my $res = $sc->send_request('user.dumpdata', $data);
+    if (ref $res && !$res->is_fault) {
+        my $tmp = File::Temp->new();
+        print $tmp $res->value . "\n";
+        close($tmp);
+        system($ENV{EDITOR} || 'vi', $tmp->filename);
+        if (open(my $fh, '<', $tmp->filename)) {
+            my $string = join('', <$fh>);
+            close($fh);
+            unlink($tmp->filename);
+            my $res2 = $sc->send_request('user.loaddata', $data, $string);
+            if (ref $res2 && !$res2->is_fault) {
+                print $res2->value . "\n";
+                exit(0);
+            } else {
+                print( (ref $res2 ? $res2->string : $res2) . "\n");
+                exit(1);
+            }
+        }
+    } else {
+        print( (ref $res ? $res->string : $res) . "\n");
+        exit(1);
+    }
+}
+
+if ($daemon) {
+    my $pid = fork();
+
+    if (defined($pid)) {
+        if ($pid) {
+            # father, exiting;
+            exit(0);
+        } else {
+            # child
+        }
+    }
+}
+
+$sc->run;
Index: /bot/trunk/bin/sophie-rpm
===================================================================
--- /bot/trunk/bin/sophie-rpm	(revision 302)
+++ /bot/trunk/bin/sophie-rpm	(revision 302)
@@ -0,0 +1,138 @@
+#! /bin/env perl
+
+use strict;
+use warnings;
+use Sophie::Client;
+use Getopt::Long;
+use Pod::Usage;
+use Config::General;
+use File::Temp;
+
+my $distrib = {};
+
+GetOptions(
+    'c=s' => \my $configfile,
+    'u=s' => \my $url,
+    'l=s' => \my $login,
+    'p=s' => \my $pass,
+    't=s' => \my $type,
+    'd=s' => \my @options,
+    'proxy' => \my $proxy,
+
+) or pod2usage;
+
+my %options;
+foreach (@options) {
+    m/([^=]+)\s*=\s*(.*)/ or next;
+    $options{$1} = $2;
+}
+
+$configfile ||= "$ENV{HOME}/.sophie.conf";
+
+if (-f $configfile && (my $conf = Config::General->new($configfile))) {
+    my %config = $conf->getall;
+    $url         ||= $config{url};
+    $login       ||= $config{login};
+    $pass        ||= $config{pass};
+    $proxy       ||= $config{proxy};
+    $distrib     = $config{distrib};
+}
+
+my $sc = Sophie::Client->new(
+    server => $url,
+    login => $login,
+    password => $pass,
+    type => $type,
+    proxy => $proxy,
+);
+
+$sc->login;
+
+my %rpmid;
+foreach my $rpm (@ARGV) {
+    my $string = `rpm -qp --qf '[%{*:xml}\n]' $rpm`;
+    warn "Loarding $rpm\n";
+
+    my $res = $sc->send_request('user.folder.load_rpm', $string);
+    if (ref $res && ! $res->is_fault) {
+        $rpmid{$res->value} = $rpm;
+    } else {
+        die((ref $res ? $res->string : $res) . "\n");
+    }
+}
+
+my %pool;
+{
+    foreach (@{ $sc->send_request('user.folder.list')->value }) {
+        $pool{$_->{id}} = $_->{name} . '-' . $_->{evr}; 
+    }
+}
+
+my @unresolved;
+foreach my $rpmid (keys %rpmid) {
+    warn "Analysing $rpmid{$rpmid}\n";
+    my $analyse = $sc->send_request('analysis.find_requirements',
+        $distrib,
+        $rpmid,
+        [ keys %rpmid ],
+    );
+    if (ref $analyse && !$analyse->is_fault) {
+        my $result = $analyse->value;
+        print "\nPackage requirements\n";
+        foreach my $dep (keys %{ $result->{bydep} }) {
+            print $dep . ":\n";
+            foreach (@{ $result->{bydep}{$dep}{pkg} || []}) {
+                print "    " . $sc->send_request('rpms.basicinfo', $_)->value->{filename};
+                print "\n";
+            }
+            foreach (@{ $result->{bydep}{$dep}{pool} || [] }) {
+                print "  * " . $pool{$_} . "\n";
+            }
+        }
+        if (@{ $result->{unresolved} || []}) {
+            push(@unresolved, @{ $result->{unresolved} });
+            print "\nAre unresolved:\n";
+            print  map { " $_\n" }  @{ $result->{unresolved} };
+        }
+    }
+    my $diranalyse = $sc->send_request('analysis.parentdir',
+        $distrib,
+        $rpmid,
+        [ keys %rpmid ],
+    );
+    if (ref $diranalyse && !$diranalyse->is_fault) {
+        my $result = $diranalyse->value;
+        print "\nParent directories:\n";
+        foreach my $dir (sort keys %{ $result->{bydir} }) {
+            print $dir . ":\n";
+            if (@{ $result->{bydir}{$dir}{pkg} || []} > 3) {
+                print "    " . scalar(@{ $result->{bydir}{$dir}{pkg} || []}) .
+                " results in the distribution...\n";
+            } else {
+                foreach (@{ $result->{bydir}{$dir}{pkg} || []}) {
+                    print "    " . $sc->send_request('rpms.basicinfo', $_)->value->{filename};
+                    print "\n";
+                }
+            }
+            foreach (@{ $result->{bydir}{$dir}{pool} || [] }) {
+                print "  * " . $pool{$_} . "\n";
+            }
+        }
+        if (@{ $result->{notfound} || []}) {
+            print "\nUnowned directories:\n";
+            print  map { " $_\n" }  @{ $result->{notfound} };
+        }
+    }
+    print "\n";
+}
+
+$sc->send_request('user.folder.clear');
+
+if (@unresolved) {
+    print "Error, unresolved:\n";
+    print  map { " $_\n" }  @unresolved;
+    exit(1);
+} else {
+    exit(0);
+}
+
Index: /bot/trunk/lib/Sophie/Bot.pm
===================================================================
--- /bot/trunk/lib/Sophie/Bot.pm	(revision 302)
+++ /bot/trunk/lib/Sophie/Bot.pm	(revision 302)
@@ -0,0 +1,158 @@
+package Sophie::Bot;
+
+use 5.010000;
+use strict;
+use warnings;
+use RPC::XML;
+use base qw(RPC::XML::Client);
+$RPC::XML::FORCE_STRING_ENCODING = 1;
+
+our $VERSION = '0.01';
+
+sub new {
+    my ($class, %options) = @_;
+
+    my $self = $class->SUPER::new(
+        $options{server} || 'http://sophie.zarb.org/rpc'
+    );
+    if ($options{proxy}) {
+        $self->useragent->proxy([ 'http' ], $options{proxy});
+    } else {
+        $self->useragent->env_proxy;
+    }
+
+    $self->{options} = { %options };
+
+
+    if ($options{login}) {
+        login($self) or die "Can't login";
+    }
+
+    my $realclass = $class . ($options{type} ? ('::' . $options{type}) : '');
+    no strict qw(refs);
+    eval "require $realclass;";
+    return if($@);
+    bless($self, $realclass);
+}
+
+sub login {
+    my ($self) = @_;
+    my %options = %{ $self->{options} };
+    if ($options{login}) {
+        my $res = $self->send_request('login',
+            $options{login},
+            $options{password});
+        if (ref $res) {
+            $self->request->header('cookie', $$res);
+            return 1;
+        } else {
+            return;
+        }
+    } else {
+        my $res = $self->send_request('user.session');
+        if (ref $res && !$res->is_fault) {
+            $self->request->header('cookie', $$res);
+            return 1;
+        } else {
+            return;
+        }
+    }
+}
+
+sub get_var {
+    my ($self, $varname) = @_;
+    my $resp = $self->send_request('user.fetchdata', $varname);
+    if (ref $resp) {
+        if ($resp->value) {
+            return $resp->value;
+        }
+    } else {
+        return {};
+    }
+}
+
+sub set_var {
+    my ($self, $varname, $data) = @_;
+
+    my $resp = $self->send_request('user.update_data', $varname, $data);
+    if (ref $resp) {
+        return 1;
+    } else {
+        return;
+    }
+}
+
+sub handle_message {
+    my ($self, $heap, $context, $message) = @_;
+
+    $self->login;
+    if ($message =~ /^\s*set\s+(\w+)\s+(\S+)/) {
+        warn "$1, $2";
+        $self->user_config($heap, $1, $2);
+    } else {
+        eval {
+            $self->submit_query($heap, $context, $message);
+        }
+    }
+}
+
+sub submit_query {
+    my ($self, $heap, $context, $message) = @_;
+
+    my $resp = $self->send_request('chat.message', $context, $message);
+    if (ref($resp)) {
+        $self->show_reply($heap, $resp->value);
+    } else {
+        return;
+    }
+
+}
+
+1;
+
+__END__
+# Below is stub documentation for your module. You'd better edit it!
+
+=head1 NAME
+
+Sophie::Client - Perl extension for blah blah blah
+
+=head1 SYNOPSIS
+
+  use Sophie::Client;
+  blah blah blah
+
+=head1 DESCRIPTION
+
+Stub documentation for Sophie::Client, created by h2xs. It looks like the
+author of the extension was negligent enough to leave the stub
+unedited.
+
+Blah blah blah.
+
+
+=head1 SEE ALSO
+
+Mention other useful documentation such as the documentation of
+related modules or operating system documentation (such as man pages
+in UNIX), or any relevant external documentation such as RFCs or
+standards.
+
+If you have a mailing list set up for your module, mention it here.
+
+If you have a web site set up for your module, mention it here.
+
+=head1 AUTHOR
+
+Olivier Thauvin, E<lt>olivier@localdomainE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2010 by Olivier Thauvin
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.12.2 or,
+at your option, any later version of Perl 5 you may have available.
+
+
+=cut
Index: /bot/trunk/lib/Sophie/Bot/IRC.pm
===================================================================
--- /bot/trunk/lib/Sophie/Bot/IRC.pm	(revision 302)
+++ /bot/trunk/lib/Sophie/Bot/IRC.pm	(revision 302)
@@ -0,0 +1,208 @@
+package Sophie::Bot::IRC;
+
+use 5.010000;
+use strict;
+use warnings;
+use base qw(Sophie::Bot);
+use POE qw(Component::IRC);
+
+our $VERSION = '0.01';
+
+sub setup_server {
+    my ($self, $server, $nick, $password) = @_;
+
+    if (!$nick) {
+        my $resp = $self->send_request('user.fetchdata', $server);
+        if (ref $resp) {
+            if ($resp->value) {
+                $nick = $resp->value->{nick};
+            }
+        }
+    }
+
+    my $irc = POE::Component::IRC->spawn(
+        Nick     => $nick,
+        Server   => $server,
+        Ircname  => 'Rpm2sql',
+        Debug    => 0,
+    );
+ 
+    POE::Session->create(
+        heap => {
+            irc => $irc,
+            sophie => $self,
+            server => $server,
+            password => $password,
+            nick => $nick,
+        },
+        package_states => [
+            ref($self)  => [ qw(_start irc_001 irc_public irc_msg) ],
+        ],
+    ); 
+}
+
+sub _start {
+    my $heap = $_[HEAP];
+    my $irc = $heap->{irc};
+    $irc->yield('register', 'all', '001');
+    $irc->yield('connect', { });
+}
+
+sub irc_001 {
+    my $heap = $_[HEAP];
+    my $irc = $heap->{irc};
+    my $self = $heap->{sophie};
+
+    my $config = $self->get_var($heap->{server});
+
+    if (my $pass = $config->{password}) {
+        $irc->yield('privmsg', 'nickserv', "identify $pass");
+    }
+
+    foreach my $chan (@{ $config->{channels} || [] }) {
+        $irc->yield('join', $chan);
+    }
+}
+
+sub irc_public {
+    my $heap = $_[HEAP];
+    my $self = $heap->{sophie};
+    my $nick = $heap->{nick};
+    my ($string) = $_[ARG2] =~ m/^(?:\Q$nick\E:?\s+|:)(\S.*)/
+        or return;
+
+    my $from = ($_[ARG0] =~ /^([^!]*)!/)[0];
+    my $chan = shift(@{$_[ARG1]});
+
+    $self->handle_message(
+        {
+            from => $from,
+            to => $chan,
+            heap => $heap
+        },
+        [ 
+            $heap->{server} . '@' . lc($chan),
+            $heap->{server} . '@' . lc($from),
+        ],
+        $string
+    );
+}
+
+sub irc_msg {
+    my $heap = $_[HEAP];
+    my $irc = $heap->{irc};
+    my $self = $heap->{sophie};
+
+    my $line = $_[ARG2];
+    $line =~ s/^://;
+    my $from = ($_[ARG0] =~ /^([^!]*)!/)[0];
+ 
+    $self->handle_message(
+        {
+            from => $from,
+            heap => $heap
+        },
+        [ $heap->{server} . '@' . lc($from) ],
+        $line
+    );
+}
+
+sub show_reply {
+    my ($self, $heap, $reply) = @_;
+
+    my ($replyto, $prefix) = $heap->{to} && !$reply->{private_reply}
+        ? ($heap->{to}, $heap->{from} . ': ')
+        : ($heap->{from}, '');
+    
+    foreach (@{$reply->{message}}) {
+        $heap->{heap}->{irc}->yield(
+            'privmsg',
+            $replyto,
+            sprintf("%s%s", ($heap->{to} ? $prefix : ''), $_)
+        );
+    }
+}
+
+sub user_config {
+    my ($self, $heap, $var, $value) = @_;
+
+    $self->set_var($heap->{heap}{server} . '@' . lc($heap->{from}),
+        { $var => $value });
+}
+
+sub run {
+    my ($self) = @_;
+
+    if ($self->{options}{ircserver}) {
+        $self->setup_server(
+            $self->{options}{ircserver},
+            $self->{options}{ircnick},
+        );
+    } else {
+        my $resp = $self->send_request('user.fetchdata', 'botconfig');
+        if (ref $resp) {
+            if ($resp->value) {
+                foreach (ref($resp->value->{server}) ? @{$resp->value->{server}}
+                    : $resp->value->{server}) {
+                    $self->setup_server($_);
+                }
+            } else {
+                warn "No config found\n";
+                return;
+            }
+        } else {
+            warn "Cannot fetch config\n";
+            return;
+        }
+    }
+
+    POE::Kernel->run();
+}
+
+1;
+__END__
+# Below is stub documentation for your module. You'd better edit it!
+
+=head1 NAME
+
+Sophie::Client - Perl extension for blah blah blah
+
+=head1 SYNOPSIS
+
+  use Sophie::Client;
+  blah blah blah
+
+=head1 DESCRIPTION
+
+Stub documentation for Sophie::Client, created by h2xs. It looks like the
+author of the extension was negligent enough to leave the stub
+unedited.
+
+Blah blah blah.
+
+
+=head1 SEE ALSO
+
+Mention other useful documentation such as the documentation of
+related modules or operating system documentation (such as man pages
+in UNIX), or any relevant external documentation such as RFCs or
+standards.
+
+If you have a mailing list set up for your module, mention it here.
+
+If you have a web site set up for your module, mention it here.
+
+=head1 AUTHOR
+
+Olivier Thauvin, E<lt>olivier@localdomainE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2010 by Olivier Thauvin
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.12.2 or,
+at your option, any later version of Perl 5 you may have available.
+
+
+=cut
Index: /bot/trunk/lib/Sophie/Bot/Term.pm
===================================================================
--- /bot/trunk/lib/Sophie/Bot/Term.pm	(revision 302)
+++ /bot/trunk/lib/Sophie/Bot/Term.pm	(revision 302)
@@ -0,0 +1,93 @@
+package Sophie::Bot::Term;
+
+use 5.010000;
+use strict;
+use warnings;
+use Term::ReadLine;
+use base qw(Sophie::Bot);
+
+our $VERSION = '0.01';
+
+{
+    open (my $fh, "/dev/tty" )
+        or eval 'sub Term::ReadLine::findConsole { ("&STDIN", "&STDERR") }';
+    die $@ if $@;
+    close ($fh);
+}
+
+sub show_reply {
+    my ($self, $heap, $reply) = @_;
+    print "$_\n" foreach (@{$reply->{message}});
+}
+
+sub user_config {
+    my ($self, $heap, $var, $value) = @_;
+
+    $self->set_var('client', { $var => $value });
+}
+
+sub run {
+    my ($self) = @_;
+
+    my $term = Term::ReadLine->new('Sophie');
+    $term->MinLine(99999);
+    my $OUT = $term->OUT || \*STDOUT;
+
+    while (1) {
+        defined (my $line = $term->readline('Sophie > ')) or do {
+            print $OUT "\n";
+            return;
+        };
+        $self->handle_message(undef, [ 'client' ], $line);
+        $term->addhistory($line);
+    }
+}
+
+1;
+
+__END__
+# Below is stub documentation for your module. You'd better edit it!
+
+=head1 NAME
+
+Sophie::Client - Perl extension for blah blah blah
+
+=head1 SYNOPSIS
+
+  use Sophie::Client;
+  blah blah blah
+
+=head1 DESCRIPTION
+
+Stub documentation for Sophie::Client, created by h2xs. It looks like the
+author of the extension was negligent enough to leave the stub
+unedited.
+
+Blah blah blah.
+
+
+=head1 SEE ALSO
+
+Mention other useful documentation such as the documentation of
+related modules or operating system documentation (such as man pages
+in UNIX), or any relevant external documentation such as RFCs or
+standards.
+
+If you have a mailing list set up for your module, mention it here.
+
+If you have a web site set up for your module, mention it here.
+
+=head1 AUTHOR
+
+Olivier Thauvin, E<lt>olivier@localdomainE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2010 by Olivier Thauvin
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.12.2 or,
+at your option, any later version of Perl 5 you may have available.
+
+
+=cut
Index: /bot/trunk/t/Sophie-IrcBot.t
===================================================================
--- /bot/trunk/t/Sophie-IrcBot.t	(revision 302)
+++ /bot/trunk/t/Sophie-IrcBot.t	(revision 302)
@@ -0,0 +1,18 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl Sophie-IrcBot.t'
+
+#########################
+
+# change 'tests => 1' to 'tests => last_test_to_print';
+
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+BEGIN { use_ok('Sophie::IrcBot') };
+
+#########################
+
+# Insert your test code below, the Test::More module is use()ed here so read
+# its man page ( perldoc Test::More ) for help writing this test script.
+
