# -*- perl -*-

# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'

######################### We start with some black magic to print on failure.

# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)

BEGIN {print "1..120\n";}
END {print "not ok 1\n" unless $loaded;}
use News::Newsrc;
$loaded = 1;
print "ok 1\n";

######################### End of black magic.

# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):

my $N = 1;

sub Not{ print "not " };
sub OK { print "ok ", ++$N, "\n" }

#GLOBALS
my $Verbose;
my @Test_files = qw(t/newsrc t/.newsrc t/newsrc.bak t/.newsrc.bak);

$ENV{HOME} = 't';

test_load        ();
test_load_errs   ();
test_save        ();
test_save_bak    ();
test_save_load   ();
test_save_as     ();
test_import      ();
test_export      ();
test_groups      ();
test_subscription();
test_where       ();
test_moves       ();
test_adds        ();
test_marks       ();
test_predicates  ();
test_lists       ();
test_get_articles();
test_set_articles();

unlink @Test_files;


sub test_load
{
    print "#load\n";

    my @test = (["t/.newsrc", "a: 1,3\n\n", ""            , 1 , "a: 1,3\n" ],
		["t/newsrc" , "b! 1-10\n ", "t/newsrc"    , 1 , "b! 1-10\n"],
		[""         , ""          , "t/newsrc.bak", "", ""         ]);

    my $t;
    my $rc = new News::Newsrc;

    unlink @Test_files;
    for $t (@test)
    {
	my($write_file, $contents, $load_file, $e_return, $e_dump) = @$t;
	write_file($write_file, $contents);
	my $return = $rc->load($load_file);
	my $dump = $rc->_dump();
	printf("#%-12s %s -> %s: %s\n", 
	       "load($load_file)", $contents, $return, $dump);
	$return eq $e_return and $dump eq $e_dump or Not; OK;
    }
}


sub test_load_errs
{
    print "#load errors\n";

    my @test = ([ 't/.newsrc', 'a'      , 'Bad newsrc line' ],
		[ 't/.newsrc', 'a: 10-1', 'Bad article list']);

    my $t;
    my $rc = new News::Newsrc;

    unlink @Test_files;
    for $t (@test)
    {
	my($file, $contents, $error) = @$t;
	write_file($file, $contents);
	my $return = eval { $rc->load() };
	printf("#%-12s %-10s -> %s %s", 
	       "load", $contents, defined $return ? 't' : 'f', $@);
	not $return and $@ =~ /$error/ or Not; OK;
    }
}


sub test_save
{
    print "#save\n";

    unlink @Test_files;
    my $rc = new News::Newsrc;
    my $scan ="a: 1,3\n";
    $rc->_scan($scan);
    $rc->save();
    my $read = read_file('t/.newsrc');
    printf("#%-12s %-20s -> %s", "save", $scan, $read);
    $scan eq $read or Not; OK;
}


sub test_save_bak
{
    print "#save_bak\n";
    unlink @Test_files;
    my $rc = new News::Newsrc;

    $rc->save();
    my $result = defined -e 't/.newsrc.bak' ? 1 : 0;
    printf("#%-12s %-20s -> %d\n", "save", "", $result);
    $result and Not; OK;

    $rc->save();
    $result = defined -e 't/.newsrc.bak' ? 1 : 0;
    printf("#%-12s %-20s -> %d\n", "save", "", $result);
    $result or Not; OK;
}


sub test_save_load
{
    print "#save_load\n";
    my $rc = new News::Newsrc;

    write_file('t/newsrc', '');
    $rc->load('t/newsrc');
    unlink @Test_files;
    $rc->save();

    my $result = defined -e 't/newsrc' ? 1 : 0;
    printf("#%-12s %-20s -> %d\n", "save", "", $result);
    $result or Not; OK;
}


