The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
# 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 { $| = 1; print "1..8\n"; }
END {print "not ok 1\n" unless $loaded;}
use RADIUS::UserFile;
$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 $USERS_FILE = 'examples/users';              # RADIUS users data file
my $NUM_USERS = 4;                              # how many users are in there
my @USERS = qw(banner joeuser chumpsize gandalf);    # who those users are
my $NUM_JOES_ATTRIBS = 8;                       # how many attribs joeuser has

my $RU;                                         # RADIUS::UserFile object

# simple test:  can we create a new object?
$t = 2;
eval { $RU = new RADIUS::UserFile(Debug => 0); } or print 'not ';
print "ok $t { new }\n";

# make sure there aren't any files loaded yet.  that'd be weird.
$t++;
scalar @{$RU->files} == 0 or print('[', @{$RU->files}, '] not ');
print "ok $t { files }\n";

# no users yet, either.
$t++;
$RU->users == undef or print 'not ';
print "ok $t { users }\n";

$t++;
scalar @{$RU->usernames} == 0 or print 'not ';
print "ok $t { username }\n";

$t++;
$RU->attributes('joeuser') == undef or print 'not ';
print "ok $t { attributes }\n";

$t++;
$RU->values('joeuser', 'attributename') == undef or print 'not ';
print "ok $t { value }\n";

# Load the users file now, and do some (slightly) more significant testing.
$t++;
eval { $RU->load(File => $USERS_FILE); } or print 'not ';
print "ok $t { load }\n";

# does the object think it loaded the file we told it to?
$t++;
eval { join('', $RU->files) eq $USERS_FILE } or print 'not ';
print "ok $t { files }\n";

# did it load the right number of users?
$t++;
eval { scalar keys %{$RU->users} == $NUM_USERS } or print 'not ';
print "ok $t { users }\n";

# check the quality of the data it loaded...
$t++;
eval { scalar @{$RU->usernames} == $NUM_USERS } or print 'not ';
print "ok $t { usernames #1 }\n";

$t++;
eval { join(' ', sort @{$RU->usernames}) eq join(' ', sort @USERS) }
 or print 'not ';
print "ok $t { usernames #2 }\n";

$t++;
eval { scalar $RU->attributes('joeuser') == $NUM_JOES_ATTRIBS }
 or print "not ";
print "ok $t { attributes }\n";

$t++;
eval { ($RU->values('joeuser', 'Password'))[0] eq '"UNIX"' } or print 'not ';
print "ok $t { value }\n";

# Ye olde "empty sub-class" test, as suggestd in the CPAN module list docs.
$t++;
eval { 
    package Subclass;
    my $USERS_FILE = 'examples/users';
    my $NUM_USERS = 4;
    @Subclass::ISA = qw(RADIUS::UserFile);
    $subRU = new Subclass;
    $subRU->load(File => $USERS_FILE);
    scalar keys %{$subRU->users} == $NUM_USERS;
} or print 'not ';
print "ok $t { empty subclass }\n";

#print "joe's attribs: ", join(', ', @{$RU->attributes('joeuser')}), "\n";
#$RU->dump('joeuser');
#foreach my $who (@{ $RU->usernames }) {
#    print "$who: \n";
#    print map(sprintf("\t%s -> %s\n", $_, $RU->value($who, $_)),
#              $RU->attributes($who)),
#          "\n";
#}

# now try adding a new user
$t++;
eval {
    $RU->add(Who        => 'areallylonguser@somedomain',
             Attributes => { 'Auth-Type' => 'unix', Password => '"jabberwocky"',
                             junkkey1 => 'val1', junkkey2 => 'val2' },
             Comment    => 'meep meep!')
     or die("test $t: couldn't add areallylonguser\@somedomain\n");
    $RU->update() or die("test $t: couldn't update $USERS_FILE\n".
                         "files are ".$RU->files."\n");
} or print 'not ';
print "ok $t { add }\n";
print $@ if $@;

# check removal of a user from the object
$t++;
eval { join('', $RU->remove('areallylonguser@somedomain'))
        eq 'areallylonguser@somedomain'
        or die("removing areallylonguser\@somedomain failed\n");
       join(' ', sort @{$RU->usernames}) eq join(' ', sort @USERS)
        or die("testing remove(areallylonguser\@somedomain) failed\n");
	} or print 'not ';
print "ok $t { remove }\n";
print $@ if $@;

# now verify the contents of the file again
$t++;
my $RU2;
eval {
    $RU2 = RADIUS::UserFile->new(File => $USERS_FILE, Debug => 0)
     or die("test $t: couldn't reload $USERS_FILE\n");
    join(' ', sort @{$RU2->usernames})
     eq join(' ', sort (@USERS, 'areallylonguser@somedomain'))
     or die("test $t: just added a user and can't find it now\n".
            'only have: '. join(' ', @{$RU2->usernames}). "\n");
} or print 'not ';
print "ok $t { verify add }\n";
print $@ if $@;