imgur uploader v1.1

imgur.pl

#!/usr/bin/perl
# Robertof's imgur uploader version 1.1
# Author: Guess who? Robertof
# Requirements: LWP::UserAgent, Term::ProgressBar, Getopt::Long, Term::ANSIColor, File::Basename, Pod::Usage
# Based on shura's imageshack uploader.
use strict;
use LWP::UserAgent;
use Term::ProgressBar 2.00;
use Getopt::Long;
use Term::ANSIColor qw(:constants);
use File::Basename;
use Pod::Usage;
# use warnings; # decomment this ONLY if you want to see an annoying warning everytime you start the script.
$HTTP::Request::Common::DYNAMIC_FILE_UPLOAD = 1;
$Term::ANSIColor::AUTORESET = 1;
$main::VERSION = "1.1";
Getopt::Long::Configure ("bundling", "auto_version");

my ($name, $silent, $direct, $del, $page, $thumb, $conf, $apikey, $log, $help, $doc, $clipboard) = undef;
my %options;
my $filehandle;
my @extensions = ("jpg", "jpeg", "png", "gif", "apng", "tiff", "tif", "bmp", "pdf", "xcf");
$SIG{"INT"} = sub { print "\n\nCaught SIGINT\n"; exit 0; };
GetOptions ("silent|s!"  => \$silent,
            "direct|d!"  => \$direct,
            "delete|D!"  => \$del,
            "imgpage|p!" => \$page,
            "thumb|t!"   => \$thumb,
            "clip|C!"    => \$clipboard,
            "conf|c"     => \$conf,
            "key|k=s"    => \$apikey,
            "log|l!"     => \$log,
            "help|h"     => \$help,
            "doc"        => \$doc
           ) or pod2usage (1);
