summaryrefslogtreecommitdiff
path: root/uri-test
diff options
context:
space:
mode:
Diffstat (limited to 'uri-test')
-rwxr-xr-xuri-test58
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;
+}