1

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

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

View File

@@ -4,6 +4,8 @@ use warnings "all";
use strict;
use Cache::Memcached;
use URI::URL;
use threads;
my $HTINY = undef;
my $HTINYS = undef;
@@ -34,12 +36,17 @@ if ($@ eq '') {
}
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;
import Image::Magick qw(ping);
return 1;
};
if ($@ eq '') {
$IMAGEMAGICK = 1;
}
}
sub dlfunc(@);
@@ -61,16 +68,25 @@ while ( 1 ) {
my $memd = new Cache::Memcached { 'servers' => [ "127.0.0.1:11211" ] };
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 $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"});
my @keys = map {
(split(/ /))[1];
} split(/\n/, $cachedump->{'hosts'}->{'127.0.0.1:11211'}->{"cachedump $slab $itemsamount"});
foreach my $key (@keys) {
next unless ($key =~ /^hcht_/);
next unless ($key =~ /^irssi_/);
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);
}
}
@@ -89,7 +105,7 @@ sub cdlfunc($) {
mkdir ($savepath) unless (-d $savepath);
my $fname = $url;
$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) ) {
$savepath = $ENV{'HOME'} . "/imgsave/" . $fname;

View File

@@ -2,7 +2,7 @@ use HexChat qw(:all);
use strict;
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 Digest::MD5 qw(md5_base64);
@@ -14,7 +14,7 @@ sub savesetting(@);
sub freehooks;
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");
my $help = 'Usage:
@@ -66,7 +66,8 @@ sub hookfn {
my $str = $_;
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 $domainlist = loadliststatus('dl_domainlist');
@@ -97,7 +98,7 @@ sub hookfn {
my $paddr = sockaddr_in($port, $iaddr);
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);