Change imput file format.

* lib/MakeRedirect.pm: move MakeRedirect::Rule to a separate file.
(read): Get flags from optional third column.
* lib/MakeRedirect/Output/list.pm: Support for the www flag.
* lib/MakeRedirect/Output/rewrite.pm: Support for the www and
exact flags.
* lib/MakeRedirect/Rule.pm: New file.
* lib/MakeRedirect/URI.pm: Minor changed.
* makeredirect: Documentation.
* t/04_rewrite.t: Update.
* t/05_rewrite.t: Update.

8 files changed, 216 insertions, 35 deletions

diff --git a/lib/MakeRedirect.pm b/lib/MakeRedirect.pm
index fefbd71..a352dc9 100644
--- a/lib/MakeRedirect.pm
+++ b/lib/MakeRedirect.pm
@@ -2,6 +2,7 @@ package MakeRedirect;
 use strict;
 use warnings;
 use MakeRedirect::URI;
+use MakeRedirect::Rule;
 use Text::CSV;
 use Text::Locus;
 use Carp;
@@ -73,12 +74,15 @@ sub read {
     use constant {
 	SRC => 0,
 	DST => 1,
-	NF  => 2
+	FLG => 2,
+	MF  => 2,
+	NF  => 3
     };
 
     my $csv = Text::CSV->new( { binary => 1 } )
 	or croak "Cannot use CSV: ".Text::CSV->error_diag();
     my $line = 0;
+    my $def_flags = 0;
     while (my $row = $csv->getline($fh)) {
 	$line++;
         next if $skiplines && $line <= $skiplines;
@@ -86,7 +90,7 @@ sub read {
         if ($nf == 0) {
 	    next
         }
-        if ($nf < NF) {
+        if ($nf < MF) {
 	    $self->error("$filename:$line: too few fields; ignoring line");
 	    next;
         }
@@ -95,15 +99,51 @@ sub read {
 	    next;
         }
 
+	my $flags;
+	if ($nf == NF) {
+	    my %t = (
+		www => MakeRedirect::Rule::RF_WWW,
+		exact => MakeRedirect::Rule::RF_EXACT
+	    );
+	    $flags = 0;
+	    foreach my $x (split /[ |,]/, $row->[FLG]) {
+		my $neg;
+		if ($x =~ s{^([-+])(.*)}{$2}) {
+                    $neg = ($1 eq '-');
+		}
+		if (exists($t{$x})) {
+		    if ($neg) {
+			$flags &= ~$t{$x};
+		    } else {
+			$flags |= $t{$x};
+		    }
+		} else {
+		    $self->error("$filename:$line: warning: unknown flag $x");
+		}
+	    }
+	} else {
+	    $flags = $def_flags;
+	}
+	if ($row->[SRC] eq '-') {
+	    $def_flags = $flags;
+	    next;
+	}
+	
 	my $src = new MakeRedirect::URI($row->[SRC],
 					scheme => $self->{scheme});
 	my $dst = new MakeRedirect::URI($row->[DST],
-					scheme => $self->{scheme});
+					scheme => $self->{scheme},
+	                                path => '/');
         if ($src == $dst) {
 	    $self->error("$filename:$line: source and destination are the same");
 	    next;
         }
 
+	if (!$src->path) {
+	    $src->path('/');
+	    $flags &= ~MakeRedirect::Rule::RF_EXACT;
+	}
+	
 	my $host = $src->host // '';
 	my $locus = new Text::Locus($filename, $line);
 	if (my $orig = $self->{rules}{$host}{$src->canonical}) {
@@ -117,21 +157,10 @@ sub read {
 	    }
 	}
 	$self->{rules}{$host}{$src->canonical} =
-	    MakeRedirect::Rule->new($src, $dst, $locus);
+	    new MakeRedirect::Rule($src, $dst, $flags, $locus);
     }
     $csv->eof or $self->error($csv->error_diag());
     close $fh;
 }
 
-
-package MakeRedirect::Rule;
-sub new {
-    my ($class, $src, $dst, $locus) = @_;
-    bless { src => $src, dst => $dst, locus => $locus }, $class
-}
-
-sub src { shift->{src} }
-sub dst { shift->{dst} }
-sub locus { shift->{locus} }
-
 1;    
diff --git a/lib/MakeRedirect/Output/list.pm b/lib/MakeRedirect/Output/list.pm
index 792c4b0..b38076f 100644
--- a/lib/MakeRedirect/Output/list.pm
+++ b/lib/MakeRedirect/Output/list.pm
@@ -37,6 +37,13 @@ sub ruleset {
 	my $src = $r->src->clone;
 	$src->unset_scheme;
 	$self->print($src, $self->{d2}, $r->dst, $self->{d1});
+	if ($r->www && (my $host = $src->host)) {
+	    if ($host !~ s{^www\.}{}) {
+		$host = 'www.' . $host
+	    }
+	    $src->host($host);
+	    $self->print($src, $self->{d2}, $r->dst, $self->{d1});
+	}
     }
 }
 
