Skip to content

Instantly share code, notes, and snippets.

@draegtun
Created December 15, 2009 14:48
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save draegtun/256992 to your computer and use it in GitHub Desktop.
Save draegtun/256992 to your computer and use it in GitHub Desktop.
URL in Perl with no strings attached!
#!/usr/bin/env perl
use Modern::Perl;
use JSON qw(decode_json);
use Url;
# http://domain.com/page are converted to LWP::Simple::get using Devel::Declare magic!
# output the json as is
say http://twitter.com/statuses/show/6592721580.json;
# => He nose the truth.
say decode_json( http://twitter.com/statuses/show/6592721580.json )->{text};
package Url;
use Modern::Perl;
use Devel::Declare ();
use LWP::Simple ();
use base 'Devel::Declare::Context::Simple';
sub import {
my $class = shift;
my $caller = caller;
my $ctx = __PACKAGE__->new;
Devel::Declare->setup_for(
$caller,
{
http => {
const => sub { $ctx->parser(@_) },
},
},
);
no strict 'refs';
*{$caller.'::http'} = sub ($) { LWP::Simple::get( $_[0] ) };
}
sub parser {
my $self = shift;
$self->init(@_);
$self->skip_declarator; # skip past "http"
my $line = $self->get_linestr; # get me current line of code
my $pos = $self->offset; # position just after "http"
my $url = substr $line, $pos; # url & everything after "http"
for my $c (split //, $url) {
# if blank, semi-colon or closing parenthesis then no longer a URL
last if $c eq q{ };
last if $c eq q{;};
last if $c eq q{)};
$pos++;
}
# so wrap url data.... ://domain.com/urlstuff
# with http prefix/quotes/brackets.... ("http://domain.com/urlstuff")
substr( $line, $pos, 0 ) = q{")};
substr( $line, $self->offset, 0 ) = q{("http};
# so from originally this... http://domain.com/urlstuff
# we send this back to parser... http("http://domain.com/urlstuff")
$self->set_linestr( $line );
return;
}
1;
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment