Improve URI processing.

* Makefile.PL: Update.
* lib/MakeRedirect.pm: Use MakeRedirect::URI.
* lib/MakeRedirect/Output.pm: Minor changes.
* lib/MakeRedirect/Output/rewrite.pm (ruleset): Use MakeRedirect::URI::SRC
explicitly.
* lib/MakeRedirect/URI.pm (new): Sort query part.
Encode path, if necessary.
* lib/MakeRedirect/URI/DST.pm: Remove.
* lib/MakeRedirect/URI/SRC.pm (new): Take a string or a MakeRedirect::URI
object as argument.  Decode only the path part.
* makeredirect: New file.
* t/00_URI.t: Update.
* t/01_SRC.t: Update.
* t/02_DST.t: Update.

11 files changed, 60 insertions, 66 deletions

diff --git a/Makefile.PL b/Makefile.PL
index c63e0b6..4c5d55b 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -12,7 +12,7 @@ WriteMakefile(
     VERSION_FROM => 'lib/MakeRedirect.pm',
     AUTHOR    =>      'Sergey Poznyakoff <gray@gnu.org>',
     LICENSE   =>      'gpl_3',
-#    EXE_FILES =>      [ 'makeredirect' ],
+    EXE_FILES =>      [ 'makeredirect' ],
     MIN_PERL_VERSION  => 5.014002,
     PREREQ_PM => {
     	'Getopt::Long' => 0,
@@ -23,7 +23,9 @@ WriteMakefile(
         'Pod::Man' => 0,
     	'Pod::Usage' => 0,
     	'Text::CSV' => 2.00,
-    	'Text::Locus' => '1.03'
+    	'Text::Locus' => '1.03',
+	'URI::Encode' => '1.1.1',
+	'Clone' => 0    
     },
     BUILD_REQUIRES => {'Test::More' => '0.88'},
     META_MERGE        => {
diff --git a/lib/MakeRedirect.pm b/lib/MakeRedirect.pm
index b690079..cfda7e9 100644
--- a/lib/MakeRedirect.pm
+++ b/lib/MakeRedirect.pm
@@ -1,8 +1,7 @@
 package MakeRedirect;
 use strict;
 use warnings;
-use MakeRedirect::URI::SRC;
-use MakeRedirect::URI::DST;
+use MakeRedirect::URI;
 use Text::CSV;
 use Text::Locus;
 use Carp;
@@ -91,10 +90,10 @@ sub read {
 	    next;
         }
 
-	my $src = new MakeRedirect::URI::SRC($row->[SRC],
-					     scheme => $self->{scheme});
-	my $dst = new MakeRedirect::URI::DST($row->[DST],
- 	                                     scheme => $self->{scheme});
+	my $src = new MakeRedirect::URI($row->[SRC],
+					scheme => $self->{scheme});
+	my $dst = new MakeRedirect::URI($row->[DST],
+					scheme => $self->{scheme});
         if ($src == $dst) {
 	    $self->error("$filename:$line: source and destination are the same");
 	    next;
diff --git a/lib/MakeRedirect/Output.pm b/lib/MakeRedirect/Output.pm
index 24e32f2..81cf8ec 100644
--- a/lib/MakeRedirect/Output.pm
+++ b/lib/MakeRedirect/Output.pm
@@ -59,13 +59,13 @@ sub close {
 sub print {
     my $self = shift;
     my $fh = $self->fh;
-    print $fh @_;
+    CORE::print $fh @_;
 }
 
 sub printf {
     my $self = shift;
     my $fh = $self->fh;
-    printf $fh @_;
+    CORE::printf $fh @_;
 }
 
 1;
diff --git a/lib/MakeRedirect/Output/rewrite.pm b/lib/MakeRedirect/Output/rewrite.pm
index cf6a166..784c438 100644
--- a/lib/MakeRedirect/Output/rewrite.pm
+++ b/lib/MakeRedirect/Output/rewrite.pm
@@ -4,6 +4,7 @@ use warnings;
 use Carp;
 use File::Spec;
 use parent 'MakeRedirect::Output';
+use MakeRedirect::URI::SRC;
 
 sub new {
     my $class = shift;
@@ -38,7 +39,7 @@ sub ruleset {
     }
     foreach my $key (sort { $b cmp $a } keys %{$rules}) {
 	my $r = $rules->{$key};
-	my $src = $r->src;
+	my $src = new MakeRedirect::URI::SRC($r->src);
 	my $dst = $r->dst;
 	if (!$src->path) {
 	    $src->path('(.*)');
diff --git a/lib/MakeRedirect/URI.pm b/lib/MakeRedirect/URI.pm
index 48ae4bb..9e0a574 100644
--- a/lib/MakeRedirect/URI.pm
+++ b/lib/MakeRedirect/URI.pm
@@ -2,6 +2,7 @@ package MakeRedirect::URI;
 use strict;
 use warnings;
 use Clone;
+use URI::Encode qw(uri_encode);
 
 sub new {
     my ($class, $url, %args) = @_;
@@ -19,7 +20,7 @@ sub new {
     }
     if ($self->{path} && $self->{path} =~ m{^(?<path>.*?)\?(?<query>.*)}) {
 	$self->{path} = $+{path};
-	$self->{query} = $+{query};
+	$self->{query} = join('&', sort split(/&/, $+{query}));
     }
     foreach my $k (qw(scheme host path)) {
 	unless ($self->{$k}) {
@@ -29,7 +30,10 @@ sub new {
     if ($self->{host} && !$self->{scheme}) {
 	$self->{scheme} = 'http';
     }
-    
+    if ($self->{path} && $self->{path} !~ m{%[0-9a-fA-F]{2}}) {
+	$self->{path} = uri_encode($self->{path});
+    }
+	
     bless $self, $class;
 }
 
diff --git a/lib/MakeRedirect/URI/DST.pm b/lib/MakeRedirect/URI/DST.pm
deleted file mode 100644
index d1892aa..0000000
--- a/lib/MakeRedirect/URI/DST.pm
+++ /dev/null
@@ -1,33 +0,0 @@
-package MakeRedirect::URI::DST;
-use strict;
-use warnings;
-use parent 'MakeRedirect::URI';
-use URI::Encode qw(uri_encode);
-
-sub new {
-    my $class = shift;
-    my $self = $class->SUPER::new(@_);
-    $self->{encode_path} = ($self->SUPER::path // '') !~ m{%[0-9a-fA-F]{2}};
-    $self->{encode_query} = ($self->SUPER::query // '') !~ m{%[0-9a-fA-F]{2}};
-    $self;
-}
-
-sub path {
-    my $self = shift;
-    my $res = $self->SUPER::path(@_);
-    if ($res && $self->{encode_path}) {
-	$res = uri_encode($res);
-    }
-    return $res;
-}
-
-sub query {
-    my $self = shift;
-    my $res = $self->SUPER::query(@_);
-    if ($res && $self->{encode_query}) {
-	$res = uri_encode($res);
-    }
-    return $res;
-}
-
-1;
diff --git a/lib/MakeRedirect/URI/SRC.pm b/lib/MakeRedirect/URI/SRC.pm
index ede28f3..9444a5c 100644
--- a/lib/MakeRedirect/URI/SRC.pm
+++ b/lib/MakeRedirect/URI/SRC.pm
@@ -2,16 +2,20 @@ package MakeRedirect::URI::SRC;
 use strict;
 use warnings;
 use parent 'MakeRedirect::URI';
+use MakeRedirect::URI;
 use URI::Encode qw(uri_decode);
 
-sub path {
-    my $self = shift;
-    uri_decode($self->SUPER::path(@_));
+sub new {
+    my ($class, $orig) = @_;
+    if (ref($orig) eq '') {
+	$orig = new MakeRedirect::URI($orig);
+    }
+    bless $orig->clone, $class;
 }
 
-sub query {
+sub path {
     my $self = shift;
-    uri_decode($self->SUPER::query(@_));
+    uri_decode($self->SUPER::path(@_));
 }
 
 1;
diff --git a/makeredirect b/makeredirect
new file mode 100644
index 0000000..9c9abb9
--- /dev/null
+++ b/makeredirect
@@ -0,0 +1,28 @@
+#!/bin/sh
+#! -*-perl-*-
+eval 'exec perl -x -S $0 ${1+"$@"}'
+    if 0;
+use strict;
+use warnings;
+use Getopt::Long qw(:config gnu_getopt no_ignore_case require_order);
+use MakeRedirect;
+
+my $output;
+my $modname = 'verbose';
+my %args;
+GetOptions('skip|s=n' => sub { $args{skip} = $_[1] },
+	   'output|o=s' => sub { $args{file} = $_[1] },
+	   'module|m=s' => \$modname,
+	   'argument|a=s' => sub {
+	       my ($k,$v) = split /=/, $_[1], 2;
+	       $args{$k} = $v || 1;
+	   }
+    )
+    or die;
+
+my $mr = new MakeRedirect($modname, %args);
+foreach my $f (@ARGV) {
+    $mr->read($f);
+}
+$mr->output;
+
diff --git a/t/00_URI.t b/t/00_URI.t
index 7d7ae91..b360d3d 100644
--- a/t/00_URI.t
+++ b/t/00_URI.t
@@ -6,12 +6,12 @@ use Test::More tests => 18;
 
 use_ok 'MakeRedirect::URI';
 
-my $uri = new MakeRedirect::URI('https://example.com/foo/bar?q=1');
+my $uri = new MakeRedirect::URI('https://example.com/foo/bar?q=1&a=f');
 is($uri->scheme,'https');
 is($uri->host,'example.com');
 is($uri->path,'/foo/bar');
-is($uri->query,'q=1');
-is($uri->canonical,'https://example.com/foo/bar?q=1');
+is($uri->query,'a=f&q=1');
+is($uri->canonical,'https://example.com/foo/bar?a=f&q=1');
 
 $uri = new MakeRedirect::URI('example.com/foo/bar?q=1');
 is($uri->scheme,'http');
diff --git a/t/01_SRC.t b/t/01_SRC.t
index 645897b..b329201 100644
--- a/t/01_SRC.t
+++ b/t/01_SRC.t
@@ -10,5 +10,5 @@ my $uri = new MakeRedirect::URI::SRC('https://example.com/foo%20bar?q=http%3A%2F
 is($uri->scheme,'https');
 is($uri->host,'example.com');
 is($uri->path,'/foo bar');
-is($uri->query,'q=http://example.org');
+is($uri->query,'q=http%3A%2F%2Fexample.org');
 
diff --git a/t/02_DST.t b/t/02_DST.t
deleted file mode 100644
index 9266786..0000000
--- a/t/02_DST.t
+++ /dev/null
@@ -1,11 +0,0 @@
-# -*- perl -*-
-use lib qw(t lib);
-use strict;
-use warnings;
-use Test::More tests => 3;
-
-use_ok 'MakeRedirect::URI::DST';
-
-my $uri = new MakeRedirect::URI::DST('https://example.com/foo bar?q=http%3A%2F%2Fexample.org');
-is($uri->path,'/foo%20bar');
-is($uri->query,'q=http%3A%2F%2Fexample.org');