package tests::UtilsTest;

use strict;

use base qw/ Lire::Test::TestCase /;

use File::Spec;
use Lire::Utils qw/xml_encode latex_encode diff_lists tilde_expand
                   tmpdir tempfile tempdir min max ratio ratio100
                   shell_quote file_content create_file sql_quote_name
                   tree_apply item_index deep_copy
                   check_param check_object_param indent
                   period_range text_for_width is_url parse_url
                   unique /;
use Time::Local;

#our @TESTS = qw//;

sub set_up {
    my $self = $_[0];
    $self->SUPER::set_up();

    return;
}

sub tear_down {
    my $self = $_[0];
    $self->SUPER::tear_down();

    return;
}

sub test_xml_encode {
    my $self = $_[0];

    my $v = xml_encode( "<XML> & </XML> Joe \"Such\" a Friend's birtday" );
    $self->assert_equals( "&lt;XML> &amp; &lt;/XML> Joe &quot;Such&quot; a Friend&apos;s birtday", $v );
}

sub test_latex_encode {
    my $self = $_[0];

    $self->assert_str_equals( '\\# \\$ \\& \\~{} \\_ \\^{} \\% \\{ \\} $\\backslash$ Other $[$ $]$ $<$ $>$',  latex_encode( '# $ & ~ _ ^ % { } \\ Other [ ] < >' ) );
}

sub test_diff_lists {
    my $self = $_[0];

    my $diff = diff_lists( [qw/field1 field2 field3 field4/],
                           [qw/field4 field3 field2 field1/] );
    $self->assert_null( $diff, "should have found no diffs" );

    $diff = diff_lists( [qw/field1 field2 field3 field4/],
                        [qw/field3 field2 field4 field5/],
                      );
    $self->assert_not_null( $diff, "should have found diffs" );
    $self->assert_deep_equals( [ "field1" ], $diff->{'remove'} );
    $self->assert_deep_equals( [ "field5" ], $diff->{'new'} );

    $diff = diff_lists( [qw/field1 field2 field3 field4/],
                        [qw/field6 field3 field2 field4 field5/],
                      );

    $self->assert_not_null( $diff, "should have found diffs" );
    $self->assert_deep_equals( [ "field1" ], $diff->{'remove'} );
    $self->assert_deep_equals( [ "field5", "field6" ], $diff->{'new'} );
}

sub test_tilde_expansion {
    my $self = $_[0];

    my $home = $ENV{'HOME'};

    $self->assert_equals($home, tilde_expand('~'));
    $self->assert_equals("$home/", tilde_expand('~/'));
    $self->assert_equals("$home/~", tilde_expand('~/~'));
    $self->assert_equals("$home/~/", tilde_expand('~/~/'));
    $self->assert_equals('/~', tilde_expand('/~'));
    $self->assert_equals('/~/', tilde_expand('/~/'));

    my $user = 'uioxzcyo';

    $self->assert_equals("~$user", tilde_expand("~$user"));
    $self->assert_equals("~$user/", tilde_expand("~$user/"));
    $self->assert_equals("/$user~", tilde_expand("/$user~"));
    $self->assert_equals("/$user~/", tilde_expand("/$user~/"));

    $user = getpwuid($<);
    my ($name,$pass,$uid,$gid,$quota,$comment,$gecos,$dir) = getpwnam($user)
        or return;

    $self->assert_equals("$dir", tilde_expand("~$user"));
    $self->assert_equals("$dir/", tilde_expand("~$user/"));
    $self->assert_equals("/$user~", tilde_expand("/$user~"));
    $self->assert_equals("/$user~/", tilde_expand("/$user~/"));
}

sub test_min {
    my $self = $_[0];
    $self->assert_null( min() );
    $self->assert_null( min( undef, undef ) );

    $self->assert_num_equals( -1, min( -1, undef) );
    $self->assert_num_equals( 2, min( 2, undef) );
    $self->assert_num_equals( -2, min( -1,-2, 0 ) );
    $self->assert_num_equals( 0, min(0,0,0));
    $self->assert_num_equals( 0, min(1,0,0));
}