sub test_save_as
{
    print "#save_as\n";
    my $rc = new News::Newsrc;

    unlink @Test_files;
    $rc->save_as('t/newsrc');
    my $result = defined -e 't/newsrc' ? 1 : 0;
    printf("#%-12s %-20s -> %d\n", "save", "", $result);
    $result or Not; OK;

    unlink @Test_files;
    $rc->save();
    $result = defined -e 't/newsrc' ? 1 : 0;
    printf("#%-12s %-20s -> %d\n", "save", "", $result);
    $result or Not; OK;
}


sub test_import
{
    print "#import\n";

    my $lines = <<LINES;
a: 1,3
b! 1-10
c: 1,3,5,9-9000
LINES
    my @lines = split /\n/, $lines;
    my $rc = new News::Newsrc;

    $rc->import_rc(@lines);
    $rc->_dump eq $lines or Not; OK;

    $rc->import_rc(\@lines);
    $rc->_dump eq $lines or Not; OK;
}


sub test_export
{
    print "#export\n";

    my $contents = <<CONTENTS;
a: 1,3
b! 1-10
c: 1,3,5,9-9000
CONTENTS

    my $rc = new News::Newsrc;
    $rc->_scan($contents);

    my @lines = $rc->export_rc;
    join('',  @lines) eq $contents or Not; OK;

    my $lines = $rc->export_rc;
    join('', @$lines) eq $contents or Not; OK;
}


sub test_groups
{
    print "#groups\n";

    my @test = (["add_group('a')            ", "a:\n"        , 1],
		["add_group('b')            ", "a:\nb:\n"    , 1],
		["add_group('c')            ", "a:\nb:\nc:\n", 1],
		["add_group('c')            ", "a:\nb:\nc:\n", 0],
		["add_group('c', replace=>1)", "a:\nb:\nc:\n", 1],
		["del_group('b')            ", "a:\nc:\n"    , 1],
		["del_group('x')            ", "a:\nc:\n"    , 0]);
	 
    my $rc = new News::Newsrc;

    my $t;
    for $t (@test)
    {
	my($op, $eDump, $eReturn) = @$t;
	my $return = eval "\$rc->$op";
	my $dump   = $rc->_dump();
	print "#$op\n$dump, $return\n";
	$dump eq $eDump and $return == $eReturn or Not; OK;
    }
}


sub test_subscription
{
    print "#subscription\n";

    my @test = (["unsubscribe('a')", "a!\nc:\n"],
		["subscribe('a')  ", "a:\nc:\n"],
		["subscribe('d')  ", "a:\nc:\nd:\n"],
		["unsubscribe('e')", "a:\nc:\nd:\ne!\n"]);
	 
    my $rc = new News::Newsrc;
    $rc->add_group("a");
    $rc->add_group("c");

    my $t;
    for $t (@test)
    {
	my($op, $expected) = @$t;
	eval "\$rc->$op";
	my $result = $rc->_dump();
	print "#$op\n$result";
	$result eq $expected or Not; OK;
    }
}


sub test_where
{
    print "#where\n";

    my $test = <<TEST;
'e'                       e
'h'                       e h
'a',where=>'first'        a e h
'z',where=>'last'         a e h z
'g',where=>'alpha'        a e g h z
'f',where=>[number=>2]    a e f g h z
'r',where=>[number=>-1]   a e f g h r z
'p',where=>[before=>'r']  a e f g h p r z
't',where=>[after=>'r']   a e f g h p r t z
'w',where=>[number=>100]  a e f g h p r t z w
'x',where=>[before=>'b']  a e f g h p r t z w x
'y',where=>[after=>'b']   a e f g h p r t z w x y
TEST
    
    my $rc = new News::Newsrc;

    for (split(/\n/, $test))
    {
	my($op, @groups) = split;
	eval "\$rc->add_group($op)";
	my $result   = $rc->_dump;
	my $expected = join(":\n", @groups, '');
	print "#$op\n$result";
	$result eq $expected or Not; OK;
    }
}


