AFS
view release on metacpan or search on metacpan
* POD documentation for the module AFS::BOS
* compiles now with OpenAFS 1.4 system libraries
* improved several test drivers;
* fixed method AFS::VOS->listvolume: returns volume name when
volume id number is given
* patched function fs_getquota
* improved POD documentation for AFS::VOS
Developer-visible changes:
* all unit test drivers are now using Test::More
* modified the computing of the VERSION numbers
* added dummy function "GetUInt32"
* modified internal function set_code
Version 2.2.3 (released 17 Feb 2005, revision 679)
NOTICE:
* This release does not support AFS system libraries version 3.4 or
Version 2.04 (never released, revision 297)
User-visible changes:
* fixed function "constant"
Developer-visible changes:
* switched test drivers to Test::More
* rewrite of several test drivers
ACL.t, CM.t, Cell.t, FS.t, Utils.t
* VERSION variable now under SVN control
* fixed function AUTOLOAD
Version 2.03 (released 15 October 2002, revision 230)
User-visible changes:
src/Cell/Cell.pm
src/Cell/Makefile.PL
src/Cell/t/Cell.t
src/CM/CM.pm
src/CM/Makefile.PL
src/CM/t/CM.t
src/com_err.h
src/FS/FS.pm
src/FS/Makefile.PL
src/FS/t/FS.t
src/inc/Test/Builder.pm
src/inc/Test/More.pm
src/inc/version.pm
src/inc/version/vpp.pm
src/KAS/KAS.pm
src/KAS/Makefile.PL
src/KAS/t/KAS.t
src/KTC_EKEY/KTC_EKEY.pm
src/KTC_EKEY/Makefile.PL
src/KTC_EKEY/t/KTC_EKEY.t
src/KTC_PRINCIPAL/KTC_PRINCIPAL.pm
src/KTC_PRINCIPAL/Makefile.PL
src/ACL/t/ACL.t view on Meta::CPAN
# -*-cperl-*-
use strict;
use lib qw(../../inc ../inc);
use blib;
use Test::More;
BEGIN {
use AFS::FS;
if (AFS::FS::isafs('./')) { plan tests => 26; }
else { plan skip_all => 'Working directory is not in AFS file system ...'; }
use_ok('AFS::ACL');
}
is(AFS::ACL->ascii2rights('write'), 63, 'ascii2rights');
src/BOS/t/BOS.t view on Meta::CPAN
# -*-cperl-*-
use strict;
use lib qw(../../inc ../inc);
use blib;
use Test::More;
BEGIN {
use AFS::FS;
if (AFS::FS::isafs('./')) { plan tests => 39; }
else { plan skip_all => 'Working directory is not in AFS file system ...'; }
use_ok('AFS::BOS');
}
use AFS::VLDB;
src/CM/t/CM.t view on Meta::CPAN
# -*-cperl-*-
use strict;
use lib qw(../../inc ../inc);
use blib;
use Test::More;
BEGIN {
use AFS::FS;
if (AFS::FS::isafs('./')) { plan tests => 15; }
else { plan skip_all => 'Working directory is not in AFS file system ...'; }
use_ok('AFS::CM', qw (
checkvolumes
cm_access flush flushcb flushvolume
getcacheparms getcrypt
src/Cell/t/Cell.t view on Meta::CPAN
# -*-cperl-*-
use strict;
use lib qw(../../inc ../inc);
use blib;
use Test::More;
BEGIN {
use AFS::FS;
if (AFS::FS::isafs('./')) { plan tests => 8; }
else { plan skip_all => 'Working directory is not in AFS file system ...'; }
use_ok('AFS::Cell', qw (configdir expandcell
getcellinfo localcell
whichcell wscell
)
src/FS/t/FS.t view on Meta::CPAN
# -*-cperl-*-
use strict;
use lib qw(../../inc ../inc);
use blib;
use Test::More;
my ($quota, @hosts);
BEGIN {
use AFS::FS;
if (AFS::FS::isafs('./')) { plan tests => 9; }
else { plan skip_all => 'Working directory is not in AFS file system ...'; }
use_ok(
'AFS::FS', qw(
src/KAS/t/KAS.t view on Meta::CPAN
# -*-cperl-*-
use strict;
use lib qw(../../inc ../inc);
use blib;
use Test::More;
BEGIN {
use AFS::FS;
if (AFS::FS::isafs('./')) { plan tests => 24; }
else { plan skip_all => 'Working directory is not in AFS file system ...'; }
use_ok('AFS::KAS');
}
use AFS::KTC_TOKEN;
src/KTC_EKEY/t/KTC_EKEY.t view on Meta::CPAN
# -*-cperl-*-
use strict;
use lib qw(../../inc ../inc);
use blib;
use Test::More;
BEGIN {
use AFS::FS;
if (AFS::FS::isafs('./')) { plan tests => 5; }
else { plan tests => 4; }
use_ok('AFS::KTC_EKEY');
}
my $dkey = AFS::KTC_EKEY->des_string_to_key('abc');
src/KTC_PRINCIPAL/t/KTC_PRINCIPAL.t view on Meta::CPAN
# -*-cperl-*-
use strict;
use lib qw(../../inc ../inc);
use blib;
use Test::More tests => 6;
BEGIN {
use_ok('AFS::KTC_PRINCIPAL');
}
my $user = AFS::KTC_PRINCIPAL->new('admin');
is(ref($user), 'AFS::KTC_PRINCIPAL', 'AFS::KTC_PRINCIPAL->new()');
is($user->name(), 'admin', "princ->name");
src/KTC_TOKEN/t/KTC_TOKEN.t view on Meta::CPAN
# -*-cperl-*-
use strict;
use lib qw(../../inc ../inc);
use blib;
use Test::More;
my $has_KAS;
BEGIN {
$has_KAS = 1;
if ($has_KAS) { plan tests => 10; }
else { plan tests => 7; }
use_ok('AFS::KTC_TOKEN');
}
src/PTS/t/PTS.t view on Meta::CPAN
# -*-cperl-*-
use strict;
use lib qw(../../inc ../inc);
use blib;
use Test::More;
BEGIN {
use AFS::FS;
if (AFS::FS::isafs('./')) { plan tests => 48; }
else { plan skip_all => 'Working directory is not in AFS file system ...'; }
use_ok('AFS::PTS');
}
use AFS::Cell 'localcell';
src/Utils/t/Utils.t view on Meta::CPAN
# -*-cperl-*-
use strict;
use lib qw(../../inc ../inc);
use blib;
use Test::More;
BEGIN {
use AFS::FS;
if (AFS::FS::isafs('./')) { plan tests => 7; }
else { plan skip_all => 'Working directory is not in AFS file system ...'; }
use_ok('AFS::Utils', qw (
XSVERSION get_server_version get_syslib_version
setpag sysname unlog
)
src/VLDB/t/VLDB.t view on Meta::CPAN
# -*-cperl-*-
use strict;
use lib qw(../../inc ../inc);
use blib;
use Test::More;
BEGIN {
use AFS::FS;
if (AFS::FS::isafs('./')) { plan tests => 56; }
else { plan skip_all => 'Working directory is not in AFS file system ...'; }
use_ok('AFS::VLDB');
}
my $vldb = AFS::VLDB->new;
src/VOS/t/VOS.t view on Meta::CPAN
# -*-cperl-*-
use strict;
use lib qw(../../inc ../inc);
use blib;
use Test::More;
BEGIN {
use AFS::FS;
if (AFS::FS::isafs('./')) { plan tests => 61; }
else { plan skip_all => 'Working directory is not in AFS file system ...'; }
use_ok('AFS::VOS');
}
# vos->new(verbose=0, timeout=90, noauth=0, localauth=0, tcell=NULL, crypt=0)
src/inc/Test/Builder.pm view on Meta::CPAN
package Test::Builder;
use 5.004;
# $^C was only introduced in 5.005-ish. We do this to prevent
# use of uninitialized value warnings in older perls.
$^C ||= 0;
use strict;
use vars qw($VERSION $CLASS);
$VERSION = '0.17';
$CLASS = __PACKAGE__;
my $IsVMS = $^O eq 'VMS';
# Make Test::Builder thread-safe for ithreads.
BEGIN {
use Config;
if( $] >= 5.008 && $Config{useithreads} ) {
require threads;
require threads::shared;
threads::shared->import;
}
else {
*share = sub { 0 };
*lock = sub { 0 };
}
}
use vars qw($Level);
my($Test_Died) = 0;
my($Have_Plan) = 0;
my $Original_Pid = $$;
my $Curr_Test = 0; share($Curr_Test);
my @Test_Results = (); share(@Test_Results);
my @Test_Details = (); share(@Test_Details);
my $Test;
sub new {
my($class) = shift;
$Test ||= bless ['Move along, nothing to see here'], $class;
return $Test;
}
my $Exported_To;
sub exported_to {
my($self, $pack) = @_;
if( defined $pack ) {
$Exported_To = $pack;
}
src/inc/Test/Builder.pm view on Meta::CPAN
else {
require Carp;
my @args = grep { defined } ($cmd, $arg);
Carp::croak("plan() doesn't understand @args");
}
return 1;
}
my $Expected_Tests = 0;
sub expected_tests {
my($self, $max) = @_;
if( defined $max ) {
$Expected_Tests = $max;
$Have_Plan = 1;
$self->_print("1..$max\n") unless $self->no_header;
}
return $Expected_Tests;
}
my($No_Plan) = 0;
sub no_plan {
$No_Plan = 1;
$Have_Plan = 1;
}
sub has_plan {
return($Expected_Tests) if $Expected_Tests;
return('no_plan') if $No_Plan;
return(undef);
};
my $Skip_All = 0;
sub skip_all {
my($self, $reason) = @_;
src/inc/Test/Builder.pm view on Meta::CPAN
# $test might contain an object which we don't want to accidentally
# store, so we turn it into a boolean.
$test = $test ? 1 : 0;
unless( $Have_Plan ) {
require Carp;
Carp::croak("You tried to run a test without a plan! Gotta have a plan.");
}
lock $Curr_Test;
$Curr_Test++;
$self->diag(<<ERR) if defined $name and $name =~ /^[\d\s]+$/;
You named your test '$name'. You shouldn't use numbers for your test names.
Very confusing.
ERR
my($pack, $file, $line) = $self->caller;
my $todo = $self->todo($pack);
src/inc/Test/Builder.pm view on Meta::CPAN
unless( $test ) {
$out .= "not ";
@$result{ 'ok', 'actual_ok' } = ( ( $todo ? 1 : 0 ), 0 );
}
else {
@$result{ 'ok', 'actual_ok' } = ( 1, $test );
}
$out .= "ok";
$out .= " $Curr_Test" if $self->use_numbers;
if( defined $name ) {
$name =~ s|#|\\#|g; # # in a name can confuse Test::Harness.
$out .= " - $name";
$result->{name} = $name;
}
else {
$result->{name} = '';
}
if( $todo ) {
my $what_todo = $todo;
$out .= " # TODO $what_todo";
$result->{reason} = $what_todo;
$result->{type} = 'todo';
}
else {
$result->{reason} = '';
$result->{type} = '';
}
$Test_Results[$Curr_Test-1] = $result;
$out .= "\n";
$self->_print($out);
unless( $test ) {
my $msg = $todo ? "Failed (TODO)" : "Failed";
$self->diag(" $msg test ($file at line $line)\n");
}
return $test ? 1 : 0;
src/inc/Test/Builder.pm view on Meta::CPAN
sub skip {
my($self, $why) = @_;
$why ||= '';
unless( $Have_Plan ) {
require Carp;
Carp::croak("You tried to run tests without a plan! Gotta have a plan.");
}
lock($Curr_Test);
$Curr_Test++;
my %result;
share(%result);
%result = (
'ok' => 1,
actual_ok => 1,
name => '',
type => 'skip',
reason => $why,
);
$Test_Results[$Curr_Test-1] = \%result;
my $out = "ok";
$out .= " $Curr_Test" if $self->use_numbers;
$out .= " # skip $why\n";
$Test->_print($out);
return 1;
}
sub todo_skip {
my($self, $why) = @_;
$why ||= '';
unless( $Have_Plan ) {
require Carp;
Carp::croak("You tried to run tests without a plan! Gotta have a plan.");
}
lock($Curr_Test);
$Curr_Test++;
my %result;
share(%result);
%result = (
'ok' => 1,
actual_ok => 0,
name => '',
type => 'todo_skip',
reason => $why,
);
$Test_Results[$Curr_Test-1] = \%result;
my $out = "not ok";
$out .= " $Curr_Test" if $self->use_numbers;
$out .= " # TODO & SKIP $why\n";
$Test->_print($out);
return 1;
}
sub level {
my($self, $level) = @_;
if( defined $level ) {
src/inc/Test/Builder.pm view on Meta::CPAN
my($self, @msgs) = @_;
# Prevent printing headers when only compiling. Mostly for when
# tests are deparsed with B::Deparse
return if $^C;
local($\, $", $,) = (undef, ' ', '');
my $fh = $self->output;
# Escape each line after the first with a # so we don't
# confuse Test::Harness.
foreach (@msgs) {
s/\n(.)/\n# $1/sg;
}
push @msgs, "\n" unless $msgs[-1] =~ /\n\Z/;
print $fh @msgs;
}
src/inc/Test/Builder.pm view on Meta::CPAN
my $old_fh = select $fh;
$| = 1;
select $old_fh;
}
sub current_test {
my($self, $num) = @_;
lock($Curr_Test);
if( defined $num ) {
unless( $Have_Plan ) {
require Carp;
Carp::croak("Can't change the current test number without a plan!");
}
$Curr_Test = $num;
if( $num > @Test_Results ) {
my $start = @Test_Results ? $#Test_Results + 1 : 0;
for ($start..$num-1) {
my %result;
share(%result);
%result = ( ok => 1,
actual_ok => undef,
reason => 'incrementing test number',
type => 'unknown',
name => undef
);
$Test_Results[$_] = \%result;
}
}
}
return $Curr_Test;
}
sub summary {
my($self) = shift;
return map { $_->{'ok'} } @Test_Results;
}
sub details {
return @Test_Results;
}
sub todo {
my($self, $pack) = @_;
$pack = $pack || $self->exported_to || $self->caller(1);
no strict 'refs';
return defined ${$pack.'::TODO'} ? ${$pack.'::TODO'}
src/inc/Test/Builder.pm view on Meta::CPAN
sub caller {
my($self, $height) = @_;
$height ||= 0;
my @caller = CORE::caller($self->level + $height + 1);
return wantarray ? @caller : $caller[0];
}
sub _sanity_check {
_whoa($Curr_Test < 0, 'Says here you ran a negative number of tests!');
_whoa(!$Have_Plan and $Curr_Test,
'Somehow your tests ran without a plan!');
_whoa($Curr_Test != @Test_Results,
'Somehow you got a different number of results than tests ran!');
}
sub _whoa {
my($check, $desc) = @_;
if( $check ) {
die <<WHOA;
WHOA! $desc
This should never happen! Please contact the author immediately!
src/inc/Test/Builder.pm view on Meta::CPAN
$SIG{__DIE__} = sub {
# We don't want to muck with death in an eval, but $^S isn't
# totally reliable. 5.005_03 and 5.6.1 both do the wrong thing
# with it. Instead, we use caller. This also means it runs under
# 5.004!
my $in_eval = 0;
for( my $stack = 1; my $sub = (CORE::caller($stack))[3]; $stack++ ) {
$in_eval = 1 if $sub =~ /^\(eval\)/;
}
$Test_Died = 1 unless $in_eval;
};
sub _ending {
my $self = shift;
_sanity_check();
# Don't bother with an ending if this is a forked copy. Only the parent
# should do the ending.
do{ _my_exit($?) && return } if $Original_Pid != $$;
# Bailout if plan() was never called. This is so
# "require Test::Simple" doesn't puke.
do{ _my_exit(0) && return } if !$Have_Plan && !$Test_Died;
# Figure out if we passed or failed and print helpful messages.
if( @Test_Results ) {
# The plan? We have no plan.
if( $No_Plan ) {
$self->_print("1..$Curr_Test\n") unless $self->no_header;
$Expected_Tests = $Curr_Test;
}
# 5.8.0 threads bug. Shared arrays will not be auto-extended
# by a slice. Worse, we have to fill in every entry else
# we'll get an "Invalid value for shared scalar" error
for my $idx ($#Test_Results..$Expected_Tests-1) {
my %empty_result = ();
share(%empty_result);
$Test_Results[$idx] = \%empty_result
unless defined $Test_Results[$idx];
}
my $num_failed = grep !$_->{'ok'}, @Test_Results[0..$Expected_Tests-1];
$num_failed += abs($Expected_Tests - @Test_Results);
if( $Curr_Test < $Expected_Tests ) {
$self->diag(<<"FAIL");
Looks like you planned $Expected_Tests tests but only ran $Curr_Test.
FAIL
}
elsif( $Curr_Test > $Expected_Tests ) {
my $num_extra = $Curr_Test - $Expected_Tests;
$self->diag(<<"FAIL");
Looks like you planned $Expected_Tests tests but ran $num_extra extra.
FAIL
}
elsif ( $num_failed ) {
$self->diag(<<"FAIL");
Looks like you failed $num_failed tests of $Expected_Tests.
FAIL
}
if( $Test_Died ) {
$self->diag(<<"FAIL");
Looks like your test died just after $Curr_Test.
FAIL
_my_exit( 255 ) && return;
}
_my_exit( $num_failed <= 254 ? $num_failed : 254 ) && return;
}
elsif ( $Skip_All ) {
_my_exit( 0 ) && return;
}
elsif ( $Test_Died ) {
$self->diag(<<'FAIL');
Looks like your test died before it could output anything.
FAIL
}
else {
$self->diag("No tests run!\n");
_my_exit( 255 ) && return;
}
}
END {
$Test->_ending if defined $Test and !$Test->no_ending;
}
1;
src/inc/Test/More.pm view on Meta::CPAN
package Test::More;
use 5.004;
use strict;
use Test::Builder;
# Can't use Carp because it might cause use_ok() to accidentally succeed
# even though the module being used forgot to use Carp. Yes, this
# actually happened.
sub _carp {
my($file, $line) = (caller(1))[1,2];
warn @_, " at $file line $line\n";
}
src/inc/Test/More.pm view on Meta::CPAN
cmp_ok
skip todo todo_skip
pass fail
eq_array eq_hash eq_set
$TODO
plan
can_ok isa_ok
diag
);
my $Test = Test::Builder->new;
# 5.004's Exporter doesn't have export_to_level.
sub _export_to_level
{
my $pkg = shift;
my $level = shift;
(undef) = shift; # redundant arg
my $callpkg = caller($level);
$pkg->export($callpkg, @_);
}
sub plan {
my(@plan) = @_;
my $caller = caller;
$Test->exported_to($caller);
my @imports = ();
foreach my $idx (0..$#plan) {
if( $plan[$idx] eq 'import' ) {
my($tag, $imports) = splice @plan, $idx, 2;
@imports = @$imports;
last;
}
}
$Test->plan(@plan);
__PACKAGE__->_export_to_level(1, __PACKAGE__, @imports);
}
sub import {
my($class) = shift;
goto &plan;
}
sub ok ($;$) {
my($test, $name) = @_;
$Test->ok($test, $name);
}
sub is ($$;$) {
$Test->is_eq(@_);
}
sub isnt ($$;$) {
$Test->isnt_eq(@_);
}
*isn't = \&isnt;
sub like ($$;$) {
$Test->like(@_);
}
sub unlike {
$Test->unlike(@_);
}
sub cmp_ok($$$;$) {
$Test->cmp_ok(@_);
}
sub can_ok ($@) {
my($proto, @methods) = @_;
my $class = ref $proto || $proto;
unless( @methods ) {
my $ok = $Test->ok( 0, "$class->can(...)" );
$Test->diag(' can_ok() called with no methods');
return $ok;
}
my @nok = ();
foreach my $method (@methods) {
local($!, $@); # don't interfere with caller's $@
# eval sometimes resets $!
eval { $proto->can($method) } || push @nok, $method;
}
my $name;
$name = @methods == 1 ? "$class->can('$methods[0]')"
: "$class->can(...)";
my $ok = $Test->ok( !@nok, $name );
$Test->diag(map " $class->can('$_') failed\n", @nok);
return $ok;
}
sub isa_ok ($$;$) {
my($object, $class, $obj_name) = @_;
my $diag;
$obj_name = 'The object' unless defined $obj_name;
src/inc/Test/More.pm view on Meta::CPAN
elsif( !$rslt ) {
my $ref = ref $object;
$diag = "$obj_name isn't a '$class' it's a '$ref'";
}
}
my $ok;
if( $diag ) {
$ok = $Test->ok( 0, $name );
$Test->diag(" $diag\n");
}
else {
$ok = $Test->ok( 1, $name );
}
return $ok;
}
sub pass (;$) {
$Test->ok(1, @_);
}
sub fail (;$) {
$Test->ok(0, @_);
}
sub diag {
$Test->diag(@_);
}
sub use_ok ($;@) {
my($module, @imports) = @_;
@imports = () unless @imports;
my $pack = caller;
local($@,$!); # eval sometimes interferes with $!
eval <<USE;
package $pack;
require $module;
'$module'->import(\@imports);
USE
my $ok = $Test->ok( !$@, "use $module;" );
unless( $ok ) {
chomp $@;
$Test->diag(<<DIAGNOSTIC);
Tried to use '$module'.
Error: $@
DIAGNOSTIC
}
return $ok;
}
src/inc/Test/More.pm view on Meta::CPAN
my($module) = shift;
my $pack = caller;
local($!, $@); # eval sometimes interferes with $!
eval <<REQUIRE;
package $pack;
require $module;
REQUIRE
my $ok = $Test->ok( !$@, "require $module;" );
unless( $ok ) {
chomp $@;
$Test->diag(<<DIAGNOSTIC);
Tried to require '$module'.
Error: $@
DIAGNOSTIC
}
return $ok;
}
sub skip {
my($why, $how_many) = @_;
unless( defined $how_many ) {
# $how_many can only be avoided when no_plan is in use.
_carp "skip() needs to know \$how_many tests are in the block"
unless $Test::Builder::No_Plan;
$how_many = 1;
}
for( 1..$how_many ) {
$Test->skip($why);
}
local $^W = 0;
last SKIP;
}
sub todo_skip {
my($why, $how_many) = @_;
unless( defined $how_many ) {
# $how_many can only be avoided when no_plan is in use.
_carp "todo_skip() needs to know \$how_many tests are in the block"
unless $Test::Builder::No_Plan;
$how_many = 1;
}
for( 1..$how_many ) {
$Test->todo_skip($why);
}
local $^W = 0;
last TODO;
}
use vars qw(@Data_Stack);
my $DNE = bless [], 'Does::Not::Exist';
sub is_deeply {
my($this, $that, $name) = @_;
my $ok;
if( !ref $this || !ref $that ) {
$ok = $Test->is_eq($this, $that, $name);
}
else {
local @Data_Stack = ();
if( _deep_check($this, $that) ) {
$ok = $Test->ok(1, $name);
}
else {
$ok = $Test->ok(0, $name);
$ok = $Test->diag(_format_stack(@Data_Stack));
}
}
return $ok;
}
sub _format_stack {
my(@Stack) = @_;
my $var = '$FOO';
src/inc/Test/More.pm view on Meta::CPAN
sub eq_set {
my($a1, $a2) = @_;
return 0 unless @$a1 == @$a2;
# There's faster ways to do this, but this is easiest.
return eq_array( [sort _bogus_sort @$a1], [sort _bogus_sort @$a2] );
}
sub builder {
return Test::Builder->new;
}
1;
src/t/AFS.t view on Meta::CPAN
# -*-cperl-*-
use strict;
use lib qw(../../inc ../inc ./inc);
use blib;
use Test::More tests => 10;
BEGIN {
use_ok('AFS', qw (
error_message constant
)
);
}
sub foo { return &AFS::KA_USERAUTH_DOSETPAG }
src/t/pod.t view on Meta::CPAN
use strict;
use lib qw(../../inc ../inc ./inc);
use Test::More;
plan skip_all => "This test is only run for the module author"
unless -d '.svn' || $ENV{IS_MAINTAINER};
eval "use Test::Pod 1.00";
plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
my @poddirs = qw(../blib);
all_pod_files_ok(Test::Pod::all_pod_files(@poddirs));
( run in 0.714 second using v1.01-cache-2.11-cpan-4d50c553e7e )