136 lines
2.6 KiB
Perl
136 lines
2.6 KiB
Perl
package CelBot::Plugin::URLInfo;
|
|
|
|
use strict;
|
|
use constant PLUGIN_TYPE => "urlinfo";
|
|
|
|
use CelBot::Connector;
|
|
use CelBot::Commands;
|
|
|
|
use Net::Async::HTTP;
|
|
|
|
use constant KIBI => 1024;
|
|
use constant MEBI => 1024*1024;
|
|
use constant GIBI => 1024*1024*1024;
|
|
|
|
use URI;
|
|
|
|
sub new
|
|
{
|
|
my $class = shift;
|
|
my ( $core, $config ) = @_;
|
|
|
|
my $self = bless {
|
|
core => $core,
|
|
http => Net::Async::HTTP->new,
|
|
}, $class;
|
|
|
|
$core->get_loop->add( $self->{http} );
|
|
|
|
return $self;
|
|
}
|
|
|
|
my @ordinals = (qw(
|
|
first
|
|
second
|
|
third
|
|
fourth
|
|
fifth
|
|
sixth
|
|
seventh
|
|
eighth
|
|
ninth
|
|
tenth
|
|
eleventh
|
|
twelfth
|
|
));
|
|
|
|
sub get_url_info
|
|
{
|
|
my $self = shift;
|
|
my ( $url, $on_info ) = @_;
|
|
|
|
my $http = $self->{http};
|
|
|
|
$http->do_request(
|
|
method => "HEAD",
|
|
uri => URI->new( $url ),
|
|
|
|
on_response => sub {
|
|
my ( $response ) = @_;
|
|
|
|
my $code = $response->code;
|
|
|
|
if( $code == 200 ) {
|
|
my $type = $response->content_type;
|
|
|
|
$type = "unknown" if !defined $type;
|
|
|
|
# Trim off a trailing charset declaration
|
|
$type =~ s/;.*$//;
|
|
|
|
my $size = $response->content_length;
|
|
|
|
if( !defined $size ) { $size = "unknown"; }
|
|
elsif( $size > GIBI ) { $size = sprintf '%.1f GiB', $size / GIBI; }
|
|
elsif( $size > MEBI ) { $size = sprintf '%.1f MiB', $size / MEBI; }
|
|
elsif( $size > KIBI ) { $size = sprintf '%.1f kiB', $size / KIBI; }
|
|
else { $size = "$size bytes"; }
|
|
|
|
$on_info->( "$type, size $size" );
|
|
}
|
|
elsif( $code == 301 or $code == 302 ) {
|
|
my $location = $response->header( "Location" );
|
|
$on_info->( "redirection to $location" );
|
|
}
|
|
else {
|
|
my $status = $response->message;
|
|
$status =~ s/\r//; # Trim linefeed
|
|
$on_info->( "$status [$code]" );
|
|
}
|
|
},
|
|
|
|
on_error => sub {
|
|
my ( $message ) = @_;
|
|
$on_info->( "unfetchable - $message" );
|
|
},
|
|
);
|
|
}
|
|
|
|
###
|
|
# Commands
|
|
###
|
|
|
|
sub register_commands
|
|
{
|
|
my $self = shift;
|
|
my ( $commands_plugin ) = @_;
|
|
|
|
$commands_plugin->register(
|
|
plugin => $self,
|
|
command => "urlinfo",
|
|
scope => "privmsg|channel",
|
|
|
|
args => [
|
|
CelBot::Commands::ArgSpec::Bareword->new( 'url' ),
|
|
],
|
|
|
|
summary => "Display information on the given URL",
|
|
);
|
|
}
|
|
|
|
sub command_urlinfo
|
|
{
|
|
my $self = shift;
|
|
my ( $context, $url ) = @_;
|
|
|
|
$self->get_url_info( $url,
|
|
sub {
|
|
$context->respond( "URL is $_[0]" );
|
|
}
|
|
);
|
|
|
|
return (); # No response yet
|
|
}
|
|
|
|
# Keep perl happy, keep Britain tidy
|
|
1;
|