eleksir/hexchat-scripts
1
Fork 0
Code Activity

img-save.pl: more eval magic, cleanups and coding style related stuff

Browse Source
This commit is contained in:
eleksir
2018-02-13 23:17:19 +03:00
parent 0d201b00ba
commit 7d92d74bab
2 changed files with 28 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files

28
web_link_saver/img-save.pl
View File

@@ -4,6 +4,8 @@ use warnings "all";
use strict; use strict;
use Cache::Memcached; use Cache::Memcached;
use URI::URL; use URI::URL;
use threads;
my $HTINY = undef; my $HTINY = undef;
my $HTINYS = undef; my $HTINYS = undef;
@@ -34,12 +36,17 @@ if ($@ eq '') {
} }
my $IMAGEMAGICK = undef; # use on demand my $IMAGEMAGICK = undef; # use on demand
if ($^O ne 'cygwin') { # cygwin 2.882 64-bit has broken Image::Magick
$IMAGEMAGICK = eval { if ($^O ne 'cygwin') { # cygwin 2.882 64-bit has broken Image::Magick
eval {
require Image::Magick; require Image::Magick;
import Image::Magick qw(ping); import Image::Magick qw(ping);
return 1; return 1;
}; };
if ($@ eq '') {
$IMAGEMAGICK = 1;
}
} }
sub dlfunc(@); sub dlfunc(@);
@@ -61,16 +68,25 @@ while ( 1 ) {
my $memd = new Cache::Memcached { 'servers' => [ "127.0.0.1:11211" ] }; my $memd = new Cache::Memcached { 'servers' => [ "127.0.0.1:11211" ] };
my $itemref = $memd->stats(['items']); my $itemref = $memd->stats(['items']);
if (defined($itemref->{'hosts'}->{'127.0.0.1:11211'}->{'items'}) and (length($itemref->{'hosts'}->{'127.0.0.1:11211'}->{'items'}) > 2)) { if (defined($itemref->{'hosts'}->{'127.0.0.1:11211'}->{'items'})
and (length($itemref->{'hosts'}->{'127.0.0.1:11211'}->{'items'}) > 2)) {
my $slabinfo = (split("\n", $itemref->{'hosts'}->{'127.0.0.1:11211'}->{'items'}))[0]; my $slabinfo = (split("\n", $itemref->{'hosts'}->{'127.0.0.1:11211'}->{'items'}))[0];
my $slab = (split(/\:/, $slabinfo))[1]; my $slab = (split(/\:/, $slabinfo))[1];
my $itemsamount = (split(/ /, $slabinfo))[2]; my $itemsamount = (split(/ /, $slabinfo))[2];
my $cachedump = $memd->stats(["cachedump $slab $itemsamount"]); my $cachedump = $memd->stats(["cachedump $slab $itemsamount"]);
my @keys = map { (split(/ /))[1] } split(/\n/, $cachedump->{'hosts'}->{'127.0.0.1:11211'}->{"cachedump $slab $itemsamount"});
my @keys = map {
(split(/ /))[1];
} split(/\n/, $cachedump->{'hosts'}->{'127.0.0.1:11211'}->{"cachedump $slab $itemsamount"});
foreach my $key (@keys) { foreach my $key (@keys) {
next unless ($key =~ /^hcht_/);
next unless ($key =~ /^irssi_/);
my $url = $memd->get($key); my $url = $memd->get($key);
cdlfunc($url); my $t = threads->create('cdlfunc', $url);
$t->detach() if (defined($t)); # detach only if we succeed in creating thread :)
undef $t;
$memd->delete($key); $memd->delete($key);
} }
} }
@@ -89,7 +105,7 @@ sub cdlfunc($) {
mkdir ($savepath) unless (-d $savepath); mkdir ($savepath) unless (-d $savepath);
my $fname = $url; my $fname = $url;
$fname =~ s/[^\w!., -#]/_/g; $fname =~ s/[^\w!., -#]/_/g;
$savepath = $savepath . "/" . $fname . ".$extension"; $savepath = sprintf("%s/%s.%s", $savepath, $fname, $extension);
if ( (lc($url) =~ /\.(gif|jpe?g|png|webm|mp4)$/) and ($1 eq $extension) ) { if ( (lc($url) =~ /\.(gif|jpe?g|png|webm|mp4)$/) and ($1 eq $extension) ) {
$savepath = $ENV{'HOME'} . "/imgsave/" . $fname; $savepath = $ENV{'HOME'} . "/imgsave/" . $fname;

11
web_link_saver/img_url_memc.pl
View File

@@ -2,7 +2,7 @@ use HexChat qw(:all);
use strict; use strict;
use warnings "all"; use warnings "all";
use Socket; # hexchat in windows does not ship proper memcache interface, so we will use Socket; # hexchat in windows does not ship any memcache interface, so we will
# use Socket module and memcache text protocol # use Socket module and memcache text protocol
use Digest::MD5 qw(md5_base64); use Digest::MD5 qw(md5_base64);
@@ -14,7 +14,7 @@ sub savesetting(@);
sub freehooks; sub freehooks;
my $script_name = "URL_Memcacher"; my $script_name = "URL_Memcacher";
HexChat::register($script_name, '0.3', 'Automatically stores URLs to Memcache', \&freehooks); HexChat::register($script_name, '0.3.1', 'Automatically stores URLs to Memcache', \&freehooks);
HexChat::print("$script_name loaded\n"); HexChat::print("$script_name loaded\n");
my $help = 'Usage: my $help = 'Usage:
@@ -66,7 +66,8 @@ sub hookfn {
my $str = $_; my $str = $_;
next unless(substr($str, 0, 4) eq 'http'); next unless(substr($str, 0, 4) eq 'http');
if ($str =~ m{https?://([a-zA-Z0-9.-]+\.[a-zA-Z]+)/(?:.*)}) { # disregard idn, until it cause real troubles :)
if ($str =~ m{https?://([a-zA-Z0-9\.\-_]+\.[a-zA-Z]+)/(?:.*)}) {
my $domain = $1; my $domain = $1;
my $domainlist = loadliststatus('dl_domainlist'); my $domainlist = loadliststatus('dl_domainlist');
@@ -95,9 +96,9 @@ sub hookfn {
if (socket(SOCK, PF_INET, SOCK_STREAM, getprotobyname('tcp'))) { if (socket(SOCK, PF_INET, SOCK_STREAM, getprotobyname('tcp'))) {
my $iaddr = inet_aton($host); my $iaddr = inet_aton($host);
my $paddr = sockaddr_in($port, $iaddr); my $paddr = sockaddr_in($port, $iaddr);
if (connect(SOCK, $paddr)) { if (connect(SOCK, $paddr)) {
send (SOCK, sprintf("set %s 0 0 %s noreply\r\n%s\r\nquit\r\n", md5_base64($str), length($str), $str), 0); send (SOCK, sprintf("set xchtlink_%s 0 0 %s noreply\r\n%s\r\nquit\r\n", md5_base64($str), length($str), $str), 0);
} }
close(SOCK); close(SOCK);