sub test_max {
    my $self = $_[0];

    $self->assert_null( max() );
    $self->assert_null( max( undef, undef ) );

    $self->assert_num_equals( 1, max( -1, 0, 1, undef ) );
    $self->assert_num_equals( -1, max( -1, -2) );
    $self->assert_num_equals( 0, max( 0, 0, 0) );
    $self->assert_num_equals( -1, max( -1, undef ) );

}

sub test_tmpdir {
    my $self = $_[0];

    $self->assert_equals( File::Spec->tmpdir, tmpdir() );
    {
        local $ENV{'TMPDIR'} = $ENV{'HOME'};
        $self->assert_equals( $ENV{'HOME'}, Lire::Utils::_tmpdir() );
    }
}

sub test_tempfile {
    my $self = $_[0];

    my $fh = Lire::Utils::_tempfile();
    $self->assert_not_null( $fh, "_tempfile() returned undef" );
    $self->assert( -r $fh, "file handle isn't readable" );
    $self->assert( -w $fh, "file handle isn't writeable" );

    my ( $nfh, $filename ) = Lire::Utils::_tempfile( "lireXXXXXX" );
    $self->assert( qr/lire[a-zA-Z0-9]{6}$/, $filename );
    $self->assert( -r $nfh, "file handle isn't readable" );
    $self->assert( -w $nfh, "file handle isn't writeable" );
    unlink $filename;

    # Try with perl's standard ones. (PerlUnit only works with perl 5.6.1 and
    # later
    my $pfh = tempfile();
    $self->assert_not_null( $pfh, "tempfile() returned undef" );
    $self->assert( -r $pfh, "file handle isn't readable" );
    $self->assert( -w $pfh, "file handle isn't writeable" );

    my ( $pnfh, $pfilename ) = tempfile( "lireXXXXXX" );
    $self->assert( qr/lire[a-zA-Z0-9]{6}$/, $pfilename );
    $self->assert( -r $pnfh, "file handle isn't readable" );
    $self->assert( -w $pnfh, "file handle isn't writeable" );
    unlink $pfilename;
}

sub test_tempdir {
    my $self = $_[0];

    my $tmpdir = Lire::Utils::_tempdir();
    $self->assert_not_null( $tmpdir, "_tempdir() returned undef" );
    $self->assert( -r $tmpdir, "tempory dir isn't readable" );
    $self->assert( -w $tmpdir, "tempory dir isn't writeable" );
    $self->assert( -x $tmpdir, "tempory dir isn't searchable" );
    rmdir $tmpdir;

    $tmpdir = Lire::Utils::_tempdir( "lireXXXXXX" );;
    $self->assert_not_null( $tmpdir, "_tempdir() returned undef" );
    $self->assert( qr/lire[a-zA-Z0-9]{6}$/, $tmpdir );
    $self->assert( -r $tmpdir, "tempory dir isn't readable" );
    $self->assert( -w $tmpdir, "tempory dir isn't writeable" );
    $self->assert( -x $tmpdir, "tempory dir isn't searchable" );
    rmdir $tmpdir;

    # Try with perl's standard ones. (PerlUnit only works with perl 5.6.1 and
    # later
    my $ptmpdir = tempdir();
    $self->assert_not_null( $ptmpdir, "tempdir() returned undef" );
    $self->assert( -r $ptmpdir, "tempory dir isn't readable" );
    $self->assert( -w $ptmpdir, "tempory dir isn't writeable" );
    $self->assert( -x $ptmpdir, "tempory dir isn't searchable" );
    rmdir $ptmpdir;

    $ptmpdir = tempdir( "lireXXXXXX" );;
    $self->assert_not_null( $ptmpdir, "_tmpdir() returned undef" );
    $self->assert( qr/lire[a-zA-Z0-9]{6}$/, $ptmpdir );
    $self->assert( -r $ptmpdir, "tempory dir isn't readable" );
    $self->assert( -w $ptmpdir, "tempory dir isn't writeable" );
    $self->assert( -x $ptmpdir, "tempory dir isn't searchable" );
    rmdir $ptmpdir;
}

sub test_ratio {
    my $self = $_[0];

    $self->assert_equals( 2, ratio( 10, 5 ) );
    # Force string comparison since NaN == NaN is false
    $self->assert_str_equals( "NaN", ratio( 10, 0 ) );
    $self->assert_equals( 0, ratio( 0, 10 ) );
    $self->assert_equals( "3.33", ratio( 10, 3 ) );
}

