diff options
Diffstat (limited to 'uri-test')
-rwxr-xr-x | uri-test | 58 |
1 files changed, 58 insertions, 0 deletions
diff --git a/uri-test b/uri-test new file mode 100755 index 0000000..ca30ef8 --- /dev/null +++ b/uri-test @@ -0,0 +1,58 @@ +#!/usr/bin/perl -w + +use strict; +use warnings; + +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; +} |