# 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 $@;