WIP Adding paste and image download modules

* Adding link shortener/paste module
* Adding image downloder
* Added TODO/Wish list
* add Exporter to modules

lib/easter_egg.pm

@@ -6,6 +6,9 @@ use vars qw/$VERSION/;
 
 $VERSION = "1.0";
 
+use Exporter qw(import);
+our @EXPORT = qw(quote chanserv nickserv me);
+
 sub quote {
 	if (-f "/usr/games/fortune") {
 		return ('200', 'text/plain', `fortune`);

lib/image_dl.pm

@@ -0,0 +1,135 @@
+package image_dl;
+
+use strict;
+use warnings "all";
+use HTTP::Tiny;
+use Net::SSLeay;
+use IO::Socket::SSL;
+use Image::Magick;
+
+use Exporter qw(import);
+use vars qw/$VERSION/;
+$VERSION = "1.0";
+our @EXPORT = qw(queue_image dl_thread);
+
+
+
+sub queue_image (@) {
+	my $url = shift;
+	my $images = shift;
+	push @{$images}, $url;
+	return('200', 'text/plain', "Download queued\n");
+}
+
+sub __urlencode($) {
+	my $url = shift;
+	my $urlobj = url $url;
+	$url = $urlobj->as_string;
+	undef $urlobj;
+	return $url;
+}
+
+sub __is_picture($) {
+	my $url = shift;
+	$url = __urlencode($url);
+	my $r = undef;
+
+	eval {
+		my $http = HTTP::Tiny->new();
+		$r = $http->request('HEAD', $url);
+		undef $http;
+	};
+
+	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;
+	}
+
+	undef $url;
+	return $r;
+}
+
+sub __dlfunc(@) {
+	my $url = shift;
+	my $file = shift;
+	$url = __urlencode($url);
+
+	eval {
+		my $http1 = HTTP::Tiny->new();
+		$http1->mirror($url, $file);
+		undef $http1;
+	};
+
+	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);
+			}
+
+			undef $im;
+			undef $rename;
+			undef $format;
+		}
+	}
+
+	#undef $url;
+	#undef $file;
+	#return;
+}
+
+
+sub dl_thread (@) {
+	my $dir = shift;
+	my $sleep = shift;
+	threads->detach();
+
+	while ( 1 ) {
+		if (@{main::images} > 0) {
+			my @pic = @{main::images};
+			@{main::images} = -1;
+
+			foreach my $url (@pic) {
+				my $extension = __is_picture($url);
+
+				if (defined($extension)) {
+					my $savepath = $dir;
+					mkdir ($savepath) unless (-d $savepath);
+					my $fname = $url;
+					$fname =~ s/[^\w!., -#]/_/g;
+					$savepath = sprintf("%s/%s.%s", $savepath, $fname, $extension);
+
+					if ( (lc($url) =~ /\.(gif|jpe?g|png|webm|mp4)$/) and ($1 eq $extension) ) {
+						$savepath = $dir . "/" . $fname;
+					}
+
+					__dlfunc($url, $savepath);
+					undef $savepath;
+					undef $fname;
+				}
+
+				undef $url;
+				undef $extension;
+			}
+			@pic = -1; undef @pic;
+		} else {
+			sleep ($sleep);
+		}
+	}
+
+	return;
+}
+
+1;

lib/paste.pm

@@ -0,0 +1,30 @@
+package paste;
+
+use strict;
+use vars qw/$VERSION/;
+
+$VERSION = "1.0";
+
+sub shorten {
+	if (defined($env{HTTP_LINK}) {
+
+	} else {
+		if (defined($env{'QUERY_STRING'}) && $env{'QUERY_STRING'} < 8) {
+			unless (open (L, "data/links.txt")) {
+				return('500', 'text/plain', "Bad permission\n");
+			}
+
+			while (my $str = <L>) {
+
+			}
+
+			return('302', 'text/plain', "$link\n");
+		} else {
+			return ('200', 'text/plain', "What?\n");
+		}
+	}
+
+	return ('200', 'text/plain', "$msg\n");
+}
+
+1;

lib/ping.pm

@@ -3,6 +3,9 @@ package ping;
 use strict;
 use vars qw/$VERSION/;
 
+use Exporter qw(import);
+our @EXPORT = qw(pong);
+
 $VERSION = "1.0";
 
 sub pong {

lib/utils.pm

@@ -4,9 +4,12 @@ use strict;
 use Socket; # for name resolves
 use Net::LibIDN ':all';
 use vars qw/$VERSION/;
-
 $VERSION = "1.0";
 
+use Exporter qw(import);
+our @EXPORT = qw(ip getaddrbyname getnamebyaddr pubycoder punydecoder mytime);
+
+
 sub ip ($) {
 	my $env = shift;
 	my $msg = '';