sub test_moves
{
    print "#moves\n";
    
    my @groups = qw(a b d e f g c);
    
    my $test = <<TEST;
'c',where=>'alpha'        a b c d e f g
'a',where=>'alpha'        a b c d e f g
'g',where=>'alpha'        a b c d e f g
'b'                       a c d e f g b
'c',where=>'first'        c a d e f g b
'g',where=>'last'         c a d e f b g
'f',where=>[number=>2]    c a f d e b g
'e',where=>[number=>-1]   c a f d b e g
'g',where=>[before=>'b']  c a f d g b e
'a',where=>[after=>'d']   c f d a g b e
'd',where=>[number=>-100] d c f a g b e
'f',where=>[before=>'x']  d c a g b e f
'c',where=>[after=>'x']   d a g b e f c
TEST
    
    my $rc = new News::Newsrc;
    
    my $group;
    for $group (@groups) { $rc->add_group($group) }

    for (split(/\n/, $test))
    {
	my($op, @groups) = split;
	eval "\$rc->move_group($op)";
	my $result   = $rc->_dump;
	my $expected = join(":\n", @groups, '');
	print "#$op\n$result";
	$result eq $expected or Not; OK;
    }
}


sub test_adds
{
    print "#adds\n";

    my @test = 
	(['add_group'        , []   ],
	 ['subscribe'        , []   ],
	 ['unsubscribe'      , []   ],
	 ['mark'             , [1]  ], 
	 ['mark_list'        , [[1]]],
	 ['mark_range'       , [1,1]],
	 ['unmark'           , [1]  ], 
	 ['unmark_list'      , [[1]]],
	 ['unmark_range'     , [1,1]],
	 ['marked_articles'  , []   ],
	 ['unmarked_articles', [1,1]],
	 ['get_articles'     , []   ],
	 ['set_articles'     , [1]  ]);
    
    my $rc = new News::Newsrc;
    my $group = 'a';

    my $test;
    for $test (@test)
    {
	my($method, $args) = @$test;
	$rc->$method($group++, @$args, where=>'first');
    }

    my $result   = join(' ', $rc->groups);
    my $expected = join(' ', reverse 'a'..'m');
    $result eq $expected or Not; OK;
    print "#$result\n";
}


sub test_marks
{
    print "#marks\n";

    my @test1 = 
	(["mark        ('a', 1      )", "a: 1\nb:\nc:\n"                   ],
	 ["mark        ('b', 4      )", "a: 1\nb: 4\nc:\n"                 ],
	 ["mark_list   ('c', [1,3,5])", "a: 1\nb: 4\nc: 1,3,5\n"           ],
	 ["mark_list   ('b', [1..10])", "a: 1\nb: 1-10\nc: 1,3,5\n"        ],
	 ["mark_range  ('a', 3, 5   )", "a: 1,3-5\nb: 1-10\nc: 1,3,5\n"    ],
	 ["unmark      ('a', 3      )", "a: 1,4-5\nb: 1-10\nc: 1,3,5\n"    ],
	 ["unmark_list ('b', [3..5] )", "a: 1,4-5\nb: 1-2,6-10\nc: 1,3,5\n"],
	 ["unmark_range('c', 5, 10  )", "a: 1,4-5\nb: 1-2,6-10\nc: 1,3\n"  ]);

    my $r1 = $test1[-1]->[1];

    my @test2 = 
	(["mark        ('d', 1    )",  $r1 . "d: 1\n"],
	 ["mark_list   ('e', [1,2])",  $r1 . "d: 1\ne: 1-2\n"],
	 ["mark_range  ('f', 3, 5 )",  $r1 . "d: 1\ne: 1-2\nf: 3-5\n"]);

    my $r2 = $test2[-1]->[1];

    my @test3 = 
	(["unmark      ('g', 1    )",  $r2 . "g:\n"],
	 ["unmark_list ('h', [1,2])",  $r2 . "g:\nh:\n"],
	 ["unmark_range('i', 3, 5 )",  $r2 . "g:\nh:\ni:\n"]);

    my $rc = new News::Newsrc;
    $rc->add_group('a');
    $rc->add_group('b');
    $rc->add_group('c');

    my $t;
    for $t (@test1, @test2, @test3)
    {
	my($op, $expected) = @$t;
	eval "\$rc->$op";
	my $result = $rc->_dump();
	print "#$op\n$result";
	$result eq $expected or Not; OK;
    }
}


