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

Revision 5627, 2.0 kB (checked in by charsbar, 6 years ago)

lang/perl/Charsbot: imported

Line 
1package Charsbot::Module::URI;
2
3use strict;
4use warnings;
5use base qw( Bot::BasicBot::Pluggable::Module );
6
7use URI::Find::UTF8;
8use LWP::UserAgent;
9use Encode;
10use HTTP::Response::Encoding;
11
12my $ua = LWP::UserAgent->new;
13   $ua->timeout(10);
14   $ua->max_size(1 << 16);
15
16sub init {
17  my $self = shift;
18
19  $self->{finder} = URI::Find::UTF8->new( \&_finder );
20}
21
22sub seen {
23  my ($self, $message) = @_;
24
25  return if $message->{who} =~ /bot$/i;
26
27  my $body = $message->{body};
28
29  if ( $self->{finder}->find(\$body) ) {
30    $self->reply( $message => $body );
31  }
32}
33
34sub _finder {
35  my ($uri, $uri_str) = @_;
36
37  my $response = $ua->get( $uri );
38
39  if ( $response->is_success ) {
40    my $content_type = $response->content_type;
41    my $encoding     = $response->encoding;
42
43    my $title;
44    if ( $content_type =~ /^text/i ) {
45      if ( $response->header('title') ) {
46        $title = $response->header('title');
47      }
48      elsif ( $response->content ) {
49        ($title) = $response->content =~ m{<TITLE>(.+?)</TITLE>}is;
50      }
51      $title = decode( $encoding, $title ) if $encoding;
52    }
53    $title = '' unless defined $title;
54
55    my $size = $response->header('content-range')
56            || $response->content_length;
57    if ( $size ) {
58      if ( $size =~ m{/} ) {
59        my $range; ($range, $size) = split '/', $size;
60      }
61
62      my $unit = 'byte';
63      if ( $size > 1024 ) { $size >>= 10; $unit = 'KB'; }
64      if ( $size > 1024 ) { $size >>= 10; $unit = 'MB'; }
65      $size = " ($size$unit)";
66    }
67    $size = '' unless defined $size;
68
69    return "$title [$content_type]$size";
70  }
71  return;
72}
73
741;
75
76__END__
77
78=head1 NAME
79
80Charsbot::Module::URI
81
82=head1 SYNOPSIS
83
84=head1 DESCRIPTION
85
86=head1 METHODS
87
88=head2 new
89
90=head1 AUTHOR
91
92Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
93
94=head1 COPYRIGHT AND LICENSE
95
96Copyright (C) 2008 by Kenichi Ishigaki.
97
98This program is free software; you can redistribute it and/or
99modify it under the same terms as Perl itself.
100
101
102=cut
Note: See TracBrowser for help on using the browser.