WWW-NanoRef-0.03pre1000755 001751 000000 00000000000 10366063136 014075 5ustar00donwheel000000 000000 WWW-NanoRef-0.03pre1/lib000755 001751 000000 00000000000 10366063136 014643 5ustar00donwheel000000 000000 WWW-NanoRef-0.03pre1/lib/WWW000755 001751 000000 00000000000 10366063136 015327 5ustar00donwheel000000 000000 WWW-NanoRef-0.03pre1/lib/WWW/NanoRef.pm000644 001751 000000 00000016140 10366062272 017276 0ustar00donwheel000000 000000 # Creation date: 2005-11-06 22:03:29 # Authors: don =pod =head1 NAME WWW::NanoRef - Shorten URLs via nanoref.com =head1 SYNOPSIS use WWW::NanoRef; my $ref = WWW::NanoRef->new({ url => $destination_url }); my $short_url = $ref->get_short_url; # or my $url = $ref->get_subdomain_url('test'); =head1 DESCRIPTION This module uses the API published by nanoref.com to produce shortened URLs. So a destination URL like http://maps.yahoo.com/dd_result?newaddr=865+W+El+C amino+Real&taddr=2495+S+Delaware+St&csz=Sunnyvale% 2C+CA+94086&country=us&tcsz=San+Mateo%2C+CA+94403- 1902&tcountry=us becomes a shorter URL like http://nanoref.com/yahoo/_QhGlg or a short URL like this that you choose yourself: http://mymap.nanoref.com/ =cut use strict; use warnings; package WWW::NanoRef; our $VERSION = '0.03pre1'; use LWP; use XML::Parser::Wrapper; =pod =head1 METHODS =head2 new(\%params) Creates a new object. The only key/value pair required is url, which is the destination URL you want the shortened URL to redirect to. =head3 Parameters: =over 4 =item url The destination URL you want the shortened URL to redirect to. =item passwd The password you want to associated with the nanoref.com URL for viewing stats (see http://nanoref.com/ for details) when they are implemented. =item test If set to a true value, a nanoref.com URL will be generated, but will not be stored (and will not work). It is used for testing this module. =back =cut sub new { my $proto = shift; my $url = shift; my $passwd = ''; my $test = ''; my $login; if (ref($url) eq 'HASH') { my $hash = $url; $url = $hash->{url}; $passwd = $hash->{passwd}; $passwd = '' unless defined $passwd; $test = $hash->{test} || ''; $login = $hash->{login}; } my $self = bless { _dest_url => $url, _passwd => $passwd, _test => $test }, ref($proto) || $proto; if (defined($login)) { $self->{_login} = $login; } return $self; } =pod =head2 get_short_url() Returns a shortened URL that will redirect to the destination URL passed to new() when creating the object. On error, undef is returned. =cut sub get_short_url { my $self = shift; # if ($self->{_error}) { # return; # } if (exists($self->{_gen_url})) { return $self->{_gen_url}; } else { if ($self->_fetch_api) { return $self->{_gen_url}; } else { return; } } } =pod =head2 get_subdomain_url($subdomain) Attempts to register a shortened URL with the given subdomain. E.g., my $short_url = $nano_ref->get_subdomain_url('test'); If 'test' has not already been registered, then http://test.nanoref.com/ will now redirect to the URL given to new(). Otherwise, $short_url will be undef. This corresponds to the "Choose your own" tab on http://nanoref.com/. =cut sub get_subdomain_url { my $self = shift; my $domain = shift; my $rv = $self->_fetch_api_domain($domain); if ($rv) { return $self->{_gen_url}; } else { return undef; } } =pod =head2 get_error() Returns the error message, if any, from the server. =cut sub get_error { my $self = shift; return $self->{_error}; } sub _fetch_api { my $self = shift; my $enc_url = $self->url_encode($self->{_dest_url}); my $enc_passwd = $self->url_encode($self->{_passwd}); my $fetch_url = "http://nanoref.com/u/api/rest?url=$enc_url;passwd=$enc_passwd"; if ($self->{_test}) { $fetch_url .= ";test=1"; } if (defined($self->{_login})) { $fetch_url .= ';login=' . $self->url_encode($self->{_login}); } my $request = HTTP::Request->new(GET => $fetch_url); my $ua = LWP::UserAgent->new(agent => "WWW::NanoRef/$VERSION"); my $response = $ua->request($request); if ($response->is_success) { my $content = $response->content; my $parser = XML::Parser::Wrapper->new($content); return unless $parser->name eq 'response'; my $response_tag = $parser; if ($response_tag) { my $error_tag = $response_tag->kid('error'); my $gen_url_tag = $response_tag->kid('gen_url'); if ($error_tag and $error_tag->text !~ /^\s*$/) { $self->{_error} = $error_tag->text; return; } else { $self->{_gen_url} = $gen_url_tag->text if $gen_url_tag; return 1; } } } else { $self->{_error} = $response->message || 'problem fetching data'; return; } } sub _fetch_api_domain { my $self = shift; my $domain = shift; my $enc_url = $self->url_encode($self->{_dest_url}); my $enc_passwd = $self->url_encode($self->{_passwd}); my $enc_domain = $self->url_encode($domain); my $fetch_url = "http://nanoref.com/u/api/rest_domain?url=$enc_url;subdomain=$enc_domain;"; $fetch_url .= "passwd=$enc_passwd"; if ($self->{_test}) { $fetch_url .= ";test=1"; } my $request = HTTP::Request->new(GET => $fetch_url); my $ua = LWP::UserAgent->new(agent => "WWW::NanoRef/$VERSION"); my $response = $ua->request($request); if ($response->is_success) { my $content = $response->content; my $parser = XML::Parser::Wrapper->new($content); return unless $parser->name eq 'response'; my $response_tag = $parser; if ($response_tag) { my $error_tag = $response_tag->kid('error'); my $gen_url_tag = $response_tag->kid('gen_url'); my $status_tag = $response_tag->kid('status'); if ($status_tag) { $self->{_status} = $status_tag->text; if ($self->{_status} == 0) { return 0; } } if ($error_tag and $error_tag->text !~ /^\s*$/) { $self->{_error} = $error_tag->text; return; } else { $self->{_gen_url} = $gen_url_tag->text if $gen_url_tag; return 1; } } } else { $self->{_error} = $response->message || 'problem fetching data'; return; } } sub url_encode { my ($self, $str) = @_; $str =~ s{([^A-Za-z0-9_-])}{sprintf("%%%02x", ord($1))}eg; return $str; } =pod =head1 DEPENDENCIES XML::Parser::Wrapper (which in turn depends on XML::Parser) LWP =head1 AUTHOR Don Owens =head1 LICENSE AND COPYRIGHT Copyright (c) 2005 Don Owens . All rights reserved. This is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See perlartistic. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. =head1 SEE ALSO http://nanoref.com/ =head1 VERSION 0.03pre1 =cut 1; # Local Variables: # # mode: perl # # tab-width: 4 # # indent-tabs-mode: nil # # cperl-indent-level: 4 # # perl-indent-level: 4 # # End: # # vim:set ai si et sta ts=4 sw=4 sts=4: WWW-NanoRef-0.03pre1/MANIFEST000644 001751 000000 00000000220 10334304574 015276 0ustar00donwheel000000 000000 MANIFEST INSTALL README Makefile.PL t/00use.t lib/WWW/NanoRef.pm META.yml Module meta-data (added by MakeMaker) WWW-NanoRef-0.03pre1/META.yml000644 001751 000000 00000000600 10366063135 015420 0ustar00donwheel000000 000000 # http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: WWW-NanoRef version: 0.03pre1 version_from: lib/WWW/NanoRef.pm installdirs: site requires: LWP: 0 XML::Parser::Wrapper: 0 distribution_type: module generated_by: ExtUtils::MakeMaker version 6.17 WWW-NanoRef-0.03pre1/t000755 001751 000000 00000000000 10366063136 014340 5ustar00donwheel000000 000000 WWW-NanoRef-0.03pre1/t/00use.t000755 001751 000000 00000000443 10334303704 015535 0ustar00donwheel000000 000000 #!/usr/bin/env perl # Creation date: 2005-11-06 21:55:21 # Authors: don use strict; use warnings; # main { use Test; BEGIN { plan tests => 1 } use WWW::NanoRef; ok(1); } exit 0; ############################################################################### # Subroutines WWW-NanoRef-0.03pre1/INSTALL000644 001751 000000 00000000256 10334303704 015201 0ustar00donwheel000000 000000 Copyright (c) 2003-2005 Don Owens See the COPYRIGHT section in Wrapper.pm for usage and distribution rights. INSTALLATION perl Makefile.PL make make test make install WWW-NanoRef-0.03pre1/Makefile.PL000755 001751 000000 00000002014 10334303704 016117 0ustar00donwheel000000 000000 #!/usr/bin/perl # Creation date: 2005-11-06 21:56:39 # Authors: don use strict; use warnings; use Carp; # main { local($SIG{__DIE__}) = sub { &Carp::cluck(); exit 0 }; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'WWW::NanoRef', DISTNAME => 'WWW-NanoRef', VERSION_FROM => 'lib/WWW/NanoRef.pm', ABSTRACT => 'Shorten URLs via nanoref.com', AUTHOR => 'DON OWENS ', PM => { 'lib/WWW/NanoRef.pm' => '$(INST_LIBDIR)/NanoRef.pm', }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz' }, DIR => [], EXE_FILES => [], PREREQ_PM => { 'XML::Parser::Wrapper' => 0, 'LWP' => 0, }, ); } exit 0; ############################################################################### # Subroutines WWW-NanoRef-0.03pre1/README000644 001751 000000 00000005136 10366063131 015034 0ustar00donwheel000000 000000 NAME WWW::NanoRef - Shorten URLs via nanoref.com SYNOPSIS use WWW::NanoRef; my $ref = WWW::NanoRef->new({ url => $destination_url }); my $short_url = $ref->get_short_url; # or my $url = $ref->get_subdomain_url('test'); DESCRIPTION This module uses the API published by nanoref.com to produce shortened URLs. So a destination URL like http://maps.yahoo.com/dd_result?newaddr=865+W+El+C amino+Real&taddr=2495+S+Delaware+St&csz=Sunnyvale% 2C+CA+94086&country=us&tcsz=San+Mateo%2C+CA+94403- 1902&tcountry=us becomes a shorter URL like http://nanoref.com/yahoo/_QhGlg or a short URL like this that you choose yourself: http://mymap.nanoref.com/ METHODS new(\%params) Creates a new object. The only key/value pair required is url, which is the destination URL you want the shortened URL to redirect to. Parameters: url The destination URL you want the shortened URL to redirect to. passwd The password you want to associated with the nanoref.com URL for viewing stats (see http://nanoref.com/ for details) when they are implemented. test If set to a true value, a nanoref.com URL will be generated, but will not be stored (and will not work). It is used for testing this module. get_short_url() Returns a shortened URL that will redirect to the destination URL passed to new() when creating the object. On error, undef is returned. get_subdomain_url($subdomain) Attempts to register a shortened URL with the given subdomain. E.g., my $short_url = $nano_ref->get_subdomain_url('test'); If 'test' has not already been registered, then http://test.nanoref.com/ will now redirect to the URL given to new(). Otherwise, $short_url will be undef. This corresponds to the "Choose your own" tab on http://nanoref.com/. get_error() Returns the error message, if any, from the server. DEPENDENCIES XML::Parser::Wrapper (which in turn depends on XML::Parser) LWP AUTHOR Don Owens LICENSE AND COPYRIGHT Copyright (c) 2005 Don Owens . All rights reserved. This is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See perlartistic. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. SEE ALSO http://nanoref.com/ VERSION 0.03pre1