sub test_predicates
{
    print "#predicates\n";

    my @test = 
	(["exists",     ['a'    ], 1],
	 ["exists",     ['b'    ], 1],
	 ["exists",     ['e'    ], 0],
	 ["subscribed", ['a'    ], 1],
	 ["subscribed", ['b'    ], 0],
	 ["subscribed", ['e'    ], 0],
	 ["marked",     ['a', 1 ], 1],
	 ["marked",     ['a', 6 ], 0],
	 ["marked",     ['b', 4 ], 1],
	 ["marked",     ['c', 25], 0],
	 ["marked",     ['e', 1 ], 0],
	 ["exists",     ['e'    ], 0]);

    my $rc = new News::Newsrc;
    $rc->load("t/fodder");

    my $t;
    for $t (@test)
    {
	my($op, $args, $expected) = @$t;
	my $result = $rc->$op(@$args);
	print "#$op(@$args) -> $result\n";
	($result xor $expected) and Not; OK;
    }
}


sub test_lists
{
    print "#lists\n";

    my $rc = new News::Newsrc;
    $rc->load("t/fodder");

    my $n = $rc->num_groups;
    print "#num_groups -> $n\n";
    $n==5 or Not; OK;

    my @test = 
	(["groups                      ", "c a f b d"],
	 ["sub_groups                  ", "c a d"    ],
	 ["unsub_groups                ", "f b"      ],
	 ["marked_articles  ('a')      ", "1 2 3 4 5"],
	 ["marked_articles  ('x')      ", ""         ],
	 ["unmarked_articles('a', 1, 9)", "6 7 8 9"  ],
	 ["unmarked_articles('y', 3, 5)", "3 4 5"    ]);

    my $t;
    for $t (@test)
    {
	my($op, $expected) = @$t;
	my @result = eval "\$rc->$op";
	my $result = join(' ', @result);
	print "#$op -> $result\n";
	$result eq $expected or Not; OK;
    }

    $rc->load("t/fodder");

    for $t (@test)
    {
	my($op, $expected) = @$t;
	my $result = eval "\$rc->$op";
	   $result = join(' ', @$result);
	print "#$op -> $result\n";
	$result eq $expected or Not; OK;
    }
}


sub test_get_articles
{
    print "#get_articles\n";

    my $get = <<GET;
c 20-21,33,38
a 1-5
f
b 3-8,15,20
d 1,3,7
x
GET
    my $rc = new News::Newsrc;
    $rc->load("t/fodder");

    for (split(/\n/, $get))
    {
	my($group, $expected) = (split, '');
	my $result = $rc->get_articles($group);
	print "#$group -> $result\n";
	$result eq $expected or Not; OK;
    }
}


sub test_set_articles
{
    print "#set_articles\n";

    my $set = <<SET;
c
a 1-5,81
f 5
y 23,26,31-91
z
SET

    my $rc = new News::Newsrc;
    $rc->load("t/fodder");

    for (split(/\n/, $set))
    {
	my($group, $expected) = (split, '');

	my $ok = $rc->set_articles($group, $expected);
	print "#$group -> $ok\n";
	$ok or Not; OK;

	my $result = $rc->get_articles($group);
	print "#$group -> $result\n";
	$result eq $expected or Not; OK;

	$ok = $rc->set_articles($group, '----');
	print "#$group -> $ok\n";
	$ok and Not; OK;

	$result = $rc->get_articles($group);
	print "#$group -> $result\n";
	$result eq $expected or Not; OK;
    }
}


sub write_file
{
    my($name, $contents) = @_;
    $name or return;
    open(FILE, "> $name") or die "Can't open $name: $!\n";
    print FILE $contents;
    close FILE;
}


sub read_file
{
    my($name) = @_;
    open(FILE, "$name") or die "Can't open $name: $!\n";
    my $contents = join('', <FILE>);
    close FILE;
    $contents;
}