pod2usage (1) if defined $help;
pod2usage (-exitstatus => 0, -verbose => 2) if defined $doc;
$name = shift @ARGV or pod2usage (1) if not defined $help and not defined $doc and not defined $conf and -d $ENV{HOME} . "/.imgur";
my $home = $ENV{HOME};
# 15/5/12 - xclip check #
my $can_clipboard = 0;
my $xclip_path;
if (defined $ENV{"PATH"} and $ENV{"PATH"} ne "")
{
    my @dirs = split /:/, $ENV{"PATH"};
    if (scalar (@dirs) > 0)
    {
        foreach (@dirs)
        {
            if (-d $_ and -e (&addTrailingSlash ($_) . "xclip"))
            {
                $can_clipboard = 1;
                $xclip_path    = addTrailingSlash ($_) . "xclip";
                last;
            }
        }
    }
}
$clipboard = 0 if (not $can_clipboard and $clipboard);
# end xclip check #
if ($conf or not -d "${home}/.imgur" or not -e "${home}/.imgur/conf") {
    print BOLD MAGENTA "** Warning: ${home}/.imgur directory already exists. Overwriting..\n" if -d "${home}/.imgur";
    print BOLD GREEN " ! ** imgur uploader configuration ** !\n";
    print BOLD YELLOW "-> Welcome.\n";
    print BOLD YELLOW "-> What is your API key ? (get one here: " . BLUE "http://imgur.com/register/api_anon " . YELLOW ")\n";
    print BOLD YELLOW "--> ";
    chomp (my $apikey = <STDIN>);
    &stopAll (BOLD RED "! Error: API key is not valid (not a MD5 hash) !\n") unless length $apikey eq 32;
    print BOLD GREEN "> API key: OK\n";
    print BOLD MAGENTA "> Now you must say to me which links you want to view.\n";
    my @links = ("direct", "delete", "page", "thumb");
    my ($i, $_tmp) = undef;
    for (0..(scalar (@links) - 1)) {
        $i = $_;
        print BOLD YELLOW "-> Would you like to see " . $links[$i] . " links of uploaded images?\n";
        print BOLD YELLOW "--> " . BOLD BLUE "[y/n] ";
        chomp ($_tmp = <STDIN>);
        $links[$i] = ($_tmp =~ /^n/i ? 0 : 1);
    }
    &stopAll (BOLD RED "! Error: you can't answer 'n' to all links. !\n") if ($links[0] eq 0 and $links[1] eq 0 and $links[2] eq 0 and $links[3] eq 0);
    print BOLD GREEN "> Links: OK\n";
    print BOLD YELLOW "-> Would you like silent output (no progress-bar)?\n";
    print BOLD YELLOW "--> " . BOLD BLUE "[y/n] ";
    chomp (my $silento = <STDIN>);
    $silento = ($silento =~ /^n/i ? 0 : 1);
    print BOLD GREEN "> OK\n";
    # BEGIN: edit 15/05/12 (yes, after a loong time): clipboard #
    my $dl2clip;
    if ($can_clipboard)
    {
        print BOLD YELLOW "-> Would you like to store the final link, at the end of the uploading, in the clipboard?\n";
        print BOLD YELLOW "--> " . BOLD BLUE "[y/n] ";
        chomp ($dl2clip = <STDIN>);
        $dl2clip = ($dl2clip =~ /^n/i ? 0 : 1);
        print BOLD GREEN "> OK\n";
    }
    else
    {
        print BOLD RED "> WARNING: Skipping direct link to clipboard, 'xclip' is missing from \$PATH dirs\n";
        print BOLD RED "> Install 'xclip' or change the \$PATH environment variable adequately if you want to autocopy direct links to the clipboard.\n";
    }
    # END:   edit 15/05/12 (yes, after a loong time): clipboard #
    print BOLD YELLOW "-> Would you like image uploads logging (logs will be saved in \$HOME/.imgur/log)?\n";
    print BOLD YELLOW "--> " . BOLD BLUE "[y/n] ";
    chomp (my $log = <STDIN>);
    $log = ($log =~ /^n/i ? 0 : 1);
    print BOLD GREEN "> OK\n";
    print BOLD BLUE "** SUMMARY **\n";
    print BOLD MAGENTA "* API Key -> " . BOLD GREEN "${apikey}\n";
    print BOLD MAGENTA "* Links (in order: direct, delete, page, thumbnail) -> " . BOLD GREEN . join (", ", @links) . "\n";
    print BOLD MAGENTA "* Silent output -> " . BOLD GREEN "${silento}\n";
    print BOLD MAGENTA "* Direct links to clipboard -> " . ( $can_clipboard ? BOLD GREEN "${dl2clip}" : BOLD RED "skipped" ) . "\n";
    print BOLD MAGENTA "* Logging -> " . BOLD GREEN "${log}\n";
    print BOLD YELLOW "-> Is that OK ?\n";
    print BOLD YELLOW "--> " . BOLD BLUE "[y/n] ";
    chomp (my $shit = <STDIN>);
    &stopAll (BOLD CYAN "Run again script *trollface*\n") if ($shit =~ /^n/i);
    print BOLD CYAN "## Preparing config file.. ##\n";
    my $conf = "apikey=${apikey}\n";
    $conf   .= "links=" . join (",", @links) . "\n";
    $conf   .= "silent=${silento}\n";
    $conf   .= "clipboard=" . ($can_clipboard ? $dl2clip : "0") . "\n";
    $conf   .= "log=${log}\n";
    print BOLD CYAN "## Writing to ~/.imgur/conf .. ##\n";
    mkdir "${home}/.imgur/", 0750 or &stopAll (BOLD RED "Error: cannot create dir ${home}/.imgur: ${!}.\n") if not -d "${home}/.imgur/";
    open FH, ">", "${home}/.imgur/conf" or &stopAll (BOLD RED "Error: cannot create/open for writing file ${home}/.imgur/conf: ${!}\n");
    print FH $conf;
    close FH;
    print BOLD CYAN "## Done! Please restart the script. Bye! ##\n";
    &logShit ("Configuration done! Script ready.");
    exit 0;
}
# Read config
open CONF, "<", "${home}/.imgur/conf";
while (<CONF>) {
    $options{$1} = $2 if ($_ =~ /^([^=]+)=(.+)$/);
}
close CONF;
&stopAll (BOLD RED "Error: config file isn't valid. Please run script with -c param.\n") unless (exists $options{"log"} and exists $options{"clipboard"} and exists $options{"silent"} and exists $options{"links"} and exists $options{"apikey"});
my @links = split /,/, $options{"links"};
&stopAll (BOLD RED "Error: " . RESET RED "file " . BOLD "'${name}'" . RESET RED " doesn't exist\n") unless -e $name;
&stopAll (BOLD RED "Error: API key is not valid (not a MD5 hash)\n") unless length &getRightOpt ("apikey", "apikey") eq 32;
my ($ua, $contentfunc, $next, $current, $bar) = (LWP::UserAgent->new, undef, 0, 0, undef);
if (&getRightOpt ("silent", "silent") ne 1) {
    # BEGIN shura's code
    $ua->add_handler (request_preprepare => sub {
        my ($request, $ua, $h) = @_;
        $contentfunc = $request->content ();
        ref ($contentfunc) eq "CODE" or die "Error in request_preprepare handler.\n";
        $request->content (sub {
            my $chunk = $contentfunc->();
            return $chunk unless defined $current and defined $chunk;
            { use bytes; $current += bytes::length ($chunk); }
            $next = $bar->update ($current) if $current >= $next;
            return $chunk;
        });
    });
    $ua->add_handler (request_send => sub {
        $bar = Term::ProgressBar->new ({
            name => &basename ($name),
            count=> $_[0]->header ("content-length"),
            ETA  => "linear"
        });
        return;
    });
    # END   shura's code
}
my @_ext = fileparse ($name, qr/[^\.]+$/);
my $_ext = $_ext[2];
my $found = 0;
foreach (@extensions) {
    if ($_ eq lc ($_ext)) {
        $found = 1;
        last;
    }
}
&stopAll ("Extension \"${_ext}\" is not valid. It must be a *.{jpg,jpeg,png,gif,apng,tiff,tif,bmp,pdf,xcf} file\n") if not $found;
&logShit ("[${name}] Starting image upload..");
my $res = $ua->post('http://api.imgur.com/2/upload',
    Content_Type  => 'multipart/form-data',
    Content       => {
        key       => &getRightOpt ("apikey", "apikey"),
        image     => [$name]
    }
);
if ($res->is_success) {
    # Match image hash and delete page, then generate links.
    $res->content =~ /<hash>([^<]+)<\/hash>/i or &stopAll ("Cannot retrieve image hash.\n");
    my $hash = $1;
    $res->content =~ /<delete_page>([^<]+)<\/delete_page>/i or &stopAll ("Cannot match delete page.\n");
    my $delpage = $1;
    &logShit ("[${name}] Upload done. Links: http://i.imgur.com/${hash}.${_ext} (direct) , http://i.imgur.com/${hash}s.${_ext} (thumbnail) , ${delpage} (delpage) , http://imgur.com/${hash} (overview-page)");
    if (&getRightOpt ("clipboard", "clipboard"))
    {
        &writeToClipBoard ("http://i.imgur.com/${hash}.${_ext}");
    }
    print "http://i.imgur.com/${hash}.${_ext}\n" if &getRightOpt ("links", "direct") ne 0; # Direct link
    print "http://i.imgur.com/${hash}s.${_ext}\n" if &getRightOpt ("links", "thumb") ne 0; # Thumbnail
    print "${delpage}\n" if &getRightOpt ("links", "del"); # Delete link
    print "http://imgur.com/${hash}\n" if &getRightOpt ("links", "page") ne 0; # Page
} else {
    &stopAll ("Something went terribly wrong during the upload..\n");
}
&closeHandle;

