git.maemo.org Git - dh-make-perl/blob - dev/i386/liburi-perl/liburi-perl-1.35.dfsg.1/uri-test

   1 #!/usr/bin/perl -w
   2
   3 sub usage {
   4     my $prog = $0; $prog =~ s,.*/,,;
   5     die "Usage: $prog <uri> [<method> [<args>]...]\n";
   6 }
   7
   8 usage() unless @ARGV;
   9 my $uri = shift;
  10 my $orig = $uri;
  11
  12 require URI;
  13
  14 my @ctor_arg = ($uri);
  15 push(@ctor_arg, shift) while @ARGV && $ARGV[0] =~ s/^\+//;
  16
  17 $uri = URI->new(@ctor_arg);
  18
  19 if (@ARGV) {
  20     my $method = shift;
  21     my $list_context = ($method =~ s/^\@//);
  22     #print "URI->new(\"$uri\")->$method ==> ";
  23     for (@ARGV) {
  24         undef($_) if $_ eq "UNDEF";
  25     }
  26
  27     my @result;
  28     if ($list_context) {
  29         @result = $uri->$method(@ARGV);
  30     } else {
  31         @result = scalar($uri->$method(@ARGV));
  32     }
  33
  34     for (@result) {
  35         if (defined) {
  36             $_ = "«$_»" if /^\s*$/;
  37         } else {
  38             $_ = "<undef>";
  39         }
  40     }
  41     print join(" ", @result), "\n";
  42 }
  43 print "$uri\n" unless $orig eq $uri;
  44 exit;
  45
  46 # Some extra methods that might be nice
  47
  48 sub UNIVERSAL::class { ref($_[0]) }
  49
  50 sub UNIVERSAL::dump {
  51     require Data::Dumper;
  52     my $d = Data::Dumper->Dump(\@_, ["self", "arg1", "arg2", "arg3", "arg4"]);
  53     chomp($d);
  54     $d;
  55 }