#!/usr/bin/perl

use warnings;
use strict;

use POE;
use POE::Component::Server::HTTP;
use POE::Component::IRC;
use CGI ":standard";
use Fcntl;
use Data::Dumper;

sub CHANNEL () { "#REMFiles" }

# Start an HTTP server. Run it until it's done, typicall forever,
# and then exit the program.

POE::Component::IRC->new("remnet");

my $nick = 'REMBot';

POE::Session->create(
    inline_states => {
        irc_disconnected    =>    \&bot_reconnect,
        irc_error         =>    \&bot_reconnect,
        irc_socketerr         =>    \&bot_reconnect,
        _default         =>    \&_default,
        _start             =>    \&bot_start,
        connect             =>    \&on_connect,
        autoping         =>    \&bot_do_autoping,
        irc_001             =>    \&on_connected,
    },
);

POE::Component::Server::HTTP->new(
    Port        => 42000,
    ContentHandler    => {
        '/'    => \&root_handler,
        '/post/'=> \&post_handler,
    }
);

POE::Kernel->run();
exit 0;

sub _default {
    my ( $event, $args ) = @_[ ARG0, ARG1 ];
    $args ||= [];
    print "default: $event (@$args)\n";
    return 0;
}

sub bot_start {
    my $kernel    = $_[KERNEL];
    my $heap    = $_[HEAP];
    my $session    = $_[SESSION];
    
    $kernel->post( remnet => register => "all" );

    $kernel->yield("connect");

}

sub on_connect {
    my ( $kernel, $heap ) = @_[ KERNEL, HEAP ];
    $kernel->post( remnet => connect => { 
        Nick => $nick,
        Username => 'FileBot',
        Ircname  => 'POE::Component::IRC FileBot',
        Server   => 'irc.remnetworks.org',
        Port     => '6667',
        }
    );
}

sub on_connected {
    my $kernel  = $_[KERNEL];
    my $heap    = $_[HEAP];
    my $session = $_[SESSION];

    $kernel->post( remnet => join => CHANNEL );
    $heap->{seen_traffic} = 1;
    $kernel->delay( autoping => 300 );
}

sub bot_do_autoping {
    my $kernel  = $_[KERNEL];
    my $heap    = $_[HEAP];
    my $session = $_[SESSION];
    $kernel->post( remnet => userhost => $nick ) unless $heap->{seen_t
+raffic};
    $heap->{seen_traffic} = 0;
    $kernel->delay( autoping => 300 );
}

sub bot_reconnect {
    my $kernel = $_[KERNEL];
    $kernel->delay( autoping => undef );
    $kernel->delay( connect  => 60 );
}

sub root_handler {
    my ( $request, $response ) = @_;

    $response->code(RC_OK);
    $response->content(
            start_html("FileUploads") .
                start_form(
            -method => "post",
            -action => "/post",
            -enctype=> "multipart/form-data"
        ) .
        "File to Up: " . filefield(-name=>'file') . br() .
        submit( "submit", "submit" ) .
        end_form() .
        end_html()
    );

    return RC_OK;
}

# Handle simple CGI parameters.
#
# This code was contributed by Andrew Chen.  It handles GET and POST,
# but it does not handle %ENV-based CGI things.  It does not handle
# cookies, for instance.  Neither does it handle file uploads.

sub post_handler {
    my ( $request, $response ) = @_;

    print Dumper $request;

    my $uploads = "/home/ovrlrdq/scripts/filebot/files";
    my $cgi;

    if ($request->method() eq 'POST' ) {
        $cgi = new CGI( $request->content );
    } else {
        $request->uri() =~ /\?(.+$)/;
        if ( define($1) ) {
            $cgi = new CGI($1);
        } else {
            $cgi = new CGI;
        }
    }

    print Dumper $cgi;
    
    my $file = $cgi->param("file");
    $file =~ s/.*[\/\\](.*)/$1/gi;
    $file = lc $file;

    my $upload_filehandle = $cgi->upload("file");
    
    $response->code(RC_OK);

    sysopen(UPLOADFILE, "$uploads/$file", O_WRONLY | O_EXCL | O_CREAT 
+) or die "Cannot do that because $!";
    while ( <$upload_filehandle> ) {
        print UPLOADFILE or die "Cannot do that because $!";
    }
    close UPLOADFILE or die "$!";

    $response->content(
        start_html() .
        title("FileUpload Success") .
        p("File has been uploaded.") .
        end_html()
    );
    
    $poe_kernel->post ( remnet => privmsg => CHANNEL, "Somebody upload
+ed $file");

    return RC_OK;
}
[download]