mirror of
https://github.com/perlbot/perlbuut
synced 2025-06-07 16:15:39 -04:00
adding stuff
This commit is contained in:
parent
17d48f5419
commit
dcecc76f6e
3 changed files with 156 additions and 0 deletions
60
plugins/core.pm.bak
Normal file
60
plugins/core.pm.bak
Normal file
|
@ -0,0 +1,60 @@
|
||||||
|
BEGIN {do Module::CoreList};
|
||||||
|
|
||||||
|
sub require {
|
||||||
|
my ($filename) = @_;
|
||||||
|
if (exists $INC{$filename}) {
|
||||||
|
return 1 if $INC{$filename};
|
||||||
|
die "Compilation failed in require";
|
||||||
|
}
|
||||||
|
my ($realfilename,$result);
|
||||||
|
ITER: {
|
||||||
|
foreach $prefix (@INC) {
|
||||||
|
$realfilename = "$prefix/$filename";
|
||||||
|
if (-f $realfilename) {
|
||||||
|
$INC{$filename} = $realfilename;
|
||||||
|
$result = do $realfilename;
|
||||||
|
last ITER;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
die "Can't find $filename in \@INC";
|
||||||
|
}
|
||||||
|
if ($@) {
|
||||||
|
$INC{$filename} = undef;
|
||||||
|
die $@;
|
||||||
|
} elsif (!$result) {
|
||||||
|
delete $INC{$filename};
|
||||||
|
die "$filename did not return true value";
|
||||||
|
} else {
|
||||||
|
return $result;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
sub {
|
||||||
|
my ( $said, $pm ) = @_;
|
||||||
|
my $module = $said->{recommended_args}->[0];
|
||||||
|
|
||||||
|
my $rev = Module::CoreList->first_release($module);
|
||||||
|
if ($rev) {
|
||||||
|
print "Added to perl core as of $rev";
|
||||||
|
if ( Module::CoreList->can('removed_from') ) {
|
||||||
|
my $rem = Module::CoreList->removed_from($module);
|
||||||
|
print " and removed from $rem" if $rem;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
my @modules = Module::CoreList->find_modules(qr/$module/);
|
||||||
|
|
||||||
|
if (@modules) {
|
||||||
|
print 'Found', scalar @modules, ':', join ',',
|
||||||
|
map { $_ . ' in ' . Module::CoreList->first_release($_) }
|
||||||
|
@modules;
|
||||||
|
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
print "Module $module does not appear to be in core. Perhaps capitalization matters or try using the 'cpan' command to search for it.";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
__DATA__
|
||||||
|
Tells you when the module you searched for was added to the Perl Core, if it was.
|
45
plugins/define.pm
Normal file
45
plugins/define.pm
Normal file
|
@ -0,0 +1,45 @@
|
||||||
|
package Bot::BB3::Plugin::Define;
|
||||||
|
use Net::Dict;
|
||||||
|
|
||||||
|
sub new {
|
||||||
|
my( $class ) = @_;
|
||||||
|
|
||||||
|
my $self = bless {}, $class;
|
||||||
|
$self->{name} = 'define';
|
||||||
|
$self->{opts} = {
|
||||||
|
command => 1,
|
||||||
|
};
|
||||||
|
|
||||||
|
return $self;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub command {
|
||||||
|
my( $self, $said, $pm ) = @_;
|
||||||
|
my $word = $said->{recommended_args}->[0];
|
||||||
|
|
||||||
|
# Note that our cache only lasts for our
|
||||||
|
# plugin handler's life. Oh well.
|
||||||
|
return $self->{cache}->{$word}
|
||||||
|
if defined $self->{cache}->{$word};
|
||||||
|
|
||||||
|
my $dict = Net::Dict->new('dict.org');
|
||||||
|
$dict->setDicts( 'wn', 'web1913' );
|
||||||
|
|
||||||
|
my $defs = $dict->define( $word );
|
||||||
|
my $definition = $defs->[0]->[1];
|
||||||
|
$definition =~ s/[ \t\n]+/ /g;
|
||||||
|
|
||||||
|
if( $definition ) {
|
||||||
|
$self->{cache}->{$word} = $definition;
|
||||||
|
|
||||||
|
return( 'handled', $definition );
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
return( 'handled', 'Whups, no definition for you' );
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
"Bot::BB3::Plugin::Define";
|
||||||
|
|
||||||
|
__DATA__
|
||||||
|
Attempts to find a definition for a given term. Syntax, define TERM.
|
51
plugins/get.pm
Normal file
51
plugins/get.pm
Normal file
|
@ -0,0 +1,51 @@
|
||||||
|
use LWP::UserAgent;
|
||||||
|
use HTML::TreeBuilder::XPath;
|
||||||
|
|
||||||
|
sub {
|
||||||
|
my( $said ) = @_;
|
||||||
|
|
||||||
|
my $ua = LWP::UserAgent->new( agent => "BB3WebAgent! (mozilla)" );
|
||||||
|
my $url;
|
||||||
|
|
||||||
|
if( $said->{body} =~ s{(http://\S+)\s*}{} ) {
|
||||||
|
$url = $1;
|
||||||
|
}
|
||||||
|
elsif( $said->{body} =~ s/(\S+)\s*// ) {
|
||||||
|
$url = "http://$1";
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
print "That doesn't look like a url..";
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
my $resp = $ua->get( $url );
|
||||||
|
|
||||||
|
if( not $resp ) {
|
||||||
|
print "Couldn't fetch [$url] you failure";
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
my @text;
|
||||||
|
my $document = HTML::TreeBuilder::XPath->new_from_content( $resp->content );
|
||||||
|
if (!$document) {
|
||||||
|
print "Could not parsinate that page!";
|
||||||
|
}
|
||||||
|
# just the xpath left
|
||||||
|
if ($said->{body}) {
|
||||||
|
@text = eval{
|
||||||
|
$document->findvalues( $said->{body} );
|
||||||
|
};
|
||||||
|
@text = "Your Xpath didn't match anything" if 0 == @text;
|
||||||
|
@text = "Your Xpath fails: $@" if $@;
|
||||||
|
}
|
||||||
|
if (! $said->{body} ){
|
||||||
|
@text = ($@,$document->findvalues( '//title' ), ': ',$document->findvalues( '//body' ));
|
||||||
|
}
|
||||||
|
local $, = ', ';
|
||||||
|
|
||||||
|
print map { local $_ = "$_"; s/\s+/ /g;s/^ +//; s/ +$//; $_} @text
|
||||||
|
}
|
||||||
|
|
||||||
|
__DATA__
|
||||||
|
get http://url/ //xpath - get page from interents, extract the xpath, show it to people. (Xpath defaults to '//title' + '//body' ) spaces squashed too
|
Loading…
Add table
Reference in a new issue