URI-1.69HEADURI-1.69master

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;
+}