sub stopAll {
    print $_[0];
    exit 1;
}

sub getRightOpt {
    my ($optname, $varname) = @_;
    my $val = eval "return \$${varname}";
    &stopAll (BOLD RED $@) if $@;
    if ($optname ne "links") {
        return $options{$optname} if not defined $val or $options{$optname} eq $val;
        return $val if defined $val and $options{$optname} ne $val;
    } else {
        my %tmp = ("direct" => $links[0], "del" => $links[1], "page" => $links[2], "thumb" => $links[3]);
        return $tmp{$varname} if not defined $val or $tmp{$varname} eq $val;
        return $val if defined $val and $tmp{$varname} ne $val;
    }
}

sub logShit {
    return 0 if &getRightOpt ("log", "log") ne 1;
    my $data = shift;
    my $logfile = "${home}/.imgur/log";
    if (ref ($filehandle) ne "GLOB") {
        open $filehandle, ">>", $logfile or &stopAll ("Error: can't open logfile (${logfile}) : ${!}\n");
    }
    my ($sec, $min, $hour, $day, $month, $year,,,) = localtime (time);
    my $formatstr = "[$hour:$min:$sec @ $day/" . ($month + 1) . "/" . ($year + 1900) . "] ";
    print {$filehandle} $formatstr . $data . "\n";
}