sub test_ratio100 {
    my $self = $_[0];

    $self->assert_equals( 50, ratio100( 5, 10 ) );
    # Force string comparison since NaN == NaN is false
    $self->assert_str_equals( "NaN", ratio100( 0, 0 ) );
    $self->assert_equals( 0, ratio100( 0, 10 ) );
    $self->assert_equals( "33.3", ratio100( 3333, 10000 ) );
}

sub test_shell_quote {
    my $self = $_[0];

    $self->assert_equals( "''", shell_quote( undef ) );
    $self->assert_equals( "'Test'", shell_quote( 'Test' ) );
    $self->assert_equals( q{'Test'\'''}, shell_quote( "Test'" ) );
    $self->assert_equals( q{'`echo shell'\''s test`'}, shell_quote( "`echo shell's test`" ) );
}

sub test_file_content {
    my $self = $_[0];

    my $content = <<EOF;
This is the file content.

More than one line.
EOF
    my ($fh, $name ) = File::Temp::tempfile();

    print $fh $content;
    close $fh;

    $self->assert_dies( qr/missing 'filename' parameter/,
                        sub { file_content() } );
    $self->assert_dies( qr{could not open '/no/such/file' for reading},
                        sub { file_content( "/no/such/file" ) } );

    $self->assert_equals( $content, file_content( $name ) );
    unlink $name;
}

sub test_create_file {
    my $self = $_[0];

    no warnings 'redefine';
    my $encoding = undef;
    my $set_fh_encoding = sub {
        $encoding = 1;
    };
    local *Lire::I18N::set_fh_encoding = $set_fh_encoding;

    $self->assert_died( sub { create_file()}, 
                        qr/missing 'filename' parameter/ );

    $self->assert_died( sub { create_file( "/no/such/file" ) },
                        qr/error creating.*: No such file/ );

    my $content = <<EOF;
This is a file.

And its content.
EOF

    my $tmpdir = File::Temp::tempdir( "Utils_XXXXXX", 'CLEANUP' => 1 );
    my $filename = "$tmpdir/test_file";

    create_file( $filename );

    $self->assert( -f $filename, "$filename wasn't created" );
    $self->assert( ! -s $filename, "$filename should be empty" );

    create_file( $filename, $content );

    my $fh;
    open $fh, $filename
      or $self->error( "open failed: $!" );
    local $/;
    my $new_content = <$fh>;
    close $fh;

    $self->assert_equals( $content, $new_content );

    $self->assert_null( $encoding );
    create_file( $filename, $content, 1 );
    $self->assert_num_equals( 1, $encoding );

    return;
}

sub test_sql_quote_name {
    my $self = $_[0];

    $self->assert_equals( 'field_name', sql_quote_name( 'field_name' ) );
    $self->assert_equals( '"field-name"', sql_quote_name( 'field-name' ) );
    $self->assert_equals( '"field.name"', sql_quote_name( 'field.name' ) );
    $self->assert_equals( '"field:name"', sql_quote_name( 'field:name' ) );
}

sub set_up_tree {
    my $self = $_[0];

    my $root = new tests::node();
    my @nodes = ( $root );
    for ( 1..3) {
        push @nodes, new tests::node( $root );
    }

    for ( 1..3 ) {
        push @nodes, new tests::node( $nodes[$_] );
        push @nodes, new tests::node( $nodes[$_] );
    }

    $self->assert_equals( 10, scalar @nodes );

    return ( $root, \@nodes );
}

sub test_tree_apply_bad_params {
    my $self = $_[0];

    $self->assert_died( sub { tree_apply() },
                        qr/missing 'root' parameter/ );
    $self->assert_died( sub { tree_apply( {}, ) },
                        qr/missing 'children_func' parameter/ );
    $self->assert_died( sub { tree_apply( {}, sub {} ) },
                        qr/missing 'apply_func' parameter/ );

}

sub test_tree_apply_subref {
    my $self = $_[0];

    my ( $root, $nodes ) = $self->set_up_tree();

    my $preorder_nodes = [ $nodes->[0],
                           $nodes->[0]{'children'}[0],
                           $nodes->[0]{'children'}[0]{'children'}[0],
                           $nodes->[0]{'children'}[0]{'children'}[1],
                           $nodes->[0]{'children'}[1],
                           $nodes->[0]{'children'}[1]{'children'}[0],
                           $nodes->[0]{'children'}[1]{'children'}[1],
                           $nodes->[0]{'children'}[2],
                           $nodes->[0]{'children'}[2]{'children'}[0],
                           $nodes->[0]{'children'}[2]{'children'}[1],
                         ];
    my $idx = 1;
    my $result = tree_apply( $root, sub { $_[0]->{'children'} },
                             sub { $_[0]{'flag'} = $idx++ } );

    my $e_result = [ 1 .. 10 ];
    $self->assert_deep_equals( $e_result, $result );
    for ( my $i=0; $i < @$preorder_nodes; $i++ ) {
        $self->assert_equals( $e_result->[$i], $preorder_nodes->[$i]{'flag'} );
    }
}

sub test_tree_apply_method {
    my $self = $_[0];

    my ( $root, $nodes ) = $self->set_up_tree();

    my $result = tree_apply( $root, 'children', 'set_flag' );
    $self->assert_deep_equals( [ ( 1 ) x 10 ], $result );
    foreach my $n ( @$nodes ) {
        $self->assert_equals( 1, $n->{'flag'} );
    }

}

sub test_item_index {
    my $self = $_[0];

    my $ref = {};
    my $array = [ 'wawa', 2, $ref, 4.0 ];

    $self->assert_died( sub { item_index() },
                        qr/missing 'array' parameter/ );
    $self->assert_died( sub { item_index( {} ) },
                        qr/'array' should be an array ref, not 'HASH/ ); #'
    $self->assert_died( sub { item_index( [] ) },
                        qr/missing 'item' parameter/ );

    $self->assert_num_equals( 0, item_index( $array, 'wawa' ) );
    $self->assert_num_equals( 1, item_index( $array, '2' ) );
    $self->assert_num_equals( 2, item_index( $array, $ref ) );
    $self->assert_num_equals( 3, item_index( $array, 4 ) );
    $self->assert_null( undef, item_index( $array, 'cocotte' ) );
}

sub test_deep_copy {
    my $self = $_[0];

    $self->assert_died( sub { deep_copy() },
                        qr/missing 'object' parameter/ );
    $self->assert_str_equals( 'Test', deep_copy( 'Test' ) );

    $self->assert_died( sub { deep_copy( 'Test', {} ) },
                        qr/'exclusions' should be an array reference, not 'HASH/ );

    my $array = [ 1, 'string', [ 2, undef, 4 ] ];
    $self->assert_deep_equals( $array, deep_copy( $array ) );
    $self->assert_str_not_equals( $array, deep_copy( $array ) );

    my $rx = qr/.*/;
    $self->assert_str_equals( $rx, deep_copy( $rx ) );

    my $hash  = { 'key1' => $array,
                  'key2' => 1,
                  'key3' => $array, };
    $hash->{'key4'} = $hash; # cyclic reference

    my $copy = deep_copy( $hash );
    $self->assert_deep_equals( $hash, $copy );
    $self->assert_str_not_equals( $hash, $copy );
    $self->assert_str_not_equals( $array, $copy->{'key1'} );
    $self->assert_str_equals( $copy->{'key1'}, $copy->{'key3'} );
    $self->assert_str_equals( $copy, $copy->{'key4'} );

    my $object = bless { 'key' => 'string1' }, 'object';
    my $object_copy = deep_copy( $object );
    $self->assert_str_equals( ref $object, ref $object_copy );
    $self->assert_str_not_equals( $object, $object_copy );
    $self->assert_deep_equals( $object, $object_copy );
}

sub test_clone_scalar_ref {
    my $self = $_[0];

    my $string = 'wawa';
    my $ref1 = \$string;
    my $ref2 = \$ref1;

    my $excl = [];
    no warnings 'redefine';
    local *Lire::Utils::_deep_copy = sub {
        my ( $object, $seen, $exclusions ) = @_;

        $self->assert_str_equals( $excl, $exclusions );
        return $object unless ref $object;
        return $seen->{$object} if exists $seen->{$object};

        if ( ref $object eq 'REF' || ref $object eq 'SCALAR') {
            return Lire::Utils::_clone_scalar_ref( $object, $seen,$exclusions);
        } else {
            $self->error( "ref type unsupported by deep_copy(): $object" );
        }
    };

    my $seen = {};
    my $ref1_copy = Lire::Utils::_clone_scalar_ref( $ref1, $seen, $excl );
    $self->assert_str_equals( $$ref1, $$ref1_copy );
    $self->assert_str_not_equals( $ref1, $ref1_copy );
    $self->assert_str_equals( $seen->{$ref1}, $ref1_copy );

    my $ref2_copy = Lire::Utils::_clone_scalar_ref( $ref2, $seen, $excl );
    $self->assert_str_equals( $$ref2_copy, $ref1_copy );
    $self->assert_str_equals( $seen->{$ref2}, $ref2_copy );
}

sub test_clone_array_ref {
    my $self = $_[0];

    my $array1 = [ 1, 2, 3 ];
    my $array2 = [ $array1 ];
    my $excl = [];

    no warnings 'redefine';
    local *Lire::Utils::_deep_copy = sub {
        my ( $object, $seen, $exclusions ) = @_;

        $self->assert_str_equals( $excl, $exclusions );

        return $object unless ref $object;
        return $seen->{$object} if exists $seen->{$object};

        if ( ref $object eq 'ARRAY' ) {
            return Lire::Utils::_clone_array_ref( $object, $seen, $exclusions);
        } else {
            $self->error( "ref type unsupported by deep_copy(): $object" );
        }
    };

    my $seen = {};
    my $array1_copy = Lire::Utils::_clone_array_ref( $array1, $seen, $excl );
    $self->assert_str_not_equals( $array1, $array1_copy );
    $self->assert_deep_equals( $array1_copy, $array1 );
    $self->assert_str_equals( $array1_copy, $seen->{$array1} );

    my $array2_copy = Lire::Utils::_clone_array_ref( $array2, $seen, $excl );
    $self->assert_str_equals( $array2_copy, $seen->{$array2} );
    $self->assert_deep_equals( $array2_copy, $array2 );
}

sub test_clone_hash_ref {
    my $self = $_[0];

    my $hash1 = { 'key1' => 'value1',
                  'key2' => 'value2' };
    my $hash2 = { 'key1' => 1,
                  'key2' => $hash1 };

    my $excl = [];

    no warnings 'redefine';
    local *Lire::Utils::_deep_copy = sub {
        my ( $object, $seen, $exclusions ) = @_;

        $self->assert_str_equals( $excl, $exclusions );

        return $object unless ref $object;
        return $seen->{$object} if exists $seen->{$object};

        if ( ref $object eq 'HASH' ) {
            return Lire::Utils::_clone_hash_ref( $object, $seen, $exclusions );
        } else {
            $self->error( "ref type unsupported by deep_copy(): $object" );
        }
    };

    my $seen = {};
    my $hash1_copy = Lire::Utils::_clone_hash_ref( $hash1, $seen, $excl );
    $self->assert_str_not_equals( $hash1, $hash1_copy );
    $self->assert_deep_equals( $hash1_copy, $hash1 );
    $self->assert_str_equals( $hash1_copy, $seen->{$hash1} );

    my $hash2_copy = Lire::Utils::_clone_hash_ref( $hash2, $seen, $excl );
    $self->assert_str_equals( $hash2_copy, $seen->{$hash2} );
    $self->assert_deep_equals( $hash2_copy, $hash2 );
}

sub test_clone_object {
    my $self = $_[0];

    my $scalar = 'Test';
    my $scalar_object = bless \$scalar, 'scalar';
    my $array_object = bless [], 'array';
    my $glob_object = bless \*SYMBOL, 'symbol';
    my $object1 = bless { 'key1' => 1 }, "package1";
    my $object2 = bless { 'key1' => $object1 }, 'package2';

    $self->assert_died( sub { Lire::Utils::_clone_object( $glob_object, {} ) },
                        qr/unsupported object storage: 'symbol=GLOB/ );

    my $seen = {};
    my $ob1_copy = Lire::Utils::_clone_object( $object1, $seen );
    $self->assert_str_not_equals( $object1, $ob1_copy );
        $self->assert_str_equals( ref $object1, ref $ob1_copy );
    $self->assert_deep_equals( $object1, $ob1_copy );
    $self->assert_str_equals( $ob1_copy, $seen->{$object1} );

    my $ob2_copy = Lire::Utils::_clone_object( $object2, $seen );
    $self->assert_str_equals( $ob2_copy, $seen->{$object2} );
    $self->assert_deep_equals( $ob2_copy, $object2 );

    $self->assert_str_equals( $object2, 
                              Lire::Utils::_clone_object( $object2, $seen,
                                                          [ 'package2' ] ) );
}

sub test_check_param {
    my $self = $_[0];

    $self->assert_died( sub { check_param() },
                        qr/check_param needs at least 2 arguments: a parameter, the parameter\'s name/ );
    $self->assert_died( sub { check_param( undef, 'wawa&' ) },
                        qr/parameter 'name' is not a valid name: 'wawa&'/ );

    $self->assert_died( sub { check_param( undef, 'wawa' ) },
                        qr/missing \'wawa\' parameter/ );
    $self->assert_died( sub { check_param( '123', 'wawa', qr/^[a-z]+$/ ) },
                        qr/\'wawa\' parameter doesn\'t match \'\(.*\)': \'123\'/ );
    $self->assert_died( sub { check_param( 'abc', 'wawa', qr/^[0-9]+$/,
                                           "'wawa' parameter is not a valid integer" )},
                        qr/\'wawa\' parameter is not a valid integer: \'abc\'/ );

    $self->assert_died( sub { check_param( 0, 'wawa', sub { return $_[0] },
                                           "'wawa' parameter is false" )},
                        qr/\'wawa\' parameter is false: \'0\'/ );
    check_param( 1, 'wawa', sub { return $_[0] },
                 "This test of check_param should have passed" );

    return;
}

sub test_check_object_param {
    my $self = $_[0];

    my $test_obj = bless {}, 'TestClass';

    $self->assert_died( sub { check_object_param() },
                        qr/check_object_param needs 3 arguments: an object, the object parameter\'s name, the object's class name/ );

    $self->assert_died( sub { check_object_param( $test_obj, 'wawaobj&',
                                                  [ 'WawaClass' ] ) },
                        qr/parameter 'name' is not a valid name: 'wawaobj&'/ );

    $self->assert_died( sub { check_object_param( $test_obj, 'wawaobj',
                                                  'WawaClass&' ) },
                        qr/parameter 'class' contains an invalid class name: 'WawaClass&'/ );

    $self->assert_died( sub { check_object_param( $test_obj, 'wawaobj',
                                                  [ 'WawaClass&' ] ) },
                        qr/parameter 'class' contains an invalid class name: 'WawaClass&'/ );
    $self->assert_died( sub { check_object_param( $test_obj, 'wawaobj',
                                                  [ 'Wawa:Class' ] ) },
                        qr/parameter 'class' contains an invalid class name: 'Wawa:Class'/ );
    $self->assert_died( sub { check_object_param( $test_obj, 'wawaobj',
                                                  [ 'Wawa:::Class' ] ) },
                        qr/parameter 'class' contains an invalid class name: 'Wawa:::Class'/ );

    $self->assert_died( sub { check_object_param( 'wawa', 'wawaname',
                                                  [ 'wawaclass' ] ) },
                        qr/'wawaname' parameter should be a 'wawaclass' instance, not \'wawa\'/ );
    $self->assert_died( sub { check_object_param( $test_obj, 'wawa',
                                                  'WawaClass' ) },
                        qr/'wawa' parameter should be a 'WawaClass' instance, not 'TestClass/ );
    $self->assert_died( sub { check_object_param( $test_obj, 'wawa',
                                                  [ 'WawaClass' ] ) },
                        qr/'wawa' parameter should be a 'WawaClass' instance, not 'TestClass/ );
    $self->assert_died( sub { check_object_param( $test_obj, 'wawa',
                                                  [ 'WawaClass',
                                                    'Chill::Class',
                                                    'Mega::Class::Name' ] ) },
                        qr/'wawa' parameter should be a 'WawaClass', 'Chill::Class' or 'Mega::Class::Name' instance, not 'TestClass/ );

    $self->assert_died( sub { check_object_param( $test_obj, 'wawa',
                                                  [] )},
                        qr/parameter \'class\' should contain at least one class name/ );

    my $rc = check_object_param( $test_obj, 'wawaobj', [ 'TestClass' ] );
    $self->assert_null( $rc, "there should be no return code" );

    check_object_param( bless ({}, 'Test::Class') , 'wawaobj', [ 'Test::Class' ] );

    return;
}

sub _check_object_param_fail_method {
    my ( $self, $object );

    check_object_param( $object, 'test_object', [ 'tests::UtilsTest' ] );
}

sub test_check_object_param_caller {
    my $self = $_[0];

    # check_object_param() invocations with a wrong object instance should
    # return the method's caller informations (1st check) while bad parameters
    # given to check_object_param() itself should refer to the
    # check_object_param's caller (2nd check).
    my $this_file = 'nofile';
    my $this_line = 'noline';
    eval { $this_file = __FILE__;
           $this_line = __LINE__; _check_object_param_fail_method( undef ); };
    my $err = $@;
    $self->assert_not_null( $err, "no error message??" );
    $self->assert_matches( qr/^missing 'test_object' parameter at $this_file:$this_line$/,
                           $err );

    eval { $this_file = __FILE__;
           $this_line = __LINE__; check_object_param();};
    $err = $@;
    $self->assert_not_null( $err, "no error message??" );
    $self->assert_matches( qr/^check_object_param needs 3 arguments: an object, the object parameter's name, the object's class name at $this_file:$this_line$/,
                           $err );

    return;
}


sub test_indent {
    my $self = $_[0];

    $self->assert_str_equals( '', indent() );
    $self->assert_str_equals( '', indent( '' ) );

    my $start_text = 'simple line';
    $self->assert_str_equals( '  simple line', indent( $start_text ) );

    $start_text = <<_EOT;
text for indentation
  indented line
end of indentation
_EOT
    my $e_text = <<_EOT;
  text for indentation
    indented line
  end of indentation
_EOT

    $self->assert_str_equals( $e_text, indent( $start_text ) );

    $e_text = <<_EOT;
    text for indentation
      indented line
    end of indentation
_EOT
    $self->assert_str_equals( $e_text, indent( $start_text, 4 ) );

    return;
}

sub test_period_range {
    my $self = $_[0];

    $self->{'cfg'}{'lr_week_numbering'} = 'U';
    $self->set_up_tz( 'UTC' );

    my $dec31_2004 = timelocal( 0, 5, 23, 31, 11, 2004 );
    $self->assert_dies( qr/'period' parameter should be one of 'hourly', 'daily', 'weekly', 'monthly' or 'yearly'/,
                        sub { period_range( 'unique', $dec31_2004 ) } );

    $self->assert_deep_equals( [ timelocal( 0, 0, 23, 31, 11, 2004 ),
                                 timelocal( 0, 0, 0, 1, 0, 2005 ) ],
                               period_range( 'hourly', $dec31_2004 ) );

    $self->assert_deep_equals( [ timelocal( 0, 0, 0, 31, 11, 2004 ),
                                 timelocal( 0, 0, 0, 1, 0, 2005 ) ],
                               period_range( 'daily', $dec31_2004 ) );

    $self->assert_deep_equals( [ timelocal( 0, 0, 0, 1, 11, 2004 ),
                                 timelocal( 0, 0, 0, 1, 0, 2005 ) ],
                               period_range( 'monthly', $dec31_2004 ) );

    my $jan1_2004 = timelocal( 0, 0, 0, 1, 0, 2004 );
    $self->assert_deep_equals( [ timelocal( 0, 0, 0, 1, 0, 2004 ),
                                 timelocal( 0, 0, 0, 1, 1, 2004 ) ],
                               period_range( 'monthly', $jan1_2004 ) );

    $self->assert_deep_equals( [ timelocal( 0, 0, 0, 1, 0, 2004 ),
                                 timelocal( 0, 0, 0, 1, 0, 2005 ) ],
                               period_range( 'yearly', $dec31_2004 ) );

    $self->assert_deep_equals( [ timelocal( 0, 0, 0, 26, 11, 2004 ),
                                 timelocal( 0, 0, 0, 2, 0, 2005 ) ],
                               period_range( 'weekly', $dec31_2004 ) );
}

sub test_text_for_width {
    my $self = $_[0];

    $self->assert_dies( qr/missing \'text\' parameter/,
                        sub { text_for_width() } );
    $self->assert_dies( qr/missing \'width\' parameter/,
                        sub { text_for_width( 'wawa' ) } );
    $self->assert_dies( qr/\'width' should be a positive, greater than or equal to 5, integer: \'-3\'/,
                        sub { text_for_width( 'wawa', -3 ) } );
    $self->assert_dies( qr/\'width' should be a positive, greater than or equal to 5, integer: \'wawa\'/,
                        sub { text_for_width( 'wawa', 'wawa' ) } );

    $self->assert_str_equals( 'wawa',
                              text_for_width( 'wawa', 10 ) );
    $self->assert_str_equals( 'b...s',
                              text_for_width( 'bigwawatestormorethan9chars', 5 ) );
    $self->assert_str_equals( 'big...ars',
                              text_for_width( 'big wawa test or more than 9 chars', 9 ) );
    $self->assert_str_equals( 'big...hars',
                              text_for_width( 'big wawa test or more than 10 chars', 10 ) );
    $self->assert_str_equals( 'big...test',
                              text_for_width( 'big           test', 10 ) );
}

sub test_is_url {
    my $self = $_[0];

    my $nourl_string1 = "/etc/lire";
    my $nourl_string2 = "/etc/lire/file://tmp";
    my $nourl_string3 = "file:/etc/lire/wawa";
    my $nourl_string4 = "fi le://etc/lire/wawa";
    my $url_string1 = "http://www.wawa.org";
    my $url_string2 = "file:///tmp";
    my $url_string3 = "file://c:/temp";

    $self->assert_num_equals( 0, is_url( $nourl_string1 ) );
    $self->assert_num_equals( 0, is_url( $nourl_string2 ) );
    $self->assert_num_equals( 0, is_url( $nourl_string3 ) );
    $self->assert_num_equals( 0, is_url( $nourl_string4 ) );
    $self->assert_num_equals( 1, is_url( $url_string1 ) );
    $self->assert_num_equals( 1, is_url( $url_string2 ) );
    $self->assert_num_equals( 1, is_url( $url_string3 ) );

    return;
}

sub test_parse_url {
    my $self = $_[0];

    $self->assert_deep_equals( { 'scheme' => 'http',
                                 'host' => 'www.logreport.org',
                                 'port' => 80,
                                 'path' => '/index.html',
                                 'query' => 'search=test',
                                 'fragment' => 'anchor' },
                               parse_url( 'http://www.logreport.org:80/index.html?search=test#anchor' ) );

    $self->assert_deep_equals( { 'scheme' => 'http',
                                 'host' => 'www.logreport.org',
                                 'port' => undef,
                                 'path' => '/index.html',
                                 'query' => undef,
                                 'fragment' => undef },
                               parse_url( 'http://www.logreport.org/index.html' ) );


    $self->assert_deep_equals( { 'scheme' => undef,
                                 'host' => undef,
                                 'port' => undef,
                                 'path' => '/index.html',
                                 'query' => undef,
                                 'fragment' => 'anchor' },
                               parse_url( '/index.html#anchor' ) );

}

sub test_unique {
    my $self = $_[0];

    $self->assert_deep_equals( [ 1, 2, 3 ],
                               unique( [ 1, 2, 3, 1, 2, 3] ) );
    $self->assert_deep_equals( [ 'aa', 'b', 'c' ],
                               unique( [ 'aa', 'aa', 'aa', 'b', 'c' ] ) );
}

package tests::node;

sub new {
    my ( $pkg, $parent ) = @_;

    my $self = bless { 'flag' => 0, 'children' => [] }, $pkg;

    push @{$parent->{'children'}}, $self
      if defined $parent;

    return $self;
}

sub children {
    return $_[0]{'children'};
}

sub set_flag {
    return $_[0]{'flag'} = 1;
}

1;