Add sample memcache plugin and client for storing and processing web links.
This commit is contained in:
eleksir
179
web_link_saver/img-save.pl
Normal file
179
web_link_saver/img-save.pl
Normal file
@@ -0,0 +1,179 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
use warnings "all";
|
||||
use strict;
|
||||
use Cache::Memcached;
|
||||
use URI::URL;
|
||||
my $HTINY = undef;
|
||||
my $HTINYS = undef;
|
||||
$HTINY = eval {
|
||||
require HTTP::Tiny; # stock perl module, but some assholes from debian rip perl into modules,
|
||||
import HTTP::Tiny; # so there is non-zero possibility that we have no this module
|
||||
$HTINYS = HTTP::Tiny->can_ssl; # to operate ssl stuff, we need Net::SSLeay, but sometimes
|
||||
return 1; # installed perl environment lacks it, so use Tiny with care
|
||||
};
|
||||
|
||||
my $IMAGEMAGICK = undef; # use on demand
|
||||
if ($^O ne 'cygwin') { # cygwin 2.882 64-bit has broken Image::Magick
|
||||
$IMAGEMAGICK = eval {
|
||||
require Image::Magick;
|
||||
import Image::Magick qw(ping);
|
||||
return 1;
|
||||
};
|
||||
}
|
||||
|
||||
sub dlfunc(@);
|
||||
sub cdlfunc($); # thread, that checks and downloads stuff
|
||||
sub is_picture($);
|
||||
sub urlencode($);
|
||||
|
||||
my $wgetpath = '';
|
||||
|
||||
if (-f "/bin/wget") {
|
||||
$wgetpath = '/bin/wget';
|
||||
} elsif (-f "/usr/bin/wget") {
|
||||
$wgetpath = '/usr/bin/wget';
|
||||
} elsif (-f "/usr/local/bin/wget") {
|
||||
$wgetpath = '/usr/local/bin/wget';
|
||||
}
|
||||
|
||||
while ( 1 ) {
|
||||
my $memd = new Cache::Memcached { 'servers' => [ "127.0.0.1:11211" ] };
|
||||
my $itemref = $memd->stats(['items']);
|
||||
|
||||
if (length($itemref->{'hosts'}->{'127.0.0.1:11211'}->{'items'}) > 2) {
|
||||
my $slabinfo = (split("\n", $itemref->{'hosts'}->{'127.0.0.1:11211'}->{'items'}))[0];
|
||||
my $slab = (split(/\:/, $slabinfo))[1];
|
||||
my $itemsamount = (split(/ /, $slabinfo))[2];
|
||||
my $cachedump = $memd->stats(["cachedump $slab $itemsamount"]);
|
||||
my @keys = map { (split(/ /))[1] } split(/\n/, $cachedump->{'hosts'}->{'127.0.0.1:11211'}->{"cachedump $slab $itemsamount"});
|
||||
|
||||
foreach my $key (@keys) {
|
||||
my $url = $memd->get($key);
|
||||
cdlfunc($url);
|
||||
$memd->delete($key);
|
||||
}
|
||||
}
|
||||
|
||||
$memd->disconnect_all;
|
||||
sleep(30);
|
||||
}
|
||||
|
||||
|
||||
sub cdlfunc($) {
|
||||
my $url = shift;
|
||||
my $extension = is_picture($url);
|
||||
|
||||
if (defined($extension)) {
|
||||
my $savepath = sprintf("%s/imgsave", $ENV{'HOME'});
|
||||
mkdir ($savepath) unless (-d $savepath);
|
||||
my $fname = $url;
|
||||
$fname =~ s/[^\w!., -#]/_/g;
|
||||
$savepath = $savepath . "/" . $fname . ".$extension";
|
||||
|
||||
if ( (lc($url) =~ /\.(gif|jpeg|png|webm|mp4)$/) and ($1 eq $extension) ){
|
||||
$savepath = $ENV{'HOME'} . "/imgsave/" . $fname;
|
||||
}
|
||||
|
||||
dlfunc($url, $savepath);
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub dlfunc(@) {
|
||||
my $url = shift;
|
||||
my $file = shift;
|
||||
$url = urlencode($url);
|
||||
|
||||
if (($url =~ /^https/) and defined($HTINY) and ($HTINYS)) {
|
||||
eval {
|
||||
my $http1 = HTTP::Tiny->new();
|
||||
$http1->mirror($url, $file);
|
||||
undef $http1;
|
||||
};
|
||||
} elsif (defined($HTINY)) {
|
||||
eval {
|
||||
my $http2 = HTTP::Tiny->new();
|
||||
$http2->mirror($url, $file);
|
||||
undef $http2;
|
||||
};
|
||||
} else {
|
||||
system($wgetpath, '--no-check-certificate', '-q', '-T', '20', '-O', $file, '-o', '/dev/null', $url);
|
||||
}
|
||||
|
||||
if (($^O ne 'cygwin') and defined($IMAGEMAGICK)) {
|
||||
eval {
|
||||
if ($file =~ /(png|jpe?g|gif)$/i){
|
||||
my $im = Image::Magick->new();
|
||||
my $rename = 1;
|
||||
my (undef, undef, undef, $format) = $im->Ping($file);
|
||||
|
||||
if (defined($format)) {
|
||||
$rename = 0 if (($format eq 'JPEG') and ($file =~ /jpe?g$/i));
|
||||
$rename = 0 if (($format eq 'GIF') and ($file =~ /gif$/i));
|
||||
$rename = 0 if (($format =~ /^PNG/) and ($file =~ /png$/i));
|
||||
rename $file, sprintf("%s.%s", $file, lc($format)) if ($rename == 1);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub is_picture($) {
|
||||
my $url = shift;
|
||||
$url = urlencode($url);
|
||||
my $r = undef;
|
||||
|
||||
if (($url =~ /^https/) and defined($HTINY) and ($HTINYS)) {
|
||||
eval {
|
||||
my $http = HTTP::Tiny->new();
|
||||
$r = $http->request('HEAD', $url);
|
||||
undef $url;
|
||||
undef $http;
|
||||
};
|
||||
} elsif (defined($HTINY)) {
|
||||
eval {
|
||||
my $http = HTTP::Tiny->new();
|
||||
$r = $http->request('HEAD', $url);
|
||||
undef $url;
|
||||
undef $http;
|
||||
};
|
||||
} else {
|
||||
$r = `$wgetpath --no-check-certificate -q --method=HEAD -S --timeout=5 "$url" 2>&1`;
|
||||
if ($? == 0) {
|
||||
foreach (split(/\n/, $r)) {
|
||||
next unless($_ =~ /Content\-Type: (.+)/);
|
||||
my $h = ($1); chomp($h);
|
||||
$r->{'success'} = 1;
|
||||
$r->{'headers'}->{'content-type'} = $h;
|
||||
last;
|
||||
}
|
||||
} else {
|
||||
$r->{'success'} = 0;
|
||||
}
|
||||
}
|
||||
|
||||
if ($r->{'success'} and defined($r->{'headers'}->{'content-type'})) {
|
||||
if ($r->{'headers'}->{'content-type'} =~ /^image\/gif/) { $r = 'gif'; }
|
||||
elsif ($r->{'headers'}->{'content-type'} =~ /^image\/jpe?g/){ $r = 'jpeg';}
|
||||
elsif ($r->{'headers'}->{'content-type'} =~ /^image\/png/) { $r = 'png'; }
|
||||
elsif ($r->{'headers'}->{'content-type'} =~ /^video\/webm/) { $r = 'webm';}
|
||||
elsif ($r->{'headers'}->{'content-type'} =~ /^video\/mp4/) { $r = 'mp4'; }
|
||||
else { $r = undef; }
|
||||
} else {
|
||||
$r = undef;
|
||||
}
|
||||
|
||||
return $r;
|
||||
}
|
||||
|
||||
sub urlencode($) {
|
||||
my $url = shift;
|
||||
my $urlobj = url $url;
|
||||
$url = $urlobj->as_string;
|
||||
undef $urlobj;
|
||||
return $url;
|
||||
}
|
||||
41
web_link_saver/link_to_memc.pl
Normal file
41
web_link_saver/link_to_memc.pl
Normal file
@@ -0,0 +1,41 @@
|
||||
#use strict;
|
||||
#use warnings "all";
|
||||
use Cache::Memcached;
|
||||
use Digest::MD5 qw(md5_base64);
|
||||
|
||||
use Irssi qw (command_bind
|
||||
settings_get_bool settings_add_bool
|
||||
settings_get_str settings_add_str);
|
||||
use vars qw($VERSION %IRSSI);
|
||||
|
||||
sub hookfn;
|
||||
|
||||
$VERSION = '1.00';
|
||||
%IRSSI = (
|
||||
authors => 'Eleksir',
|
||||
contact => 'eleksir@exs-elm.ru',
|
||||
name => 'Image link saver',
|
||||
description => 'Saves image link to memcache',
|
||||
license => 'Public Domain',
|
||||
changed => 'Sun Oct 02 12:21 CET 2016',
|
||||
);
|
||||
|
||||
|
||||
Irssi::signal_add_last("message public", "hookfn");
|
||||
|
||||
sub hookfn {
|
||||
my ($a, $text, $b, $c) = @_;
|
||||
my @words = split(/\s+/, $text);
|
||||
|
||||
foreach (@words) {
|
||||
if ($_ =~ m{:?https?://([a-zA-Z0-9.-]+\.[a-zA-Z]+)/(?:.*)}) {
|
||||
my $memd = new Cache::Memcached { 'servers' => [ "127.0.0.1:11211" ] };
|
||||
$memd->set(md5_base64($str), $str);
|
||||
$memd->disconnect_all;
|
||||
last;
|
||||
}
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
13
web_link_saver/readme.md
Normal file
13
web_link_saver/readme.md
Normal file
@@ -0,0 +1,13 @@
|
||||
## link_to_memc.pl
|
||||
|
||||
Script that greps http(s) links from irc conversations and put 'em to memcache on 127.0.0.1:11211
|
||||
|
||||
## img-save.pl
|
||||
|
||||
Sample memcache clients that loops every 30 seconds over stored memcache keys, downloads images and cleans up processed links
|
||||
|
||||
## purpose of these scripts
|
||||
|
||||
irssi api is not thread-safe. If you need asynchronously process something in irssi the only way to make it by using threads. But using threads cause memory leak and possibly something more bad (but i didn't observe some other side effects). Another way to make things asynchronously is to store data that should be processed in some fast storage and run separate process that hammer data from this storage.
|
||||
|
||||
Downloading images is time consuming task. During data transfer irssi itself becomes unresponsitive.
|
||||
Reference in New Issue
Block a user