#! /usr/bin/env perl

# Test HTMLGenerator

# Check function that transfers query strings from old URIs to new
# ones.

use strict;
use warnings;
use utf8;
use Data::Dumper;

use lib 'lib';
use HTMLGenerator qw(transfer_query_string);

binmode( STDOUT, "utf8" );

my @cases = (
    [ "new/uri?",            "old/uri?param=value", undef ],
    [ "new/uri?already=has", "old/uri?param=value", undef ],

    [ "new/uri",             "old/uri?param=value", undef ],
    [ "new/uri",             "old/uri",             undef ],

    [ "new/uri",             "old/uri?param=value", { append => "extra=value" } ],
    [ "new/uri",             "old/uri",             { append => "extra=value" } ],
    [ "new/uri",             "old/uri?param=value", { append => "extra=value&another=value" } ],
    [ "new/uri",             "old/uri",             { append => "extra=value&another=value" } ],

    [ "new/uri",             "old/uri?param=value", { exclude_re => 'param' } ],
    [ "new/uri",             "old/uri",             { exclude_re => 'param' } ],

    [ "new/uri#fragment",    "old/uri",             undef ],
    [ "new/uri#fragment",    "old/uri?param=value", undef ],

    [ "new/uri#newfrag",     "old/uri#oldfrag",             undef ],
    [ "new/uri#newfrag",     "old/uri?param=value#oldfrag", undef ],

    [ "new/uri",             "old/uri",             { append => "extra=unescaped&value" } ],
    [ "new/uri",             "old/uri",             { append => { extra => 'unescaped&value' } } ],
);

$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Indent   = 1;

local $, = "\t";
my $n = 0;
for my $case (@cases) {

    print "test" . ++$n . ":\n";
    print Dumper $case;
    
    eval {
        local $\ = "\n";
        print "", &transfer_query_string( @{$case} );
    };
    if( $@ ) {
        print $@;
    }
};
