Add ARM files

[dh-make-perl] / dev / arm / liburi-perl / liburi-perl-1.35.dfsg.1 / uri-test

diff --git a/dev/arm/liburi-perl/liburi-perl-1.35.dfsg.1/uri-test b/dev/arm/liburi-perl/liburi-perl-1.35.dfsg.1/uri-test
new file mode 100755 (executable)
index 0000000..1e4f4d8
--- /dev/null
+++ b/dev/arm/liburi-perl/liburi-perl-1.35.dfsg.1/uri-test
@@ -0,0 +1,55 @@
+#!/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;
+}