diff --git a/lib/MakeRedirect/Output/rewrite.pm b/lib/MakeRedirect/Output/rewrite.pm
index aa5aaa3..3f24942 100644
--- a/lib/MakeRedirect/Output/rewrite.pm
+++ b/lib/MakeRedirect/Output/rewrite.pm
@@ -48,23 +48,48 @@ sub ruleset {
     if (!$self->{monolithic} && $host ne '') {
 	$self->print("# Host $host\n");
     }
+    my @prereq;
+    if ($self->{monolithic} && $host ne '') {
+	$prereq[0] = sprintf("RewriteCond %%{HTTP_HOST} =%s [NC]\n", $host);
+	$host =~ s{^www\.}{};
+	$host =~ s{\.}{\\.}g;
+	$prereq[1] = sprintf("RewriteCond %%{HTTP_HOST} ^(www\\.)%s\$ [NC]\n",
+			     $host);
+    }
     foreach my $key (sort { $b cmp $a } keys %{$rules}) {
 	my $r = $rules->{$key};
 	my $src = new MakeRedirect::URI::SRC($r->src);
 	my $dst = $r->dst;
-	if (!$src->path) {
-	    $src->path('(.*)');
-	    $dst->path('$1');
-	}
-	if ($self->{monolithic} && $host ne '') {
-	    $self->printf("RewriteCond %%{HTTP_HOST} =%s [NC]\n", $host);
+	if (@prereq) {
+	    $self->print($prereq[$r->www])
 	}
 	if ($src->query) {
 	    $self->printf("RewriteCond %%{QUERY_STRING} %s\n", $src->query);
 	    $src->unset_query
 	}
-	$self->printf("RewriteRule \"^%s\" %s [L,R=%d,NE]\n",
-		      $src->path, $dst, $self->http_code);
+	my $flags = 'L,R='.$self->http_code;
+	if ($dst =~ m{%[0-9a-fA-F]{2}}) {
+	    $flags .= ',NE';
+	}
+	
+	my $src_path = $src->path || '/';
+        my $dst_path = $dst->path || '/';	
+	if ($r->exact) {
+	    $dst->path($dst_path);
+	    $self->printf("RewriteRule \"^%s\$\" %s [%s]\n",
+			  $src_path, $dst, $flags);
+	} else {
+	    if ($src_path eq '/') {
+		$src_path = '(.*)';
+		$dst_path = '$1';
+	    } else {
+	        $src_path =~ s{/?$}{(/(.*))?};
+	        $dst_path =~ s{/?$}{/\$2};
+	    }
+	    $dst->path($dst_path);
+  	    $self->printf("RewriteRule \"^%s\" %s [%s]\n",
+			  $src_path, $dst, $flags);
+	}
     }
     if ($fh) {
 	$self->close
diff --git a/lib/MakeRedirect/Rule.pm b/lib/MakeRedirect/Rule.pm
new file mode 100644
index 0000000..95cec7d
--- /dev/null
+++ b/lib/MakeRedirect/Rule.pm
@@ -0,0 +1,26 @@
+package MakeRedirect::Rule;
+use strict;
+use warnings;
+require Exporter;
+
+our @ISA = qw(Exporter);
+our @EXPORT = qw(RW_WWW RW_EXACT);
+
+use constant {
+    RF_WWW   => 0x01,
+    RF_EXACT => 0x02
+};
+
+sub new {
+    my ($class, $src, $dst, $flags, $locus) = @_;
+    bless { src => $src, dst => $dst, flags => $flags, locus => $locus },
+	  $class
+}
+
+sub src { shift->{src} }
+sub dst { shift->{dst} }
+sub www   { (shift->{flags} & RF_WWW) != 0 }
+sub exact { (shift->{flags} & RF_EXACT) != 0 }
+sub locus { shift->{locus} }
+
+1;
diff --git a/lib/MakeRedirect/URI.pm b/lib/MakeRedirect/URI.pm
index 4db1a85..ccb5055 100644
--- a/lib/MakeRedirect/URI.pm
+++ b/lib/MakeRedirect/URI.pm
@@ -18,10 +18,15 @@ sub new {
     } else {
         $self = { path => '/' . $url }
     }
-    if ($self->{path} && $self->{path} =~ m{^(?<path>.*?)\?(?<query>.*)}) {
-	$self->{path} = $+{path};
-	$self->{query} = join('&', sort split(/&/, $+{query}));
+    if ($self->{path}) {
+	if ($self->{path} =~ m{^(?<path>.*?)\?(?<query>.*)}) {
+	    $self->{path} = $+{path};
+	    $self->{query} = join('&', sort split(/&/, $+{query}));
+	}
+	# Remove eventual superfluous slashes
+	$self->{path} =~ s{^(.+)/+$}{$1};
     }
+
     foreach my $k (qw(scheme host path)) {
 	unless ($self->{$k}) {
 	    $self->{$k} = delete $args{$k};
@@ -30,8 +35,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});
+    if ($self->{path}) {
+	if ($self->{path} !~ m{%[0-9a-fA-F]{2}}) {
+	    $self->{path} = uri_encode($self->{path});
+	}
     }
 	
     bless $self, $class;
diff --git a/makeredirect b/makeredirect
index 0dabd01..b6b2f46 100755
--- a/makeredirect
+++ b/makeredirect
@@ -46,7 +46,7 @@ B<makeredirect>
 [B<-o> I<FILE>]
 [B<-s> I<N>]
 [B<--output=>I<FILE>]
-[B<--split=>I<N>]
+[B<--skip=>I<N>]
 I<module>
 [I<MODOPT>]
 I<FILE> ...
@@ -61,4 +61,88 @@ of an I<output module>.  Optional I<MODOPT> are options for the module.
 
 =head1 OPTIONS
 
+=over 4
+
+=item B<-s>, B<--skip> I<N>
+
+Skip first I<N> rows in the input file.
+
+=item B<-o>, B<--output> I<FILE>
+
+Write output to I<FILE>, instead of the standard output.  Note, that
+depending on I<module> and its options I<FILE> can be treated as a file
+or a directory or even be ignored.  Please consult the manual for the
+particular module in use.
+
+=item B<-?>
+
+Produce a short help text and exit.
+
+=item B<--help>
+
+Display the manual page and exit.
+
+=item B<--usage>
+
+Display a short command line usage summary and exit.
+
+=back
+
+=head1 MODULES
+
+Several modules are shipped with B<makeredirect>.  To see a list of installed
+modules, run
+
+   makeredirect help
+
+To see the manual page for a particular I<MODULE>, run
+
+   makeredirect help MODULE
+
+or
+
+   makeredirect MODULE --help
+
+=head1 INPUT CVS FORMAT
+
+Each row in the input CSV file must contain two to three columns:
+
+  SRC,DST,FLAGS
+
+The I<SRC> column lists the source URL.  If this column contains a single
+dash, this row introduces default settings.  Its I<DST> column is ignored
+and its I<FLAGS> column sets defaults for flags (see below).  The new
+flag values apply to all subsequent rows up to the next default column or
+end of input.
+
+The I<DST> column contains the URL to redirect all requests to I<SRC> to.
+
+Both I<SRC> and I<DST> can consist of only the path part, or path and query
+part, or be a full URL.
+
+The optional I<FLAGS> part contains whitespace-delimited list of flags
+that control the parser behavior.  Following flags are implemented:
+
+=over 4
+
+=item B<www>
+
+If I<SRC> contains the host part, produce redirects for both unchanged host
+part and host part with C<www.> prefix.  If the host part already starts with
+C<www.>, produce redirects for both the unchanged host part and the host part
+with the C<www.> prefix stripped off.
+
+=item B<exact>
+
+Create redirects for exact match.  By default, B<makeredirect> creates rules
+for redirecting I<SRC> and all its subpath.  Notice, however, that some
+modules don't support this option.  When in doubt, consult the manual for the
+output module in use.
+
+=back
+
+Each flag value can be prefixed with a minus sign to disable that particular
+setting.  This may be necessary to turn off default flags values set by a
+preceding C<-> row.
+
 =cut
diff --git a/t/04_rewrite.t b/t/04_rewrite.t
index e1816a0..4f84884 100644
--- a/t/04_rewrite.t
+++ b/t/04_rewrite.t
@@ -8,13 +8,15 @@ use_ok 'TestRedirect';
 my $t = new TestRedirect('rewrite', monolithic => 1);
 is_deeply([$t->errors],[]);
 is $t->result,<<EOT;
-RewriteRule "^/foo" /bar [L,R=301,NE]
+RewriteRule "^/foo" /bar [L,R=301]
 RewriteCond %{HTTP_HOST} =example.com [NC]
-RewriteRule "^/source/subdir" /subdir [L,R=301,NE]
+RewriteRule "^/source/subdir" /subdir [L,R=301]
 RewriteCond %{HTTP_HOST} =example.com [NC]
-RewriteRule "^/source" /dest [L,R=301,NE]
+RewriteRule "^/source" /dest [L,R=301]
+RewriteCond %{HTTP_HOST} =example.com [NC]
+RewriteRule "^/baz" /sub/b%20a%20z [L,R=301,NE]
 RewriteCond %{HTTP_HOST} =example.org [NC]
-RewriteRule "^/foobar" /baz [L,R=301,NE]
+RewriteRule "^/foobar" /baz [L,R=301]
 EOT
 ;
 __DATA__
@@ -22,3 +24,4 @@ __DATA__
 https://example.com/source,/dest
 http://example.org/foobar,/baz
 https://example.com/source/subdir,/subdir
+https://example.com/baz,/sub/b a z
diff --git a/t/05_rewrite.t b/t/05_rewrite.t
index 79952f5..bde73d1 100644
--- a/t/05_rewrite.t
+++ b/t/05_rewrite.t
@@ -8,8 +8,8 @@ use_ok 'TestRedirect';
 my $t = new TestRedirect('rewrite', mono => 1);
 is_deeply([$t->errors],[]);
 is $t->result,<<EOT;
-RewriteRule "^/source/siste lenke" /last [L,R=301,NE]
-RewriteRule "^/source/første lenke" /first [L,R=301,NE]
+RewriteRule "^/source/siste lenke" /last [L,R=301]
+RewriteRule "^/source/første lenke" /first [L,R=301]
 EOT
 ;
 __DATA__