#!/usr/bin/perl

use strict;

use HTTP::Request::Common qw( POST );
use LWP::UserAgent;

# use URI;
# use IO::Socket::INET;

use Getopt::Long;

=pod

=head1 NAME

shortenurl - Shorten a given url using makeashorterlink.com.

=head1 SYNOPSIS

B<shortenurl> [I<-n>|I<-h>] <url>

B<shortenurl> [I<-p <proxy>>] <url>

=head1 OPTIONS

=over 4

=item -p|--proxy I<proxy>

Use the specified I<proxy> for HTTP requests sent to
makeashorterlink.com.  This must be in the form of
http://host[:port]/.

=item -n|--debug

Debug mode.  Don't actually submit the url, just display a the encoded
content that would've been POSTed.

=item -h

Display help and exit.

=item -v

Display version info and exit.

=back

=head1 DESCRIPTION

Takes the given url and submits it to makeashorterlink.com through
their form POST mechanism, the same one used on their main page there.
makeashorterlink.com hashes the URL and then provides a pleasently
abbreviated version of it which can be used to access the longer,
uglier link.  This abbreviated link is parsed out of the resulting
HTML and spat out to stdout.  Nice and simple, I wonder why I'm even
bothering to write these docs ... must be some OCD behaviour.

This script makes use of Perl's LWP package and hence inherits it's
idiosyncrasies, be they bug or feature.

=over 4

=item I<url>

This is the URL to be abbreviated by makeashorterlink.com.  If this
URL is too short, makeashorterlink.com won't do anything with it.  Not
sure what this length constraint is, this script will (try to) detect
this and report back appropriately.

=back

=head1 PROXIES

As you may have noted a proxy host may be specified with the --proxy
or -p options.  Since this script uses Perl's LWP package to make it's
HTTP request it will also use the http_proxy environment variable if
no proxy is provided on the cmdline.  Like the argument to the --proxy option
it should be a full URL to the proxy host.

=head1 AUTHOR

Mishka "Documentation Monkey" Gorodnitzky
<misaka@pobox.com>

=head1 COPYRIGHT

Copyright (C) 2001 Mishka Gorodnitzky

Distributed under the Artistic License, please see:
<http://www.perl.com/pub/a/language/misc/Artistic.html>

=head1 NOTES

I haven't yet contacted makeashorterlink.com in regards to this
script.  I see nothing on their webpage indicating that they wouldn't
want such a script to exist so I assume for now that they don't really
care either way.  Yet they may, intentionally or unintentionally,
break this script by changing aspects of the form or of the resulting
HTML page.  Obviously, I can't control that.  If you think this script
is broken you may check out http://www.pobox.com/~misaka/hacks.html
for an updated version.

=head1 BUGS

I spent too much time on this measly little script.  Ugh.

=cut

my( $useragent, $url, $escapedurl, $post, $response, $uri,
@fullrequest, $shorturl, $argDebug, $argHelp, $argVersion, $argProxy );

my $versionNumber = "1.0 (the Tactile-Feely-Weeeb-Experience release)";
my $versionString = "shortenurl";

GetOptions( "help!"    => \$argHelp,
	    "n|debug!" => \$argDebug,
	    "version!" => \$argVersion,
            "proxy=s"  => \$argProxy );

print( "debug mode enabled\n" ) if( $argDebug );

if( $argVersion ) {
    print( "$versionString\n" );
    exit( 0 );
}

if( $argHelp ) {
    print( <<EOH );
Usage: shorten <url>

  Sends the given <url> to makeashorterlink.com to make an abbreviated
  version and prints it to stdout.

  Options:
    -p <proxy> : Use <proxy> when making the http connection.
    -n         : Debug mode, print out what would be done.
    -h         : Display help and exit.
    -v         : Display version info and exit.

EOH
    exit( 0 );
}

# Data initialization and sanity checks.

$url = shift( @ARGV );

if( !$url ) {
    die( "No url provided, what is it you want me to do 'zactly?\n" );
}

# makeashorterlink.com will bail out if the url is too short.  I'm not
# sure what it's minimum length is, but their URLs end up being about
# this length so it seems like a reasonable minimum.
elsif( length( $url ) < 38 ) {
    die( "This url is already short, it won't be abbreviated to anything shorter.\n" );
}

# God this is simple using LWP ...

$useragent = new LWP::UserAgent;
$useragent->agent( "shortenurl/$versionNumber" );
$post = POST( 'http://www.makeashorterlink.com/index.php', [ url => $url ] );

if( $argProxy ) {
    $useragent->proxy( $argProxy );
} else {
    $useragent->env_proxy();
}

if( $argDebug ) {
    print( $post->as_string() );
} else {
    $response = $useragent->request( $post );
}

if( !$argDebug ) {
    if( !$response->is_success ) {
	print( "An error has occured, cannot produce result.\n" );
    } elsif( $response->content() =~ m/URL already short:/i ) {
	print( "URL is already short, it's been ignoring.\n" );
    } elsif( $response->content() =~ m/Your shorter link is: <a href="([^"]+)"/ ) {
        print( "$1\n" );
    } else {
        print( "Response unparseable. sorry.\n" );
        print( $response->content() );
    }
}