uri-test   [plain text]

#!/usr/bin/perl -w

sub usage {
    my $prog = $0; $prog =~ s,.*/,,;
    die "Usage: $prog <uri> [<method> [<args>]...]\n";
}

usage() unless @ARGV;
my $uri = shift;
my $orig = $uri;

require URI;

my @ctor_arg = ($uri);
push(@ctor_arg, shift) while @ARGV && $ARGV[0] =~ s/^\+//;

$uri = URI->new(@ctor_arg);

if (@ARGV) {
    my $method = shift;
    my $list_context = ($method =~ s/^\@//);
    #print "URI->new(\"$uri\")->$method ==> ";
    for (@ARGV) {
	undef($_) if $_ eq "UNDEF";
    }

    my @result;
    if ($list_context) {
	@result = $uri->$method(@ARGV);
    } else {
	@result = scalar($uri->$method(@ARGV));
    }

    for (@result) {
	if (defined) {
	    $_ = "«$_»" if /^\s*$/;
	} else {
	    $_ = "<undef>";
	}
    }
    print join(" ", @result), "\n";
}
print "$uri\n" unless $orig eq $uri;
exit;

# Some extra methods that might be nice

sub UNIVERSAL::class { ref($_[0]) }

sub UNIVERSAL::dump {
    require Data::Dumper;
    my $d = Data::Dumper->Dump(\@_, ["self", "arg1", "arg2", "arg3", "arg4"]);
    chomp($d);
    $d;
}