sub addTrailingSlash
{
    return ( substr ($_[0], (length ($_[0]) - 1)) ne "/" ) ? 
        $_[0] . "/"
    :
        $_[0];
}

sub writeToClipBoard
{
    if ($can_clipboard)
    {
        return if not -e $xclip_path;
        open CLIPWRITER, "|" . $xclip_path . " -selection clipboard";
        print CLIPWRITER $_[0];
        close CLIPWRITER;
    }
}


sub closeHandle {
    return 0 if &getRightOpt ("log", "log") ne 1;
    close $filehandle if ( ref ($filehandle) eq "GLOB" );
}
__END__

=head1 NAME

imgur uploader - a simple script to upload files on imgur.com

=head1 SYNOPSIS

perl imgur.pl [-sdDptlckh] [--no{silent,direct,delete,imgpage,thumb,log}] [--version] [--key=apikey] image.{jpg,jpeg,png,gif,apng,tiff,tif,bmp,pdf,xcf}

  Options:
     -s/--silent/--nosilent*            With this option the script won't produce any progress-bar or debug message.
     -d/--direct/--nodirect*            With this option the script will print direct link of the image.
     -D/--delete/--nodelete*            With this option the script will print delete-page link of the image.
     -p/--imgpage/--noimgpage*          With this option the script will print the overview-page link of the image.
     -t/--thumb/--nothumb*              With this option the script will print thumbnail link of the image.
     -c/--clip/--noclip*                With this option the script will copy the direct link of the image to the clipboard.
     -l/--log/--nolog*                  With this option the script will log the image-upload in $HOME/.imgur/log
     -c/--conf                          With this option the script will enter in configuration mode.
     -k/--key <apikey>                  Your apikey (if configuration file is valid, you don't need this option)
     -h/--help                          Show the usage.
     --doc                              Show full documentation. You can use perldoc imgur.pl, too.
     --version                          Show script's version.
   * means that you can specify --noOPTION to disable that option.

=head1 EXAMPLES

perl imgur.pl --nosilent $HOME/myimage.png
 The script will be launched without silent option (default) and it will upload an image from $HOME/myimage.png

perl imgur.pl -dpt $HOME/myimage.png
 The script will be launched with options -dpt (--direct, --imgpage, --thumb) and it will print direct, overview-page and thumbnail link of the image $HOME/myimage.png

=head1 AUTHORS

This script was created by Robertof, and it is released under GNU/GPL v.3 licence. B<Based on shura's imageshack uploader.>

=cut