root/lang/perl/Charsbot/trunk/lib/Charsbot/Module/URI.pm @ 5627

package Charsbot::Module::URI;

use strict;
use warnings;
use base qw( Bot::BasicBot::Pluggable::Module );

use URI::Find::UTF8;
use LWP::UserAgent;
use Encode;
use HTTP::Response::Encoding;

my $ua = LWP::UserAgent->new;
   $ua->timeout(10);
   $ua->max_size(1 << 16);

sub init {
  my $self = shift;

  $self->{finder} = URI::Find::UTF8->new( \&_finder );
}

sub seen {
  my ($self, $message) = @_;

  return if $message->{who} =~ /bot$/i;

  my $body = $message->{body};

  if ( $self->{finder}->find(\$body) ) {
    $self->reply( $message => $body );
  }
}

sub _finder {
  my ($uri, $uri_str) = @_;

  my $response = $ua->get( $uri );

  if ( $response->is_success ) {
    my $content_type = $response->content_type;
    my $encoding     = $response->encoding;

    my $title;
    if ( $content_type =~ /^text/i ) {
      if ( $response->header('title') ) {
        $title = $response->header('title');
      }
      elsif ( $response->content ) {
        ($title) = $response->content =~ m{<TITLE>(.+?)</TITLE>}is;
      }
      $title = decode( $encoding, $title ) if $encoding;
    }
    $title = '' unless defined $title;

    my $size = $response->header('content-range')
            || $response->content_length;
    if ( $size ) {
      if ( $size =~ m{/} ) {
        my $range; ($range, $size) = split '/', $size;
      }

      my $unit = 'byte';
      if ( $size > 1024 ) { $size >>= 10; $unit = 'KB'; }
      if ( $size > 1024 ) { $size >>= 10; $unit = 'MB'; }
      $size = " ($size$unit)";
    }
    $size = '' unless defined $size;

    return "$title [$content_type]$size";
  }
  return;
}

1;

__END__

=head1 NAME

Charsbot::Module::URI

=head1 SYNOPSIS

=head1 DESCRIPTION

=head1 METHODS

=head2 new

=head1 AUTHOR

Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2008 by Kenichi Ishigaki.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.


=cut