AFS-Command
view release on metacpan or search on metacpan
=head1 CHanges in 1.9
=head1 Enhancements
A new argument is supported by AFS::Command::Base->new():
my $vos = AFS::Command::VOS->new( timestamps => 1 );
This will result in ISO timestamps being prepended to each line of
output when it is collected into the $vos->errors(). This is useful
for profiling the performance of operations such as vos release:
my $result = $vos->release
(
id => 'somevol',
cell => 'somecell',
) || die $vos->errors();
When this works, the $vos->errors() will have the verbose output,
which can be logged even in the successful case, for diagnostics.
Here's an example for a failure:
[2004-11-18 17:20:36] Could not lock the VLDB entry for the volume 536998569.
[2004-11-18 17:20:36] VLDB: no permission access for call
[2004-11-18 17:20:36] Error in vos release command.
[2004-11-18 17:20:36] VLDB: no permission access for call
=head1 Changes in 1.8
=head1 Bug Fixes
=head2 vos examine did not pick up the LOCKED flag
The code to parse the VLDB header was missing the LOCKED flag, if it
was present, so this attribute was not being set properly. It is now.
=head2 pts membership error checking was bogus
Well, it still is bogus, actually, since the code has to deal with the
fact that pts has never produced meaningful return codes, so a failed
pts membership command can still exit 0, and we have to figure out if
it failed by other means. This is done by looking for the known error
messages that pts prints out, which is a good example of why parsing
the ASCII test output of commands like this is a weak architecture.
=head1 Changes in 1.7
=head1 Enhancements
=head2 Boolean flags can be turned off, as well as on
If an argument to a method (and its corresponding command line
=head2 AFS::Command::BOS->status
When querying a specific instance, if it wasn't there, the API would
try to add an undefined instance object to the result, and croak.
Now, you just get a result object with no instances.
=head2 AFS::Command::FS->(several methods)
If you pass a list of paths to methods such as whichcell(), then the
error handling was a bit intrusive. The way it used to work, in 1.0,
was to return an error if we didn't see output for one or more of the
paths. Now, the code is more forgiving, and if have no idea what
happened for one of the given paths, we'll return a Path object for
that path which has a generic error.
=head2 AFS::Command::FS->lsmount
The "File 'foo' doesn't exist" error message wasn't trapped as a
recognized error. It is now.
=head2 AFS::Command::FS->sysname
The pattern matching was a bit greedy and the trailing single quote
was showing up in the returned sysname value.
=cut
Changes.html view on Meta::CPAN
<UL>
<LI><A HREF="#CHanges_in_1_9">CHanges in 1.9</A>
<LI><A HREF="#Enhancements">Enhancements</A>
<LI><A HREF="#Changes_in_1_8">Changes in 1.8</A>
<LI><A HREF="#Bug_Fixes">Bug Fixes</A>
<UL>
<LI><A HREF="#vos_examine_did_not_pick_up_the_">vos examine did not pick up the LOCKED flag</A>
<LI><A HREF="#pts_membership_error_checking_wa">pts membership error checking was bogus</A>
</UL>
<LI><A HREF="#Changes_in_1_7">Changes in 1.7</A>
<LI><A HREF="#Enhancements">Enhancements</A>
<UL>
<LI><A HREF="#Boolean_flags_can_be_turned_off_">Boolean flags can be turned off, as well as on</A>
</UL>
<LI><A HREF="#Bugs">Bugs</A>
Changes.html view on Meta::CPAN
<P>
<PRE> my $vos = AFS::Command::VOS->new( timestamps => 1 );
</PRE>
<P>
This will result in ISO timestamps being prepended to each line of output
when it is collected into the $vos->errors(). This is useful for
profiling the performance of operations such as vos release:
<P>
<PRE> my $result = $vos->release
(
id => 'somevol',
cell => 'somecell',
) || die $vos->errors();
</PRE>
<P>
When this works, the $vos->errors() will have the verbose output, which
can be logged even in the successful case, for diagnostics. Here's an
example for a failure:
<P>
<PRE> [2004-11-18 17:20:36] Could not lock the VLDB entry for the volume 536998569.
[2004-11-18 17:20:36] VLDB: no permission access for call
[2004-11-18 17:20:36] Error in vos release command.
[2004-11-18 17:20:36] VLDB: no permission access for call
Changes.html view on Meta::CPAN
</A></H2>
The code to parse the VLDB header was missing the LOCKED flag, if it was
present, so this attribute was not being set properly. It is now.
<P>
<P>
<HR>
<H2><A NAME="pts_membership_error_checking_wa">pts membership error checking was bogus
</A></H2>
Well, it still is bogus, actually, since the code has to deal with the fact
that pts has never produced meaningful return codes, so a failed pts
membership command can still exit 0, and we have to figure out if it failed
by other means. This is done by looking for the known error messages that
pts prints out, which is a good example of why parsing the ASCII test
output of commands like this is a weak architecture.
<P>
<P>
<HR>
<H1><A NAME="Changes_in_1_7">Changes in 1.7
Changes.html view on Meta::CPAN
<P>
<P>
<HR>
<H2><A NAME="AFS_Command_FS_several_metho">AFS::Command::FS->(several methods)
</A></H2>
If you pass a list of paths to methods such as <CODE>whichcell(),</CODE>
then the error handling was a bit intrusive. The way it used to work, in
1.0, was to return an error if we didn't see output for one or more of the
paths. Now, the code is more forgiving, and if have no idea what happened
for one of the given paths, we'll return a Path object for that path which
has a generic error.
<P>
<P>
<HR>
<H2><A NAME="AFS_Command_FS_lsmount">AFS::Command::FS->lsmount
</A></H2>
The ``File 'foo' doesn't exist'' error message wasn't trapped as a
recognized error. It is now.
<P>
<P>
<HR>
<H2><A NAME="AFS_Command_FS_sysname">AFS::Command::FS->sysname
</A></H2>
The pattern matching was a bit greedy and the trailing single quote was
objects. It would be nice if we could manipulate them via OO method
calls, and then pass them right back to $fs->setacl(), wouldn't it?
And how about passing the AFS::Object::Path objects returned from
$fs->whichcell directly to an $fs->listquota call, so that the final
AFS::Object::Path objects have all of the attributes returned by both
calls, but in one set of objects?
Look for this in version 1.1
=head2 stderr handling
stderr processing needs to be handled in the _exec_cmds() method, and
for that matter, _reap_cmds() needs to be folded into _exec_cmds().
The problem is that each API method calls _save_stderr(), and then
later calls _restore_stderr(), and we leave stderr redirected for
longer than necessary. The contents of the redirected output should
be *only* the output from the commands we run, and right now, some of
our own carping can creep in there.
Worse, its possible that a failure in the API can leave stderr
redirected, resulting in a lot of confusion.
Its possible we should just suck in *ALL* of the output, both
stdout/stderr, and drop that data into a couple of arrays. Then,
method calls on the command object get gets individual rows of
stdout/stderr output.
return unless $self->_exec_cmds();
#
# Process stdout
#
while ( defined($_ = $self->_stdout() ) ) {
}
#
# Process stderr (in some cases, there's interesting data in here.
# see the fs examine/diskfree and similar api calls)
#
while ( defined($_ = $self->_stderr() ) ) {
}
Maybe something like that. By the time _exec_cmds returns, we have
reaped the commands, and collected *ALL* of the output into arrays in
the object.
=head2 Test Suite: fs lsmount using multiple dirs
We should create several mount points and then query then all with one
lsmount method call, to verify we can parse output for multiple dirs.
We should pass in some bogus paths, too, to verify the error handling
is correct as well (that code feels dubious to me).
=head1 Bugs
=head2 stdout/stderr buffering will break the fs examine/diskfree commands
Actually, all of the commands that parse per-path output, really.
Currently the code assumes the stderr output will appear first, which
is a side effect of the buffering. Some attempts to turn of buffering
didn't change this, and in any case, we don't want to be sensitive to
this (we currently are).
We need to process stderr first, to determine which paths had errors,
and then parse stdout. This will require the change descibred above
for how we handle stderr.
=cut
<!-- INDEX BEGIN -->
<UL>
<LI><A HREF="#NAME">NAME</A>
<LI><A HREF="#Enhancements">Enhancements</A>
<UL>
<LI><A HREF="#Accept_AFS_Object_objects_as_ar">Accept AFS::Object objects as arguments</A>
<LI><A HREF="#stderr_handling">stderr handling</A>
<LI><A HREF="#Test_Suite_fs_lsmount_using_mul">Test Suite: fs lsmount using multiple dirs</A>
</UL>
<LI><A HREF="#Bugs">Bugs</A>
<UL>
<LI><A HREF="#stdout_stderr_buffering_will_bre">stdout/stderr buffering will break the fs examine/diskfree commands</A>
</UL>
</UL>
<!-- INDEX END -->
<HR>
<P>
<H1><A NAME="NAME">NAME
</A></H1>
<P>
Look for this in version 1.1
<P>
<P>
<HR>
<H2><A NAME="stderr_handling">stderr handling
</A></H2>
stderr processing needs to be handled in the <CODE>_exec_cmds()</CODE>
method, and for that matter, <CODE>_reap_cmds()</CODE> needs to be folded
into <CODE>_exec_cmds().</CODE>
<P>
The problem is that each API method calls <CODE>_save_stderr(),</CODE> and
then later calls <CODE>_restore_stderr(),</CODE> and we leave stderr
redirected for longer than necessary. The contents of the redirected output
should be *only* the output from the commands we run, and right now, some
of our own carping can creep in there.
<P>
Worse, its possible that a failure in the API can leave stderr redirected,
resulting in a lot of confusion.
<P>
Its possible we should just suck in *ALL* of the output, both
stdout/stderr, and drop that data into a couple of arrays. Then, method
calls on the command object get gets individual rows of stdout/stderr
output.
<P>
<PRE> return unless $self->_exec_cmds();
</PRE>
<P>
</PRE>
<P>
<PRE> }
</PRE>
<P>
<PRE> #
# Process stderr (in some cases, there's interesting data in here.
# see the fs examine/diskfree and similar api calls)
#
while ( defined($_ = $self->_stderr() ) ) {
</PRE>
<P>
<PRE> }
</PRE>
<P>
Maybe something like that. By the time _exec_cmds returns, we have reaped
<P>
<P>
<HR>
<H2><A NAME="Test_Suite_fs_lsmount_using_mul">Test Suite: fs lsmount using multiple dirs
</A></H2>
We should create several mount points and then query then all with one
lsmount method call, to verify we can parse output for multiple dirs. We
should pass in some bogus paths, too, to verify the error handling is
correct as well (that code feels dubious to me).
<P>
<P>
<HR>
<H1><A NAME="Bugs">Bugs
</A></H1>
<P>
<HR>
<H2><A NAME="stdout_stderr_buffering_will_bre">stdout/stderr buffering will break the fs examine/diskfree commands
</A></H2>
Actually, all of the commands that parse per-path output, really. Currently
the code assumes the stderr output will appear first, which is a side
effect of the buffering. Some attempts to turn of buffering didn't change
this, and in any case, we don't want to be sensitive to this (we currently
are).
<P>
We need to process stderr first, to determine which paths had errors, and
then parse stdout. This will require the change descibred above for how we
handle stderr.
<P>
</DL>
</BODY>
</HTML>
lib/AFS/Command/BOS.pm view on Meta::CPAN
my (%args) = @_;
my $result = AFS::Object::BosServer->new();
$self->{operation} = "getdate";
my $directory = $args{dir} || '/usr/afs/bin';
return unless $self->_parse_arguments(%args);
return unless $self->_save_stderr();
my $errors = 0;
$errors++ unless $self->_exec_cmds();
while ( defined($_ = $self->{handle}->getline()) ) {
chomp;
next unless m:File $directory/(\S+) dated ([^,]+),:;
my $file = AFS::Object->new
(
file => $1,
lib/AFS/Command/BOS.pm view on Meta::CPAN
}
if ( /\.OLD dated ([^,\.]+)/ ) {
$file->_setAttribute( old => $1 );
}
$result->_addFile($file);
}
$errors++ unless $self->_reap_cmds();
$errors++ unless $self->_restore_stderr();
return if $errors;
return $result;
}
sub getlog {
my $self = shift;
my (%args) = @_;
my $result = AFS::Object::BosServer->new();
lib/AFS/Command/BOS.pm view on Meta::CPAN
if ( $args{redirect} ) {
$redirectname = delete $args{redirect};
$redirect = IO::File->new(">$redirectname") || do {
$self->_Carp("Unable to write to $redirectname: $ERRNO");
return;
};
}
return unless $self->_parse_arguments(%args);
return unless $self->_save_stderr();
my $errors = 0;
$errors++ unless $self->_exec_cmds();
my $log = "";
while ( defined($_ = $self->{handle}->getline()) ) {
next if /^Fetching log file/;
if ( $redirect ) {
$redirect->print($_);
} else {
$log .= $_;
}
}
if ( $redirect ) {
$redirect->close()|| do {
$self->_Carp("Unable to close $redirectname: $ERRNO");
$errors++
};
$result->_setAttribute( log => $redirectname );
} else {
$result->_setAttribute( log => $log );
}
$errors++ unless $self->_reap_cmds();
$errors++ unless $self->_restore_stderr();
return if $errors;
return $result;
}
sub getrestart {
my $self = shift;
my (%args) = @_;
my $result = AFS::Object::BosServer->new();
$self->{operation} = "getrestart";
return unless $self->_parse_arguments(%args);
return unless $self->_save_stderr();
my $errors = 0;
$errors++ unless $self->_exec_cmds();
while ( defined($_ = $self->{handle}->getline()) ) {
if ( /restarts at (.*)/ || /restarts (never)/ ) {
$result->_setAttribute( restart => $1 );
} elsif ( /binaries at (.*)/ || /binaries (never)/ ) {
$result->_setAttribute( binaries => $1 );
}
}
$errors++ unless $self->_reap_cmds();
$errors++ unless $self->_restore_stderr();
return if $errors;
return $result;
}
sub listhosts {
my $self = shift;
my (%args) = @_;
my $result = AFS::Object::BosServer->new();
$self->{operation} = "listhosts";
return unless $self->_parse_arguments(%args);
return unless $self->_save_stderr();
my $errors = 0;
$errors++ unless $self->_exec_cmds();
my @hosts = ();
while ( defined($_ = $self->{handle}->getline()) ) {
chomp;
if ( /Cell name is (\S+)/i ) {
$result->_setAttribute( cell => $1 );
}
if ( /Host \d+ is (\S+)/i ) {
push(@hosts,$1);
}
}
$result->_setAttribute( hosts => \@hosts );
$errors++ unless $self->_reap_cmds();
$errors++ unless $self->_restore_stderr();
return if $errors;
return $result;
}
sub listkeys {
my $self = shift;
my (%args) = @_;
my $result = AFS::Object::BosServer->new();
$self->{operation} = "listkeys";
return unless $self->_parse_arguments(%args);
return unless $self->_save_stderr();
my $errors = 0;
$errors++ unless $self->_exec_cmds();
while ( defined($_ = $self->{handle}->getline()) ) {
chomp;
if ( /key (\d+)/ ) {
my $key = AFS::Object->new( index => $1 );
if ( /has cksum (\d+)/ ) {
lib/AFS/Command/BOS.pm view on Meta::CPAN
$result->_addKey($key);
}
if ( /last changed on (.*)\./ ) {
$result->_setAttribute( keyschanged => $1 );
}
}
$errors++ unless $self->_reap_cmds();
$errors++ unless $self->_restore_stderr();
return if $errors;
return $result;
}
sub listusers {
my $self = shift;
my (%args) = @_;
my $result = AFS::Object::BosServer->new();
$self->{operation} = "listusers";
return unless $self->_parse_arguments(%args);
return unless $self->_save_stderr();
my $errors = 0;
$errors++ unless $self->_exec_cmds();
while ( defined($_ = $self->{handle}->getline()) ) {
chomp;
if ( /^SUsers are: (.*)/ ) {
$result->_setAttribute( susers => [split(/\s+/,$1)] );
}
}
$errors++ unless $self->_reap_cmds();
$errors++ unless $self->_restore_stderr();
return if $errors;
return $result;
}
#
# XXX -- we might want to provide parsing of the bos salvage output,
# but for now, this is a non-parsed command.
#
# sub salvage {
# my $self = shift;
# my (%args) = @_;
# my $result = AFS::Object::BosServer->new();
# $self->{operation} = "salvage";
# return unless $self->_parse_arguments(%args);
# return unless $self->_save_stderr();
# my $errors = 0;
# $errors++ unless $self->_exec_cmds();
# while ( defined($_ = $self->{handle}->getline()) ) {
# }
# $errors++ unless $self->_reap_cmds();
# $errors++ unless $self->_restore_stderr();
# return if $errors;
# return $result;
# }
sub status {
my $self = shift;
my (%args) = @_;
my $result = AFS::Object::BosServer->new();
$self->{operation} = "status";
return unless $self->_parse_arguments(%args);
return unless $self->_save_stderr();
my $errors = 0;
$errors++ unless $self->_exec_cmds();
my $instance = undef;
while ( defined($_ = $self->{handle}->getline()) ) {
chomp;
if ( /inappropriate access/ ) {
$result->_setAttribute( access => 1 );
next;
lib/AFS/Command/BOS.pm view on Meta::CPAN
# strings varies.
#
if ( /\(type is (\S+)\)/ ) {
$instance->_setAttribute( type => $1 );
}
if ( /(disabled|temporarily disabled|temporarily enabled),/ ) {
$instance->_setAttribute( state => $1 );
}
if ( /stopped for too many errors/ ) {
$instance->_setAttribute( errorstop => 1 );
}
if ( /has core file/ ) {
$instance->_setAttribute( core => 1 );
}
if ( /currently (.*)\.$/ ) {
$instance->_setAttribute( status => $1 );
}
lib/AFS/Command/BOS.pm view on Meta::CPAN
(
startdate => $1,
startcount => $2,
);
}
if ( /Last exit at (.*)/ ) {
$instance->_setAttribute( exitdate => $1 );
}
if ( /Last error exit at ([^,]+),/ ) {
$instance->_setAttribute( errorexitdate => $1 );
if ( /due to shutdown request/ ) {
$instance->_setAttribute( errorexitdue => 'shutdown' );
}
if ( /due to signal (\d+)/ ) {
$instance->_setAttribute
(
errorexitdue => 'signal',
errorexitsignal => $1,
);
}
if ( /by exiting with code (\d+)/ ) {
$instance->_setAttribute
(
errorexitdue => 'code',
errorexitcode => $1,
);
}
}
if ( /Command\s+(\d+)\s+is\s+\'(.*)\'/ ) {
my $command = AFS::Object->new
(
index => $1,
command => $2,
lib/AFS/Command/BOS.pm view on Meta::CPAN
if ( /Notifier\s+is\s+\'(.*)\'/ ) {
$instance->_setAttribute( notifier => $1 );
}
}
if ( defined $instance ) {
$result->_addInstance($instance);
}
$errors++ unless $self->_reap_cmds();
$errors++ unless $self->_restore_stderr();
return if $errors;
return $result;
}
1;
lib/AFS/Command/BOS.pod view on Meta::CPAN
=head1 METHODS -- Inherited
All of the following methods are inherited from the AFS::Command::Base
class. See that documentation for details.
=over
=item new
=item errors
=item supportsOperation
=item supportsArgument
=back
=head1 METHODS (with complex return values)
=head2 getdate
lib/AFS/Command/BOS.pod view on Meta::CPAN
=item Return Values
This method returns an AFS::Object::BosServer object, which
contains one or more generic AFS::Object, one for each file
specified in the arguments.
my $result = $bos->getdate
(
file => [ 'bosserver', 'vlserver', 'ptserver' ],
cell => $cell,
) || die $bos->errors();
foreach my $fileobj ( $result->getFiles() ) {
my ($file,$date) = ($fileobj->file(),$fileobj->date());
print "File $file has date $date\n";
}
Each of these objects has the following attributes and methods:
B<AFS::Object::BosServer>
lib/AFS/Command/BOS.pod view on Meta::CPAN
=item Return Values
This method returns an AFS::Object::BosServer object, which
contains one attribute.
my $result = $bos->getlog
(
server => $server,
file => "/usr/afs/logs/VolserLog",
redirect => "/var/tmp/VolserLog.$$",
) || die $bos->errors();
my $logfile = IO::File->new("</var/tmp/VolserLog.$$") ||
die "Unable to open logfile: $ERRNO\n";
while ( defined($_ = $logfile->getline()) ) {
....
}
# Alternately, the memory pig way:
lib/AFS/Command/BOS.pod view on Meta::CPAN
=item Return Values
This method returns an AFS::Object::BosServer object, which
contains two attributes.
my $result = $bos->getrestart
(
server => $server,
cell => $cell,
) || die $bos->errors();
print "Binary restart time is " . $result->binaries() . "\n";
print "Server restart time is " . $result->restart() . "\n";
The object has the following attributes:
B<AFS::Object::BosServer>
Attributes Values
---------- ------
restart The server restart time
lib/AFS/Command/BOS.pod view on Meta::CPAN
=item Return Values
This method returns an AFS::Object::BosServer object, which
contains one attribute.
my $result = $bos->listhosts
(
server => $server,
cell => $cell,
) || die $bos->errors();
my $hosts = $result->hosts();
print "Server $server in cell $cell has hosts:\n"
foreach my $host ( @$hosts ) {
print "\t$host\n";
}
The object has the following attributes:
B<AFS::Object::BosServer>
lib/AFS/Command/BOS.pod view on Meta::CPAN
=item Return Values
This method returns an AFS::Object::BosServer object, which
contains one or more AFS::Object objects, each of which
represents a single authentication key on the server.
my $result = $bos->listkeys
(
server => $server,
cell => $cell,
) || die $bos->errors();
print "Server $server in cell $cell has the following keys:\n";
foreach my $key ( $result->getKeys() ) {
my ($index,$cksum) = ($key->index(),$key->cksum());
print "\t$index => $cksum\n";
}
my $result = $bos->listkeys
(
server => $server,
cell => $cell,
showkey => 1,
) || die $bos->errors();
print "Server $server in cell $cell has the following keys:\n";
foreach my $key ( $result->getKeys() ) {
my ($index,$value) = ($key->index(),$key->value());
print "\t$index => $cksum\n";
}
The objects have the following attributes and methods:
B<AFS::Object::BosServer>
lib/AFS/Command/BOS.pod view on Meta::CPAN
=item Return Values
This method returns an AFS::Object::BosServer object, which
contains one attribute.
my $result = $bos->listusers
(
server => $server,
cell => $cell,
) || die $bos->errors();
my $users = $result->susers();
print "Server $server in cell $cell has users:\n"
foreach my $user ( @$users ) {
print "\t$user\n";
}
The object has the following attribute:
B<AFS::Object::BosServer>
lib/AFS/Command/BOS.pod view on Meta::CPAN
This method returns an AFS::Object::BosServer object, which
contains one optional attribute, and one or more
AFS::Object::Instance objects, each of which represents a
single instance of a bosserver managed process on the server.
my $result = $bos->status
(
server => $server,
long => 1,
) || die $bos->errors();
foreach my $instanceobj ( $result->getInstances() ) {
my $instance = $instanceobj->instance();
my $status = $instanceobj->status();
print "Instance $instance has status $status\n";
foreach my $commandobj ( $instance->getCommands() ) {
my $index = $commandobj->index();
my $command = $commandobj->command();
print "\tCmd $index is '$command'\n";
}
}
lib/AFS/Command/BOS.pod view on Meta::CPAN
since the bosserver was started
exitdate Date when the process last exited
The following attributes are optionally available, depending on the
state of the instance, when the 'long' argument is specified:
Attributes Values
---------- ------
notifier Path to the notifier application for this instance
state "temporarily disabled", or "disabled", or "temporarily enabled"
errorstop Boolean, indicating the process was
"stopped for too many errors"
core Boolean, indicating the instance has a core file
errorexitdate Date when the process last exited with an error
errorexitdue "shutdown", or "signal", or "code" (present only when
"errorexitdate" attribute is present)
errorexitsignal Signal that cause the error exit (present only when
"errorexitdue" eq "signal")
errorexitcode Exit code from last error exit (present only when
"errorexitdue" eq "code")
The following methods can be used to extract the command objects,
which are also only present when the 'long' argument is specified.
Methods Returns
------- -------
getCommandIndexes() list of numeric indexes for the commands
getCommands() list of AFS::Object objects for all commands
getCommand($index) the AFS::Object object for the command with index $index
lib/AFS/Command/Base.pm view on Meta::CPAN
} else {
@{$self->{command}} = lc((split(/::/,$class))[2]);
}
bless $self, $class;
return $self;
}
sub errors {
my $self = shift;
return $self->{errors};
}
sub supportsOperation {
my $self = shift;
my $operation = shift;
return $self->_operations($operation);
}
sub supportsArgument {
my $self = shift;
lib/AFS/Command/Base.pm view on Meta::CPAN
my $pid = fork();
unless ( defined $pid ) {
$self->_Carp("Unable to fork: $ERRNO\n");
return;
}
if ( $pid == 0 ) {
STDERR->fdopen( STDOUT->fileno(), "w" ) ||
$self->_Croak("Unable to redirect stderr: $ERRNO\n");
STDOUT->fdopen( $pipe->writer()->fileno(), "w" ) ||
$self->_Croak("Unable to redirect stdout: $ERRNO\n");
if ( $type eq 'default' ) {
exec @{$self->{command}}, 'help';
} else {
exec @{$self->{command}}, 'offline', '-help';
}
die "Unable to exec @{$self->{command}} help: $ERRNO\n";
lib/AFS/Command/Base.pm view on Meta::CPAN
return $self->{_arguments}->{$operation}
if ref $self->{_arguments}->{$operation} eq 'HASH';
my $pipe = IO::Pipe->new() || do {
$self->_Carp("Unable to create pipe: $ERRNO");
return;
};
my $pid = fork();
my $errors = 0;
unless ( defined $pid ) {
$self->_Carp("Unable to fork: $ERRNO");
return;
}
if ( $pid == 0 ) {
STDERR->fdopen( STDOUT->fileno(), "w" ) ||
die "Unable to redirect stderr: $ERRNO\n";
STDOUT->fdopen( $pipe->writer()->fileno(), "w" ) ||
die "Unable to redirect stdout: $ERRNO\n";
exec @command, $operation, '-help';
die "Unable to exec @command help $operation: $ERRNO\n";
} else {
$pipe->reader();
while ( <$pipe> ) {
if ( /Unrecognized operation '$operation'/ ) {
$self->_Carp("Unsupported @command operation '$operation'\n");
$errors++;
last;
}
next unless s/^Usage:.*\s+$operation\s+//;
while ( $_ ) {
if ( s/^\[\s*-(\w+?)\s*\]\s*// ) {
$arguments->{optional}->{$1} = 0
unless $1 eq 'help'; # Yeah, skip it...
} elsif ( s/^\[\s*-(\w+?)\s+<[^>]*?>\+\s*]\s*// ) {
lib/AFS/Command/Base.pm view on Meta::CPAN
$arguments->{optional}->{$1} = 1;
} elsif ( s/^\s*-(\w+?)\s+<[^>]*?>\+\s*// ) {
$arguments->{required}->{$1} = [];
} elsif ( s/^\s*-(\w+?)\s+<[^>]*?>\s*// ) {
$arguments->{required}->{$1} = 1;
} elsif ( s/^\s*-(\w+?)\s*// ) {
$arguments->{required}->{$1} = 0;
} else {
$self->_Carp("Unable to parse @command help for $operation\n" .
"Unrecognized string: '$_'");
$errors++;
last;
}
}
last;
}
}
lib/AFS/Command/Base.pm view on Meta::CPAN
if ( $self->isa("AFS::Command::VOS") && $operation eq 'release' ) {
if ( exists $arguments->{optional}->{f} ) {
$arguments->{aliases}->{force} = 'f';
} elsif ( exists $arguments->{optional}->{force} ) {
$arguments->{aliases}->{f} = 'force';
}
}
unless ( waitpid($pid,0) ) {
$self->_Carp("Unable to get status of child process ($pid)");
$errors++;
}
if ( $? ) {
$self->_Carp("Error running @command $operation -help. Unable to configure @command $operation");
$errors++;
}
return if $errors;
return $self->{_arguments}->{$operation} = $arguments;
}
sub _save_stderr {
my $self = shift;
$self->{olderr} = IO::File->new(">&STDERR") || do {
$self->_Carp("Unable to dup stderr: $ERRNO");
return;
};
my $command = basename((split /\s+/,@{$self->{command}})[0]);
$self->{tmpfile} = "/tmp/.$command.$self->{operation}.$$";
my $newerr = IO::File->new(">$self->{tmpfile}") || do {
$self->_Carp("Unable to open $self->{tmpfile}: $ERRNO");
return;
};
STDERR->fdopen( $newerr->fileno(), "w" ) || do {
$self->_Carp("Unable to reopen stderr: $ERRNO");
return;
};
$newerr->close() || do {
$self->_Carp("Unable to close $self->{tmpfile}: $ERRNO");
return;
};
return 1;
}
sub _restore_stderr {
my $self = shift;
STDERR->fdopen( $self->{olderr}->fileno(), "w") || do {
$self->_Carp("Unable to restore stderr: $ERRNO");
return;
};
$self->{olderr}->close() || do {
$self->_Carp("Unable to close saved stderr: $ERRNO");
return;
};
delete $self->{olderr};
my $newerr = IO::File->new($self->{tmpfile}) || do {
$self->_Carp("Unable to reopen $self->{tmpfile}: $ERRNO");
return;
};
$self->{errors} = "";
while ( <$newerr> ) {
$self->{errors} .= $_;
}
$newerr->close() || do {
$self->_Carp("Unable to close $self->{tmpfile}: $ERRNO");
return;
};
unlink($self->{tmpfile}) || do {
$self->_Carp("Unable to unlink $self->{tmpfile}: $ERRNO");
return;
};
delete $self->{tmpfile};
lib/AFS/Command/Base.pm view on Meta::CPAN
my $class = ref($self);
my (%args) = @_;
my $arguments = $self->_arguments($self->{operation});
unless ( defined $arguments ) {
$self->_Carp("Unable to obtain arguments for $class->$self->{operation}");
return;
}
$self->{errors} = "";
$self->{cmds} = [];
if ( $args{inputfile} ) {
push( @{$self->{cmds}}, [ 'cat', $args{inputfile} ] );
} else {
my @argv = ( @{$self->{command}}, $self->{operation} );
lib/AFS/Command/Base.pm view on Meta::CPAN
exists $args{stdout} && $args{stdout} ne 'stdout' ) {
my $stdout = IO::File->new(">$args{stdout}") ||
$self->_Croak("Unable to open $args{stdout}: $ERRNO");
STDOUT->fdopen( $stdout->fileno(), "w" ) ||
$self->_Croak("Unable to redirect stdout: $ERRNO");
} else {
STDOUT->fdopen( $pipe->writer()->fileno(), "w" ) ||
$self->_Croak("Unable to redirect stdout: $ERRNO");
}
if ( exists $args{stderr} && $args{stderr} eq 'stdout' ) {
STDERR->fdopen( STDOUT->fileno(), "w" ) ||
$self->_Croak("Unable to redirect stderr: $ERRNO");
}
if ( $index == 0 ) {
if ( exists $args{stdin} && $args{stdin} ne 'stdin' ) {
my $stdin = IO::File->new("<$args{stdin}") ||
$self->_Croak("Unable to open $args{stdin}: $ERRNO");
STDIN->fdopen( $stdin->fileno(), "r" ) ||
$self->_Croak("Unable to redirect stdin: $ERRNO");
}
} else {
lib/AFS/Command/Base.pm view on Meta::CPAN
}
return 1;
}
sub _parse_output {
my $self = shift;
$self->{errors} = "";
while ( defined($_ = $self->{handle}->getline()) ) {
$self->{errors} .= time2str("[%Y-%m-%d %H:%M:%S] ",time,'GMT') if $self->{timestamps};
$self->{errors} .= $_;
}
return 1;
}
sub _reap_cmds {
my $self = shift;
my (%args) = @_;
my $errors = 0;
$self->{handle}->close() || do {
$self->_Carp("Unable to close pipe handle: $ERRNO");
$errors++;
};
delete $self->{handle};
delete $self->{cmds};
$self->{status} = {};
my %allowstatus = ();
if ( $args{allowstatus} ) {
if ( ref $args{allowstatus} eq 'ARRAY' ) {
lib/AFS/Command/Base.pm view on Meta::CPAN
foreach my $pid ( keys %{$self->{pids}} ) {
$self->{status}->{$pid}->{cmd} =
join(' ', @{delete $self->{pids}->{$pid}} );
if ( waitpid($pid,0) ) {
$self->{status}->{$pid}->{status} = $?;
if ( $? ) {
if ( %allowstatus ) {
$errors++ unless $allowstatus{$? >> 8};
} else {
$errors++;
}
}
} else {
$self->{status}->{$pid}->{status} = undef;
$errors++;
}
}
return if $errors;
return 1;
}
sub AUTOLOAD {
my $self = shift;
my (%args) = @_;
$self->{operation} = $AUTOLOAD;
$self->{operation} =~ s/.*:://;
return unless $self->_parse_arguments(%args);
return unless $self->_exec_cmds( stderr => 'stdout' );
my $errors = 0;
$errors++ unless $self->_parse_output();
$errors++ unless $self->_reap_cmds();
return if $errors;
return 1;
}
sub DESTROY {}
1;
lib/AFS/Command/Base.pod view on Meta::CPAN
AFS, and may be unsupported by the underlying commands.
XXX: What should the default behavior be? Croak or carp? we can
figure out dynamically if the command supports it, and have the
constructor fail, or we can be lazy and let the first command fail.
=item quiet
The default behavior for the common -verbose flag is inverted. By
default, all commands are run with the -verbose flag, in order to
capture maximum diagnostics when an error occurs. Normally, the
chatty output is all trapped by the API anyway, so there is no
application visible noise, just more verbose errors.
There should be no need to disable verbosity, but for completeness,
specifying 'quiet' will turn off the default verbose output.
=item timestamps
If this argument is given, then the output collected from the commands
will be prepended with the date formatted using Date::Format with:
%Y/%m/%d %H:%M:%S
lib/AFS/Command/Base.pod view on Meta::CPAN
release, restore, etc. Commands that return complex structures of
objects, such as listvldb, listvol, etc will not be affected.
=back
=head2 setCarp
This class method configures the carp and/or croak subroutines used
throughout the API. By default, the obviously sensible thing is done:
the carp an croak subroutines exported by the Carp module are used.
These normally print output to stderr, and this method provides a
mechanism for trapping these errors and redirecting them elsewhere.
For example, stderr in a system daemon may be entirely ignored, and
syslog may be a more appropriate destination. In this case, the
setCarp method may be used to configure this, globally, for the entire
API.
AFS::Command->setCarp
(
carp => sub {
my ($lines) = @_;
foreach my $line ( split(/\n+/,$lines) ) {
syslog('warning',$line);
}
},
croak => sub {
my ($lines) = @_;
foreach my $line ( split(/\n+/,$lines) ) {
syslog('error',$line);
}
die $lines; # If we're dying, whine at stderr, too.
},
);
This method takes a list of key/value pairs, with only two supported
keys (anything else will be quietly ignored): carp an croak. The
values are CODE references (anonymous subroutines, or references to
existing subroutines). The carp CODE should not be fatal, however the
croak CODE should. The API calls the croak method in very few places,
but when it does, it assumes that call will be fatal, so if you
provide a croak subroutine that doesn't die, the results will be
unpredictable, and unsupportable.
This method returns true of false, depending on whether or not the
carp and/or croak subroutines were properly configured. If the values
are not CODE references, then this method will itself croak.
=head1 INSTANCE METHODS
=head2 errors
This method takes no arguments, and it returns a string, containing the
unparsed errors from the last command method invoked. This string is
reset with each subsequent command method invocation. The string is
normally the output written to stderr by the process, but in the case
of unparsed boolean commands, it contains both the stdout as well as
the stderr output.
my $result = $vos->examine
(
id => $volname,
cell => $cell,
);
unless ( $result ) {
die "Unable to examine volname '$volname' in cell '$cell':" .
$vos->errors();
}
=head2 supportsOperation
This class method allows the developer to test whether or not any
given operation is supported by the underlying command line utility.
For example, the "vos changeloc" operation is not supported in older
release of vos.
unless ( $vos->supportsOperation('changeloc') {
lib/AFS/Command/FS.pm view on Meta::CPAN
my $self = shift;
my (%args) = @_;
my $result = AFS::Object::CacheManager->new();
$self->{operation} = "checkservers";
return unless $self->_parse_arguments(%args);
return unless $self->_save_stderr();
my $errors = 0;
$errors++ unless $self->_exec_cmds();
my @servers = ();
while ( defined($_ = $self->{handle}->getline()) ) {
chomp;
if ( /The current down server probe interval is (\d+) secs/ ) {
$result->_setAttribute( interval => $1 );
}
lib/AFS/Command/FS.pm view on Meta::CPAN
while ( defined($_ = $self->{handle}->getline()) ) {
s/^\s+//g;
s/\s+$//g;
push(@servers,$_);
}
}
}
$result->_setAttribute( servers => \@servers );
$errors++ unless $self->_reap_cmds();
$errors++ unless $self->_restore_stderr();
return if $errors;
return $result;
}
sub diskfree {
my $self = shift;
return $self->_paths_method('diskfree',@_);
}
sub examine {
lib/AFS/Command/FS.pm view on Meta::CPAN
my (%args) = @_;
my $result = AFS::Object::CacheManager->new();
$self->{operation} = $operation;
my $pathkey = $operation eq 'storebehind' ? 'files' : 'path';
return unless $self->_parse_arguments(%args);
my $errors = 0;
$errors++ unless $self->_exec_cmds( stderr => 'stdout' );
my @paths = ref $args{$pathkey} eq 'ARRAY' ? @{$args{$pathkey}} : ($args{$pathkey});
my %paths = map { $_ => 1 } @paths;
my $default = undef; # Used by storebehind
while ( defined($_ = $self->{handle}->getline()) ) {
next if /^Volume Name/;
my $path = AFS::Object::Path->new();
if ( /fs: Invalid argument; it is possible that (.*) is not in AFS./ ||
/fs: no such cell as \'(.*)\'/ ||
/fs: File \'(.*)\' doesn\'t exist/ ||
/fs: You don\'t have the required access rights on \'(.*)\'/ ) {
$path->_setAttribute
(
path => $1,
error => $_,
);
delete $paths{$1};
@paths = grep($_ ne $1,@paths);
} else {
if ( $operation eq 'listacl' ) {
if ( /^Access list for (.*) is/ ) {
lib/AFS/Command/FS.pm view on Meta::CPAN
$path->_setAttribute( asynchrony => $default );
}
}
}
foreach my $pathname ( keys %paths ) {
my $path = AFS::Object::Path->new
(
path => $pathname,
error => "Unable to determine results",
);
$result->_addPath($path);
}
$errors++ unless $self->_reap_cmds( allowstatus => 1 );
return if $errors;
return $result;
}
sub exportafs {
my $self = shift;
my (%args) = @_;
my $result = AFS::Object->new();
$self->{operation} = "exportafs";
return unless $self->_parse_arguments(%args);
return unless $self->_save_stderr();
my $errors = 0;
$errors++ unless $self->_exec_cmds();
while ( defined($_ = $self->{handle}->getline()) ) {
/translator is (currently )?enabled/ && do {
$result->_setAttribute( enabled => 1 );
};
/translator is disabled/ && do {
$result->_setAttribute( enabled => 0 );
};
lib/AFS/Command/FS.pm view on Meta::CPAN
/allow mounts/i && do {
$result->_setAttribute( submounts => 1 );
};
/Only mounts/i && do {
$result->_setAttribute( submounts => 0 );
};
}
$errors++ unless $self->_reap_cmds();
$errors++ unless $self->_restore_stderr();
return if $errors;
return $result;
}
sub getcacheparms {
my $self = shift;
my (%args) = @_;
my $result = AFS::Object::CacheManager->new();
$self->{operation} = "getcacheparms";
return unless $self->_parse_arguments(%args);
return unless $self->_save_stderr();
my $errors = 0;
$errors++ unless $self->_exec_cmds();
while ( defined($_ = $self->{handle}->getline()) ) {
if ( /using (\d+) of the cache.s available (\d+) 1K/ ) {
$result->_setAttribute
(
used => $1,
avail => $2,
);
}
}
$errors++ unless $self->_reap_cmds();
$errors++ unless $self->_restore_stderr();
return if $errors;
return $result;
}
sub getcellstatus {
my $self = shift;
my (%args) = @_;
my $result = AFS::Object::CacheManager->new();
$self->{operation} = "getcellstatus";
return unless $self->_parse_arguments(%args);
return unless $self->_save_stderr();
my $errors = 0;
$errors++ unless $self->_exec_cmds();
while ( defined($_ = $self->{handle}->getline()) ) {
if ( /Cell (\S+) status: (no )?setuid allowed/ ) {
my $cell = AFS::Object::Cell->new
(
cell => $1,
status => $2 ? 0 : 1,
);
$result->_addCell($cell);
}
}
$errors++ unless $self->_reap_cmds();
$errors++ unless $self->_restore_stderr();
return if $errors;
return $result;
}
sub getclientaddrs {
my $self = shift;
my (%args) = @_;
my $result = AFS::Object::CacheManager->new();
$self->{operation} = "getclientaddrs";
return unless $self->_parse_arguments(%args);
return unless $self->_save_stderr();
my $errors = 0;
$errors++ unless $self->_exec_cmds();
my @addresses = ();
while ( defined($_ = $self->{handle}->getline()) ) {
chomp;
s/^\s+//;
s/\s+$//;
push(@addresses,$_);
}
$result->_setAttribute( addresses => \@addresses );
$errors++ unless $self->_reap_cmds();
$errors++ unless $self->_restore_stderr();
return if $errors;
return $result;
}
sub getcrypt {
my $self = shift;
my (%args) = @_;
my $result = AFS::Object::CacheManager->new();
$self->{operation} = "getcrypt";
return unless $self->_parse_arguments(%args);
return unless $self->_save_stderr();
my $errors = 0;
$errors++ unless $self->_exec_cmds();
while ( defined($_ = $self->{handle}->getline()) ) {
if ( /Security level is currently (crypt|clear)/ ) {
$result->_setAttribute( crypt => ($1 eq 'crypt' ? 1 : 0) );
}
}
$errors++ unless $self->_reap_cmds();
$errors++ unless $self->_restore_stderr();
return if $errors;
return $result;
}
sub getserverprefs {
my $self = shift;
my (%args) = @_;
my $result = AFS::Object::CacheManager->new();
$self->{operation} = "getserverprefs";
return unless $self->_parse_arguments(%args);
return unless $self->_save_stderr();
my $errors = 0;
$errors++ unless $self->_exec_cmds();
while ( defined($_ = $self->{handle}->getline()) ) {
s/^\s+//g;
s/\s+$//g;
my ($name,$preference) = split;
my $server = AFS::Object::Server->new
(
server => $name,
preference => $preference,
);
$result->_addServer($server);
}
$errors++ unless $self->_reap_cmds();
$errors++ unless $self->_restore_stderr();
return if $errors;
return $result;
}
sub listaliases {
my $self = shift;
my (%args) = @_;
my $result = AFS::Object::CacheManager->new();
$self->{operation} = "listaliases";
return unless $self->_parse_arguments(%args);
return unless $self->_save_stderr();
my $errors = 0;
$errors++ unless $self->_exec_cmds();
while ( defined($_ = $self->{handle}->getline()) ) {
if ( /Alias (.*) for cell (.*)/ ) {
my $cell = AFS::Object::Cell->new
(
cell => $2,
alias => $1,
);
$result->_addCell($cell);
}
}
$errors++ unless $self->_reap_cmds();
$errors++ unless $self->_restore_stderr();
return if $errors;
return $result;
}
sub listcells {
my $self = shift;
my (%args) = @_;
my $result = AFS::Object::CacheManager->new();
$self->{operation} = "listcells";
return unless $self->_parse_arguments(%args);
return unless $self->_save_stderr();
my $errors = 0;
$errors++ unless $self->_exec_cmds();
while ( defined($_ = $self->{handle}->getline()) ) {
if ( /^Cell (\S+) on hosts (.*)\.$/ ) {
my $cell = AFS::Object::Cell->new
(
cell => $1,
servers => [split(/\s+/,$2)],
);
$result->_addCell($cell);
}
}
$errors++ unless $self->_reap_cmds();
$errors++ unless $self->_restore_stderr();
return if $errors;
return $result;
}
sub lsmount {
my $self = shift;
my (%args) = @_;
my $result = AFS::Object::CacheManager->new();
$self->{operation} = "lsmount";
return unless $self->_parse_arguments(%args);
my $errors = 0;
$errors++ unless $self->_exec_cmds( stderr => 'stdout' );
my @dirs = ref $args{dir} eq 'ARRAY' ? @{$args{dir}} : ($args{dir});
my %dirs = map { $_ => 1 } @dirs;
while ( defined($_ = $self->{handle}->getline()) ) {
my $current = shift @dirs;
delete $dirs{$current};
my $path = AFS::Object::Path->new( path => $current );
if ( /fs: Can.t read target name/ ) {
$path->_setAttribute( error => $_ );
} elsif ( /fs: File '.*' doesn't exist/ ) {
$path->_setAttribute( error => $_ );
} elsif ( /fs: you may not use \'.\'/ ) {
$_ .= $self->{handle}->getline();
$path->_setAttribute( error => $_ );
} elsif ( /\'(.*?)\' is not a mount point/ ) {
$path->_setAttribute( error => $_ );
} elsif ( /^\'(.*?)\'.*?\'(.*?)\'$/ ) {
my ($dir,$mount) = ($1,$2);
$path->_setAttribute( symlink => 1 ) if /symbolic link/;
$path->_setAttribute( readwrite => 1 ) if $mount =~ /^%/;
$mount =~ s/^(%|\#)//;
my ($volname,$cell) = reverse split(/:/,$mount);
$path->_setAttribute( volname => $volname );
$path->_setAttribute( cell => $cell) if $cell;
} else {
$self->_Carp("fs lsmount: Unrecognized output: '$_'");
$errors++;
next;
}
$result->_addPath($path);
}
foreach my $dir ( keys %dirs ) {
my $path = AFS::Object::Path->new
(
path => $dir,
error => "Unable to determine results",
);
$result->_addPath($path);
}
$errors++ unless $self->_reap_cmds( allowstatus => 1 );
return if $errors;
return $result;
}
#
# This is deprecated in newer versions of OpenAFS
#
sub monitor {
my $self = shift;
$self->_Carp("fs monitor: This operation is deprecated and no longer supported");
lib/AFS/Command/FS.pm view on Meta::CPAN
my $self = shift;
my (%args) = @_;
my $result = AFS::Object::CacheManager->new();
$self->{operation} = "sysname";
return unless $self->_parse_arguments(%args);
return unless $self->_save_stderr();
my $errors = 0;
$errors++ unless $self->_exec_cmds();
my @sysname = ();
while ( defined($_ = $self->{handle}->getline()) ) {
if ( /Current sysname is \'?([^\']+)\'?/ ) {
$result->_setAttribute( sysname => $1 );
} elsif ( s/Current sysname list is // ) {
while ( s/\'([^\']+)\'\s*// ) {
push(@sysname,$1);
}
$result->_setAttribute( sysnames => \@sysname );
$result->_setAttribute( sysname => $sysname[0] );
}
}
$errors++ unless $self->_reap_cmds();
$errors++ unless $self->_restore_stderr();
return if $errors;
return $result;
}
sub wscell {
my $self = shift;
my (%args) = @_;
my $result = AFS::Object::CacheManager->new();
$self->{operation} = "wscell";
return unless $self->_parse_arguments(%args);
return unless $self->_save_stderr();
my $errors = 0;
$errors++ unless $self->_exec_cmds();
while ( defined($_ = $self->{handle}->getline()) ) {
next unless /belongs to cell\s+\'(.*)\'/;
$result->_setAttribute( cell => $1 );
}
$errors++ unless $self->_reap_cmds();
$errors++ unless $self->_restore_stderr();
return if $errors;
return $result;
}
1;
lib/AFS/Command/FS.pod view on Meta::CPAN
=head1 METHODS -- Inherited
All of the following methods are inherited from the AFS::Command::Base
class. See that documentation for details.
=over
=item new
=item errors
=item supportsOperation
=item supportsArgument
=back
=head1 METHODS (with complex return values)
=head2 NOTE: Error checking for commands that accept a list of paths
A number of these methods accept a list of paths, and will return
information for each path, individually. If you specify a
non-existent path, or one which is not in AFS, then the fs command
returns a non-zero exist status, which normally would mean the command
failed.
If you specify a list of paths to this API, and one or more of them
result in errors, the API call is still considered to succeed, as long
as we can determine the error for each path specified. The API will
still return an AFS::Object::CacheManager object, which contains a set
of AFS::Object::Path object, for each path specified in the arguments,
as long as we saw some kind of output from the fs commands for each
path.
Each AFS::Object::Path object must be examined to determine the
success of failure for that individual path. When errors were
encountered for any given path, then the objects will have an "error"
attribute, and nothing else (no other data attributes, except the path
itself).
This holds true for the following API methods: diskfree, examine,
listquota, quota, storebehind, whereis, whichcell, and listacl.
=head2 checkservers
=over
lib/AFS/Command/FS.pod view on Meta::CPAN
interval => $interval,
all => 1,
fast => 1,
);
=item Return Values
This method returns an AFS::Object::CacheManager object, which
contains one or more attributes.
my $result = $fs->checkservers() || die $fs->errors();
my @servers = $result->servers();
foreach my $server ( @servers ) {
print "Server $server appears to be down\n";
}
The object has the following attributes:
Attributes Values
---------- ------
servers ARRAY reference of strings, each of which is
lib/AFS/Command/FS.pod view on Meta::CPAN
=item Return Values
This method returns an AFS::Object::CacheManager object, which
contains one or more AFS::Object::Path objects, one for each path
specified in the arguments.
my $result = $fs->diskfree
(
path => [ $afspath, $ufspath, $boguspath ],
) || die $fs->errors();
foreach my $pathobj ( $result->getPaths() ) {
my $path = $pathobj->path();
if ( $pathobj->hasAttribute('error') ) {
print "Path '$path' has errors '" . $pathobj->error() . "'\n";
} else {
foreach my $attr ( qw( volname used total avail percent ) ) {
print "Path '$path' has '$attr' of '" . $pathobj->$attr() . "'\n";
}
}
}
Each of these objects has the following attributes and methods:
B<AFS::Object::CacheManager>
Methods Returns
------- -------
getPathNames() list of strings, each of which is a single pathname
getPaths() list of AFS::Object::Path objects, one for each path
getPath($pathname) a single AFS::Object::Path object, for the pathname $pathname
B<AFS::Object::Path>
If errors were encountered for any given path, then its object will
have the following attributes:
Attributes Values
---------- ------
path The pathname
error The error string for that path
If no errors were encountered, then the following attributes will be present:
Attributes Values
---------- ------
path The pathname
volname The AFS volume name that contains the pathname
total The size (in KB) of the partition that contains 'volname'
used The amount of space (in KB) used on that partition
avail The amount of space (in KB) available on that partition
percent The amount of space used, as a percentage
lib/AFS/Command/FS.pod view on Meta::CPAN
=item Return Values
This method returns an AFS::Object::CacheManager object, which
contains one or more AFS::Object::Path objects, one for each path
specified in the arguments.
my $result = $fs->examine
(
path => [ $afspath, $ufspath, $boguspath ],
) || die $fs->errors();
foreach my $pathobj ( $result->getPaths() ) {
my $path = $pathobj->path();
if ( $pathobj->hasAttribute('error') ) {
print "Path '$path' has errors '" . $pathobj->error() . "'\n";
} else {
foreach my $attr ( qw( id volname quota used avail total ) ) {
print "Path '$path' has '$attr' of '" . $pathobj->$attr() . "'\n";
}
}
}
Each of these objects has the following attributes and methods:
B<AFS::Object::CacheManager>
Methods Returns
------- -------
getPathNames() list of strings, each of which is a single pathname
getPaths() list of AFS::Object::Path objects, one for each path
getPath($pathname) a single AFS::Object::Path object, for the pathname $pathname
B<AFS::Object::Path>
If errors were encountered for any given path, then its object will
have the following attributes:
Attributes Values
---------- ------
path The pathname
error The error string for that path
If no errors were encountered, then the following attributes will be present:
Attributes Values
---------- ------
path The pathname
volname The AFS volume name that contains the pathname
id The numerical volume ID of the above volume
total The size (in KB) of the partition that contains 'volname'
used The amount of space (in KB) used on that partition
avail The amount of space (in KB) available on that partition
quota The quota of the volume (in KB), or 0 if set to "unlimited"
lib/AFS/Command/FS.pod view on Meta::CPAN
=item Return Values
This method returns an AFS::Object::CacheManager object with one or
more attributes.
my $result = $fs->exportafs
(
type => 'nfs',
start => 'on',
) || die $fs->errors();
foreach my $attr ( qw( convert uidcheck submounts ) ) {
print "Translator has '$attr' set to '" . $result->$attr() . "'\n";
}
The object has the following attribute:
B<AFS::Object::CacheManager>
Attributes Values
---------- ------
lib/AFS/Command/FS.pod view on Meta::CPAN
The corresponding method invocation looks like:
my $result = $fs->getcacheparms();
=item Return Values
This method returns an AFS::Object::CacheManager object with one or
more attributes.
my $result = $fs->getcacheparms() || die $fs->errors();
my $used = $result->used();
my $avail = $result->avail();
print "Cache is using $used KB of $availa KB available\n";
The object has the following attributes:
B<AFS::Object::CacheManager>
Attributes Values
---------- ------
lib/AFS/Command/FS.pod view on Meta::CPAN
);
=item Return Values
This method returns an AFS::Object::CacheManager object which contains
one or more AFS::Object::Cell objects.
my $result = $fs->getcellstatus
(
cell => [ $cell1 , $cell2 ],
) || die $fs->errors();
foreach my $cellobj ( $result->getCells() ) {
my $cell = $cellobj->cell();
if ( $cellobj->status() ) {
print("This client allows setuid binaries from cell '$cell'\n";
} else {
print("This client does NOT allow setuid binaries from cell '$cell'\n";
}
}
The objects have the following attributes and methods:
lib/AFS/Command/FS.pod view on Meta::CPAN
Usage: fs getclientaddrs
The corresponding method invocation looks like:
my $result = $fs->getclientaddrs();
=item Return Values
This method returns an AFS::Object::CacheManager object with one attribute.
my $result = $fs->getclientaddrs() || die $fs->errors();
print "This client has the following addressed configured for AFS:\n";
foreach my $address ( @{$result->addresses()} ) {
print "\t$address\n";
}
The object has the following attribute:
B<AFS::Object::CacheManager>
Attributes Values
lib/AFS/Command/FS.pod view on Meta::CPAN
Usage: fs getcrypt
The corresponding method invocation looks like:
my $result = $fs->getcrypt();
=item Return Values
This method returns an AFS::Object::CacheManager object with one attribute.
my $result = $fs->getcrypt() || die $fs->errors();
print "This client has encryption turned " . ( $result->crypt() ? "on" : "off" ) . "\n";
The object has the following attribute:
B<AFS::Object::CacheManager>
Attributes Values
---------- ------
crypt Boolean, indicating whether or not encryption is enabled
lib/AFS/Command/FS.pod view on Meta::CPAN
file => $file,
numeric => 1,
vlservers => 1,
);
=item Return Values
This method returns an AFS::Object::CacheManager object which contains
one or more AFS::Object::Server objects.
my $result = $fs->getserverprefs() || die $fs->errors();
foreach my $serverobj ( $result->getServers() ) {
my $server = $serverobj->server();
my $pref = $serverobj->preference();
print "Server '$server' has preference '$preference'\n";
}
The objects have the following attributes and methods:
B<AFS::Object::CacheManager>
lib/AFS/Command/FS.pod view on Meta::CPAN
This method returns an AFS::Object::CacheManager object, which
contains one or more AFS::Object::Path objects, one for each path
specified in the arguments. Each AFS::Object::Path object contains
one or two AFS::Object::ACL objects (one for normal, and one for
negative).
my $result = $fs->listacl
(
path => [ $afspath, $ufspath, $boguspath ],
) || die $fs->errors();
foreach my $pathobj ( $result->getPaths() ) {
my $path = $pathobj->path();
if ( $pathobj->hasAttribute('error') ) {
print "Path '$path' has errors '" . $pathobj->error() . "'\n";
} else {
foreach my $type ( qw( normal negative ) ) {
my $acl = $pathobj->getACL($type);
my %entries = $acl->getEntries();
foreach my $principal ( keys %entries ) {
my $rights = $acl->getRights($principal);
print "$type rights for $principal are $rights\n";
}
}
}
lib/AFS/Command/FS.pod view on Meta::CPAN
The corresponding method invocation looks like:
my $result = $fs->listaliases();
=item Return Values
This method returns an AFS::Object::CacheManager object, which
contains one or more AFS::Object::Cell objects.
my $result = $fs->listaliases() || die $fs->errors();
foreach my $cellobj ( $result->getCells() ) {
my $cell = $cellobj->cell();
my $alias = $cellobj->alias();
print "Cell '$cell' has alias '$alias'\n";
}
The objects have the following attributes and methods:
B<AFS::Object::CacheManager>
lib/AFS/Command/FS.pod view on Meta::CPAN
(
# Optional arguments
numeric => 1,
);
=item Return Values
This method returns an AFS::Object::CacheManager object, which
contains one or more AFS::Object::Cell objects.
my $result = $fs->listcells() || die $fs->errors();
foreach my $cellobj ( $result->getCells() ) {
my $servers = $cellobj->servers();
print "Cell $cell has servers " . join(" ",@$servers) . "\n";
}
The objects have the following attributes and methods:
B<AFS::Object::CacheManager>
Methods Returns
lib/AFS/Command/FS.pod view on Meta::CPAN
=back
This method returns an AFS::Object::CacheManager object, which
contains one or more AFS::Object::Path objects, one for each path
specified in the arguments.
my $result = $fs->listquota
(
path => [ $afspath, $ufspath, $boguspath ],
) || die $fs->errors();
foreach my $pathobj ( $result->getPaths() ) {
my $path = $pathobj->path();
if ( $pathobj->hasAttribute('error') ) {
print "Path '$path' has errors '" . $pathobj->error() . "'\n";
} else {
foreach my $attr ( qw( volname quota used percent partition ) ) {
print "Path '$path' has '$attr' of '" . $pathobj->$attr() . "'\n";
}
}
}
Each of these objects has the following attributes and methods:
B<AFS::Object::CacheManager>
Methods Returns
------- -------
getPathNames() list of strings, each of which is a single pathname
getPaths() list of AFS::Object::Path objects, one for each path
getPath($pathname) a single AFS::Object::Path object, for the pathname $pathname
B<AFS::Object::Path>
If errors were encountered for any given path, then its object will
have the following attributes:
Attributes Values
---------- ------
path The pathname
error The error string for that path
If no errors were encountered, then the following attributes will be present:
Attributes Values
---------- ------
path The pathname
volname The AFS volume name that contains the pathname
quota Volume quota, in KB
used The amount of space (in KB) used in that volume
percent The percentage of the allocated quota in use
partition The percentage of space used on the partition where the volume resides
lib/AFS/Command/FS.pod view on Meta::CPAN
=item Return Values
This method returns an AFS::Object::CacheManager object, which
contains one or more AFS::Object::Path objects, one for each path
specified in the arguments.
my $result = $fs->lsmount
(
dir => [ $dir1, $dir2 ],
) || die $fs->errors();
foreach my $pathobj ( $result->getPaths() ) {
my $path = $pathobj->path();
if ( $pathobj->hasAttribute('error') ) {
print "Path '$path' has errors '" . $pathobj->error() . "'\n";
} else {
my $volname = $pathobj->volname();
my $cell = $pathobj->cell();
print("Path '$path' is a mtpt for volume $volname" .
( $cell ? ", in cell '$cell'\n" : "\n" ));
}
}
Each of these objects has the following attributes and methods:
B<AFS::Object::CacheManager>
Methods Returns
------- -------
getPathNames() list of strings, each of which is a single pathname
getPaths() list of AFS::Object::Path objects, one for each path
getPath($pathname) a single AFS::Object::Path object, for the pathname $pathname
B<AFS::Object::Path>
If errors were encountered for any given path, then its object will
have the following attributes:
Attributes Values
---------- ------
path The pathname
error The error string for that path
If no errors were encountered, then the following attributes will
always be present:
Attributes Values
---------- ------
path The pathname
volname AFS volname in the mount point
The following attributes may or may not be present:
Attributes Values
lib/AFS/Command/FS.pod view on Meta::CPAN
=item Return Values
This method returns an AFS::Object::CacheManager object, which
contains one or more AFS::Object::Path objects, one for each path
specified in the arguments.
my $result = $fs->quota
(
path => [ $afspath, $ufspath, $boguspath ],
) || die $fs->errors();
foreach my $pathobj ( $result->getPaths() ) {
my $path = $pathobj->path();
if ( $pathobj->hasAttribute('error') ) {
print "Path '$path' has errors '" . $pathobj->error() . "'\n";
} else {
print "Path '$path' has quota '" . $pathobj->quota() . "'\n";
}
}
Each of these objects has the following attributes and methods:
B<AFS::Object::CacheManager>
Methods Returns
------- -------
getPathNames() list of strings, each of which is a single pathname
getPaths() list of AFS::Object::Path objects, one for each path
getPath($pathname) a single AFS::Object::Path object, for the pathname $pathname
B<AFS::Object::Path>
If errors were encountered for any given path, then its object will
have the following attributes:
Attributes Values
---------- ------
path The pathname
error The error string for that path
If no errors were encountered, then the following attributes will be present:
Attributes Values
---------- ------
path The pathname
quota The percentage of the allocated quota in use
=back
=head2 storebehind
lib/AFS/Command/FS.pod view on Meta::CPAN
=item Return Values
This method returns an AFS::Object::CacheManager object, which
contains one or more AFS::Object::Path objects, one for each path
specified in the arguments.
my $result = $fs->quota
(
path => [ $afspath, $ufspath, $boguspath ],
) || die $fs->errors();
foreach my $pathobj ( $result->getPaths() ) {
my $path = $pathobj->path();
if ( $pathobj->hasAttribute('error') ) {
print "Path '$path' has errors '" . $pathobj->error() . "'\n";
} else {
foreach my $attr ( qw( volname quota used percent partition ) ) {
print "Path '$path' has '$attr' of '" . $pathobj->$attr() . "'\n";
}
}
}
Each of these objects has the following attributes and methods:
B<AFS::Object::CacheManager>
lib/AFS/Command/FS.pod view on Meta::CPAN
asynchrony Default value (in KB) of asynchronous writes
Methods Returns
------- -------
getPathNames() list of strings, each of which is a single pathname
getPaths() list of AFS::Object::Path objects, one for each path
getPath($pathname) a single AFS::Object::Path object, for the pathname $pathname
B<AFS::Object::Path>
If errors were encountered for any given path, then its object will
have the following attributes:
Attributes Values
---------- ------
path The pathname
error The error string for that path
If no errors were encountered, then the following attributes will be present:
Attributes Values
---------- ------
path The pathname
asynchrony The number of KB of asynchronous writes for this file
=back
=head2 sysname
lib/AFS/Command/FS.pod view on Meta::CPAN
(
# Optional arguments
newsys => $sysname, # OR [ $sysname1, $sysname2, ... ]
);
=item Return Values
This method returns an AFS::Object::CacheManager object which has one
of two possible attributes.
my $result = $fs->sysname() || die $fs->errors();
my $sysname = $result->sysname();
my $sysnames = $result->sysnames();
print "This client has a primary sysname of '$sysname'\n";
if ( ref $sysnames eq 'ARRAY' ) {
print "This client has a list of sysnames: " . join(" ,",@$sysnames) . "\n";
}
The object has the following attributes:
B<AFS::Object::CacheManager>
lib/AFS/Command/FS.pod view on Meta::CPAN
=item Return Values
This method returns an AFS::Object::CacheManager object, which
contains one or more AFS::Object::Path objects, one for each path
specified in the arguments.
my $result = $fs->whereis
(
path => [ $afspath, $ufspath, $boguspath ],
) || die $fs->errors();
foreach my $pathobj ( $result->getPaths() ) {
my $path = $pathobj->path();
if ( $pathobj->hasAttribute('error') ) {
print "Path '$path' has errors '" . $pathobj->error() . "'\n";
} else {
print "Path '$path' is on hosts " . join(" ,",@{pathobj->hosts()}) . "\n";
}
}
Each of these objects has the following attributes and methods:
B<AFS::Object::CacheManager>
Methods Returns
------- -------
getPathNames() list of strings, each of which is a single pathname
getPaths() list of AFS::Object::Path objects, one for each path
getPath($pathname) a single AFS::Object::Path object, for the pathname $pathname
B<AFS::Object::Path>
If errors were encountered for any given path, then its object will
have the following attributes:
Attributes Values
---------- ------
path The pathname
error The error string for that path
If no errors were encountered, then the following attributes will be present:
Attributes Values
---------- ------
path The pathname
hosts An ARRAY reference of hostnames
=back
=head2 whichcell
lib/AFS/Command/FS.pod view on Meta::CPAN
=item Return Values
This method returns an AFS::Object::CacheManager object, which
contains one or more AFS::Object::Path objects, one for each path
specified in the arguments.
my $result = $fs->whichcell
(
path => [ $afspath, $ufspath, $boguspath ],
) || die $fs->errors();
foreach my $pathobj ( $result->getPaths() ) {
my $path = $pathobj->path();
if ( $pathobj->hasAttribute('error') ) {
print "Path '$path' has errors '" . $pathobj->error() . "'\n";
} else {
print "Path '$path' is in cell '" . $pathobj->cell() . "'\n";
}
}
Each of these objects has the following attributes and methods:
B<AFS::Object::CacheManager>
Methods Returns
------- -------
getPathNames() list of strings, each of which is a single pathname
getPaths() list of AFS::Object::Path objects, one for each path
getPath($pathname) a single AFS::Object::Path object, for the pathname $pathname
B<AFS::Object::Path>
If errors were encountered for any given path, then its object will
have the following attributes:
Attributes Values
---------- ------
path The pathname
error The error string for that path
If no errors were encountered, then the following attributes will be present:
Attributes Values
---------- ------
path The pathname
cell Cell in which the pathname lives
=back
=head2 wscell
lib/AFS/Command/FS.pod view on Meta::CPAN
The corresponding method invocation looks like:
my $result = $fs->wscell();
=item Return Values
This method returns an AFS::Object::CacheManager object which has one
attribute.
my $result = $fs->wscell() || die $fs->errors();
print "This client lives in cell '" . $result->cell() . "'\n";
The object has the following attribute:
Attributes Values
---------- ------
cell The AFS cell of the client
=back
lib/AFS/Command/PTS.pm view on Meta::CPAN
my $self = shift;
my (%args) = @_;
my $result = AFS::Object::PTServer->new();
$self->{operation} = "creategroup";
return unless $self->_parse_arguments(%args);
return unless $self->_save_stderr();
my $errors = 0;
$errors++ unless $self->_exec_cmds();
while ( defined($_ = $self->{handle}->getline()) ) {
next unless /group (\S+) has id (-\d+)/;
my $group = AFS::Object::Group->new
(
name => $1,
id => $2,
);
$result->_addGroup($group);
}
$errors++ unless $self->_reap_cmds();
$errors++ unless $self->_restore_stderr();
return if $errors;
return $result;
}
sub createuser {
my $self = shift;
my (%args) = @_;
my $result = AFS::Object::PTServer->new();
$self->{operation} = "createuser";
return unless $self->_parse_arguments(%args);
return unless $self->_save_stderr();
my $errors = 0;
$errors++ unless $self->_exec_cmds();
while ( defined($_ = $self->{handle}->getline()) ) {
next unless /User (\S+) has id (\d+)/;
my $user = AFS::Object::User->new
(
name => $1,
id => $2,
);
$result->_addUser($user);
}
$errors++ unless $self->_reap_cmds();
$errors++ unless $self->_restore_stderr();
return if $errors;
return $result;
}
sub examine {
my $self = shift;
my (%args) = @_;
my $result = AFS::Object::PTServer->new();
$self->{operation} = "examine";
return unless $self->_parse_arguments(%args);
return unless $self->_save_stderr();
my $errors = 0;
$errors++ unless $self->_exec_cmds();
while ( defined($_ = $self->{handle}->getline()) ) {
chomp;
while ( /,\s*$/ ) {
$_ .= $self->{handle}->getline();
chomp;
}
lib/AFS/Command/PTS.pm view on Meta::CPAN
$key =~ tr/A-Z/a-z/;
$key =~ s/\s+//g; # group quota -> groupquota
$value =~ s/\.$//;
$data{$key} = $value;
}
unless ( $data{id} ) {
$self->_Carp("pts examine: Unrecognized output: '$_'");
$errors++;
next;
}
if ( $data{id} > 0 ) {
$result->_addUser( AFS::Object::User->new(%data) );
} else {
$result->_addGroup( AFS::Object::Group->new(%data) );
}
}
$errors++ unless $self->_reap_cmds();
$errors++ unless $self->_restore_stderr();
return if $errors;
return $result;
}
sub listentries {
my $self = shift;
my (%args) = @_;
my $result = AFS::Object::PTServer->new();
$self->{operation} = "listentries";
return unless $self->_parse_arguments(%args);
return unless $self->_save_stderr();
my $errors = 0;
$errors++ unless $self->_exec_cmds();
while ( defined($_ = $self->{handle}->getline()) ) {
next if /^Name/;
my ($name,$id,$owner,$creator) = split;
#
# We seem to be getting this one bogus line of data, with no
# name, and 0's for the IDs. Probably a bug in pts...
lib/AFS/Command/PTS.pm view on Meta::CPAN
name => $name,
id => $id,
owner => $owner,
creator => $creator,
);
$result->_addGroup($group);
}
}
$errors++ unless $self->_reap_cmds();
$errors++ unless $self->_restore_stderr();
return if $errors;
return $result;
}
sub listmax {
my $self = shift;
my (%args) = @_;
my $result = AFS::Object::PTServer->new();
$self->{operation} = "listmax";
return unless $self->_parse_arguments(%args);
return unless $self->_save_stderr();
my $errors = 0;
$errors++ unless $self->_exec_cmds();
while ( defined($_ = $self->{handle}->getline()) ) {
next unless /Max user id is (\d+) and max group id is (-\d+)/;
$result->_setAttribute
(
maxuserid => $1,
maxgroupid => $2,
);
}
$errors++ unless $self->_reap_cmds();
$errors++ unless $self->_restore_stderr();
return if $errors;
return $result;
}
sub listowned {
my $self = shift;
my (%args) = @_;
my $result = AFS::Object::PTServer->new();
$self->{operation} = "listowned";
return unless $self->_parse_arguments(%args);
my $errors = 0;
$errors++ unless $self->_exec_cmds( stderr => 'stdout' );
my $user = undef;
my $group = undef;
while ( defined($_ = $self->{handle}->getline()) ) {
if ( /Groups owned by (\S+) \(id: (-?\d+)\)/ ) {
$result->_addUser($user) if $user;
$result->_addGroup($group) if $group;
lib/AFS/Command/PTS.pm view on Meta::CPAN
$group->_addOwned($2);
}
} elsif ( /unable to get owner list/ ) {
#
# pts still (as of OpenAFS 1.2.8) doesn't have proper exit codes.
# If we see this string, then let the command fail, even
# though we might have partial data.
#
$self->{errors} .= $_;
$errors++;
}
}
$result->_addUser($user) if $user;
$result->_addGroup($group) if $group;
$errors++ unless $self->_reap_cmds();
return if $errors;
return $result;
}
sub membership {
my $self = shift;
my (%args) = @_;
my $result = AFS::Object::PTServer->new();
$self->{operation} = "membership";
return unless $self->_parse_arguments(%args);
my $errors = 0;
$errors++ unless $self->_exec_cmds( stderr => 'stdout' );
my $user = undef;
my $group = undef;
while ( defined($_ = $self->{handle}->getline()) ) {
if ( /(\S+) \(id: (-?\d+)\)/ ) {
$result->_addUser($user) if $user;
$result->_addGroup($group) if $group;
lib/AFS/Command/PTS.pm view on Meta::CPAN
} elsif ( /unable to get membership/ ||
/User or group doesn't exist/ ||
/membership list for id \d+ exceeds display limit/ ) {
#
# pts still (as of OpenAFS 1.2.8) doesn't have proper exit codes.
# If we see this string, then let the command fail, even
# though we might have partial data.
#
$self->{errors} .= $_;
$errors++;
}
}
$result->_addUser($user) if $user;
$result->_addGroup($group) if $group;
$errors++ unless $self->_reap_cmds();
return if $errors;
return $result;
}
1;
lib/AFS/Command/PTS.pod view on Meta::CPAN
=head1 METHODS -- Inherited
All of the following methods are inherited from the AFS::Command::Base
class. See that documentation for details.
=over
=item new
=item errors
=item supportsOperation
=item supportsArgument
=back
=head1 METHODS (with complex return values)
=head2 creategroup
lib/AFS/Command/PTS.pod view on Meta::CPAN
=item Return Values
This method returns an AFS::Object::PTServer object, which
contains one AFS::Object::Group for each group created.
my $result = $pts->creategroup
(
name => $name,
owner => $owner,
) || die $pts->errors();
foreach my $group ( $result->getGroups() ) {
my ($grname,$grid) = ($group->name(),$group->id());
print "New group $grname has id $grid\n";
}
Each of these objects has the following attributes and methods:
B<AFS::Object::PTServer>
Methods Returns
lib/AFS/Command/PTS.pod view on Meta::CPAN
=item Return Values
This method returns an AFS::Object::PTServer object, which
contains one AFS::Object::User for each user created.
my $result = $pts->createuser
(
name => $name,
owner => $owner,
) || die $pts->errors();
foreach my $user ( $result->getUsers() ) {
my ($username,$userid) = ($user->name(),$user->id());
print "New user $username has id $userid\n";
}
Each of these objects has the following attributes and methods:
B<AFS::Object::PTServer>
Methods Returns
lib/AFS/Command/PTS.pod view on Meta::CPAN
=item Return Values
This method returns an AFS::Object::PTServer object, which
contains one AFS::Object::User or AFS::Object::Group
object for each user/group examined.
my $result = $pts->examine
(
nameorid => [ $name1, $name2 ],
cell => 1,
) || die $pts->errors();
foreach my $userobj ( $result->getUser() ) {
my ($name,$id) = ($userobj->name(),$userobj->id());
print "User $name has id $id\n";
}
foreach my $groupobj ( $result->getGroups() ) {
my ($name,$id) = ($groupobj->name(),$groupobj->id());
print "Group $name has id $id\n";
}
Each of these objects has the following attributes and methods:
lib/AFS/Command/PTS.pod view on Meta::CPAN
This method returns an AFS::Object::PTServer object, which
contains one AFS::Object::User or AFS::Object::Group
object for each user/group listed.
my $result = $pts->listentries
(
users => 1,
groups => 1,
cell => $cell,
) || die $pts->errors();
# Starting to see a pattern? The result is parsed in almost the
# same way as shown for examine
Each of these objects has the following attributes and methods:
B<AFS::Object::PTServer>
Methods Returns
------- -------
getGroupNames() list of group names
lib/AFS/Command/PTS.pod view on Meta::CPAN
);
=item Return Values
This method returns an AFS::Object::PTServer object, which
contains two attributes:
my $result = $pts->listmax
(
cell => $cell,
) || die $pts->errors();
print "Maximum group ID is " . $result->maxgroupid() . "\n";
print "Maximum user ID is " . $result->maxuserid() . "\n";
This object has the following attributes, which are always present:
Attributes Values
---------- ------
maxgroupid Numeric value of the highest group ID
maxuserid Numeric value of the highest user ID
lib/AFS/Command/PTS.pod view on Meta::CPAN
=item Return Values
This method returns an AFS::Object::PTServer object, which
contains one AFS::Object::User or AFS::Object::Group
object for each user/group specified.
my $result = $pts->listowned
(
nameorid => $user,
cell => $cell,
) || die $pts->errors();
my $userobj = $result->getUserbyName($user);
print "User $user owns the following groups:\n";
foreach my $owned ( $userobj->getOwned() ) {
print "\t$owned\n";
}
Each of these objects has the following attributes and methods:
B<AFS::Object::PTServer>
lib/AFS/Command/PTS.pod view on Meta::CPAN
=item Return Values
This method returns an AFS::Object::PTServer object, which
contains one AFS::Object::User or AFS::Object::Group
object for each user/group specified.
my $result = $pts->membership
(
nameorid => $user,
cell => $cell,
) || die $pts->errors();
my $userobj = $result->getUserbyName($user);
print "User $user is a member of these groups:\n";
foreach my $group ( $userobj->getMembership() ) {
print "\t$group\n";
}
Each of these objects has the following attributes and methods:
B<AFS::Object::PTServer>
lib/AFS/Command/VOS.pm view on Meta::CPAN
my $self = shift;
my (%args) = @_;
my $result = AFS::Object::Volume->new();
my $entry = AFS::Object::VLDBEntry->new( locked => 0 );
$self->{operation} = "examine";
return unless $self->_parse_arguments(%args);
return unless $self->_save_stderr();
my $errors = 0;
$errors++ unless $self->_exec_cmds();
while ( defined($_ = $self->{handle}->getline()) ) {
chomp;
#
# These two lines are part of the verbose output
#
next if /Fetching VLDB entry/;
next if /Getting volume listing/;
lib/AFS/Command/VOS.pm view on Meta::CPAN
# leading the VLDB entry stanza.
#
if ( /^(\S+)/ ) {
$entry->_setAttribute( name => $1 );
}
}
$result->_addVLDBEntry($entry);
$errors++ unless $self->_reap_cmds();
$errors++ unless $self->_restore_stderr();
return if $errors;
return $result;
}
sub listaddrs {
my $self = shift;
my (%args) = @_;
my @result = ();
$self->{operation} = "listaddrs";
return unless $self->_parse_arguments(%args);
return unless $self->_save_stderr();
my $errors = 0;
$errors++ unless $self->_exec_cmds();
if ( $args{printuuid} ) {
while ( defined($_ = $self->{handle}->getline()) ) {
chomp;
if ( /^UUID:\s+(\S+)/ ) {
my $fileserver = AFS::Object::FileServer->new( uuid => $1 );
lib/AFS/Command/VOS.pm view on Meta::CPAN
s/\s*$//g;
if ( /^\d+\.\d+\.\d+\.\d+$/ ) {
push(@result,AFS::Object::FileServer->new( addresses => [$_] ));
} else {
push(@result,AFS::Object::FileServer->new( hostname => $_ ));
}
}
}
$errors++ unless $self->_reap_cmds();
$errors++ unless $self->_restore_stderr();
return if $errors;
return @result;
}
sub listpart {
my $self = shift;
my (%args) = @_;
my $result = AFS::Object::FileServer->new();
$self->{operation} = "listpart";
return unless $self->_parse_arguments(%args);
return unless $self->_save_stderr();
my $errors = 0;
$errors++ unless $self->_exec_cmds();
while ( defined($_ = $self->{handle}->getline()) ) {
chomp;
next unless m:/vice:;
s/^\s+//g;
s/\s+$//g;
foreach my $partname ( split ) {
my $partition = AFS::Object::Partition->new( partition => $partname );
$result->_addPartition($partition);
}
}
$errors++ unless $self->_reap_cmds();
$errors++ unless $self->_restore_stderr();
return if $errors;
return $result;
}
sub listvldb {
my $self = shift;
my (%args) = @_;
$self->{operation} = "listvldb";
my $locked = 0;
my $result = AFS::Object::VLDB->new();
return unless $self->_parse_arguments(%args);
return unless $self->_save_stderr();
my $errors = 0;
$errors++ unless $self->_exec_cmds();
while ( defined($_ = $self->{handle}->getline()) ) {
chomp;
next if /^\s*$/; # If it starts with a blank line, then
# its not a volume name.
#
# Skip the introductory lines of the form:
# "VLDB entries for all servers"
lib/AFS/Command/VOS.pm view on Meta::CPAN
}
}
$result->_addVLDBEntry( $entry );
}
$result->_setAttribute( locked => $locked );
$errors++ unless $self->_reap_cmds();
$errors++ unless $self->_restore_stderr();
return if $errors;
return $result;
}
sub listvol {
my $self = shift;
my (%args) = @_;
my $result = AFS::Object::VolServer->new();
$self->{operation} = "listvol";
return unless $self->_parse_arguments(%args);
return unless $self->_save_stderr();
my $errors = 0;
$errors++ unless $self->_exec_cmds();
if ( delete $args{extended} ) {
$self->_Carp("vos listvol: -extended is not supported by this version of the API");
}
while ( defined($_ = $self->{handle}->getline()) ) {
chomp;
next if /^\s*$/; # Blank lines are not interesting
lib/AFS/Command/VOS.pm view on Meta::CPAN
);
} elsif ( @array == 1 ) {
$volume->_setAttribute
(
id => $_,
status => 'online',
attached => 1,
);
} else {
$self->_Carp("Unable to parse header summary line:\n" . $_);
$errors++;
next;
}
#
# If the output is long, then we have some more
# interesting information to parse. See vos/examine.pl
# for notes. This code was stolen from there...
#
if ( $args{long} || $args{extended} ) {
lib/AFS/Command/VOS.pm view on Meta::CPAN
}
$partition->_addVolumeHeader($volume);
}
$result->_addPartition($partition);
}
$errors++ unless $self->_reap_cmds();
$errors++ unless $self->_restore_stderr();
return if $errors;
return $result;
}
sub partinfo {
my $self = shift;
my (%args) = @_;
my $result = AFS::Object::FileServer->new();
$self->{operation} = "partinfo";
return unless $self->_parse_arguments(%args);
return unless $self->_save_stderr();
my $errors = 0;
$errors++ unless $self->_exec_cmds();
while ( defined($_ = $self->{handle}->getline()) ) {
next unless m|partition (/vice\w+): (-?\d+)\D+(\d+)$|;
my $partition = AFS::Object::Partition->new
(
partition => $1,
available => $2,
total => $3,
);
$result->_addPartition($partition);
}
$errors++ unless $self->_reap_cmds();
$errors++ unless $self->_restore_stderr();
return if $errors;
return $result;
}
sub status {
my $self = shift;
my (%args) = @_;
my $result = AFS::Object::VolServer->new();
$self->{operation} = "status";
return unless $self->_parse_arguments(%args);
return unless $self->_save_stderr();
my $errors = 0;
$errors++ unless $self->_exec_cmds();
my $transaction = undef;
while ( defined($_ = $self->{handle}->getline()) ) {
chomp;
if ( /No active transactions/ ) {
$result->_setAttribute( transactions => 0 );
last;
lib/AFS/Command/VOS.pm view on Meta::CPAN
if ( /packetSend:\s+(\d+)/ ) {
$transaction->_setAttribute( packetSend => $1 );
}
if ( /lastSendTime:\s+(\d+)/ ) {
$transaction->_setAttribute( lastSendTime => $1 );
}
}
$errors++ unless $self->_reap_cmds();
$errors++ unless $self->_restore_stderr();
return if $errors;
return $result;
}
sub dump {
my $self = shift;
my (%args) = @_;
$self->{operation} = 'dump';
lib/AFS/Command/VOS.pm view on Meta::CPAN
}
};
if ( $gzip ) {
push( @{$self->{cmds}}, [ 'gzip', "-$gzip", '-c' ] );
} elsif ( $bzip2 ) {
push( @{$self->{cmds}}, [ 'bzip2', "-$bzip2", '-c' ] );
}
return unless $self->_save_stderr();
my $errors = 0;
$errors++ unless $self->_exec_cmds
(
stdout => ( $args{file} ? "/dev/null" : $file ),
);
$errors++ unless $self->_reap_cmds();
$errors++ unless $self->_restore_stderr();
return if $errors;
return 1;
}
sub restore {
my $self = shift;
my (%args) = @_;
$self->{operation} = "restore";
lib/AFS/Command/VOS.pm view on Meta::CPAN
}
};
if ( $gunzip ) {
unshift( @{$self->{cmds}}, [ 'gunzip', '-c' ] );
} elsif ( $bunzip2 ) {
unshift( @{$self->{cmds}}, [ 'bunzip2', '-c' ] );
}
my $errors = 0;
$errors++ unless $self->_exec_cmds
(
stderr => 'stdout',
stdin => ( $args{file} ? "/dev/null" : $file ),
);
$errors++ unless $self->_parse_output();
$errors++ unless $self->_reap_cmds();
return if $errors;
return 1;
}
1;
lib/AFS/Command/VOS.pod view on Meta::CPAN
=head1 METHODS -- Inherited
All of the following methods are inherited from the AFS::Command::Base
class. See that documentation for details.
=over
=item new
=item errors
=item supportsOperation
=item supportsArgument
=back
=head1 METHODS (dump, restore)
Both the 'dump' and 'restore' methods are special, since this API
lib/AFS/Command/VOS.pod view on Meta::CPAN
This method returns an AFS::Object::Volume object, which in
turn contains one or more AFS::Object::VolumeHeader objects,
as well as an AFS::Object::VLDBEntry, which contains one or
more AFS::Object::VLDBSite objects.
my $result = $vos->examine
(
id => $volname,
cell => $cell,
) || die $vos->errors();
foreach my $header ( $result->getVolumeHeaders() ) {
my ($server,$partition) = ($header->server(),$header->partition());
print "[header] server = $server, partition = $partition\n";
}
my $vldbentry = $result->getVLDBEntry();
foreach my $vldbsite ( $vldbentry->getVLDBSites() ) {
my ($server,$partition) = ($vldbsite->server(),$vldbsite->partition());
lib/AFS/Command/VOS.pod view on Meta::CPAN
This method returns an AFS::Object::FileServer object, which
contains one or more AFS::Object::Partition objects. Because
'listpart' returns nothing other than the partition names, the
underlying Partition objects have only one attribute ('partition'), so
the API for access this data is trivial:
my $result = $vos->listpart
(
server => 'fs1.ms.com',
) || die $vos->errors();
foreach my $partition ( $result->getPartitionNames() ) {
print "Server '$server' has partition '$partition'\n";
}
The FileServer object has no attributes at all, it merely contains the
Partition objects. Since the Partition objects are indexed by name,
there's no need to extract the partition objects and query their
attributes, since once you have the names, you have all the information
already.
lib/AFS/Command/VOS.pod view on Meta::CPAN
NOTE: the VLDBEntry and VLDBSite objects are the same as those used by
the 'examine' method, since that command also queries the VLDB for
part of its return values. See that discussion above for some
relevant details on the parsing of those objects, which will no be
repeated here.
my $result = $vos->listvldb
(
cell => $cell,
) || die $vos->errors();
print("VLDB contains " . $result->total() " volumes, " .
$result->locked() . " of which are locked\n");
foreach my $entry ( $result->getVLDBEntries() ) {
my $name = $entry->name();
foreach my $attr ( $entry->listAttributes() ) {
print "Volume $name has attribute $attr => " . $entry->$attr() . "\n";
}
foreach my $site ( $entry->getVLDBSites() ) {
lib/AFS/Command/VOS.pod view on Meta::CPAN
quiet => 1,
extended => 1, # Not really... see below
cell => $cell,
noauth => 1,
localauth => 1,
verbose => 1,
encrypt => 1,
);
NOTE: 'extended' is not supported in this version of the API, and
specifying it will result in a warning, but not an error. However,
'vos examine' does parse the extended output, so if you really want
that data you can get it on a volume by volume basis. Adding support
for 'extended' to 'vos listvol' is on the todo list.
=item Return Values
This method returns an AFS::Object::VolServer object, which
merely contains one or more AFS::Object::Partition objects,
which in turn have a few attributes and contain one or more
AFS::Object::VolumeHeader objects.
my $result = $vos->listvol
(
server => $server,,
cell => $cell,
) || die $vos->errors();
foreach my $partition ( $result->getPartitions() ) {
my $partname = $partition->partition();
my $total = $partition->total();
my $online = $partition->online();
my $offline = $partition->offline();
my $busy = $partition->busy();
print("Partition $partname has $total total volumes, of which " .
"$online are online, $offline are offline, and $busy are busy.\n");
foreach my $header ( $partition->getVolumeHeaders() ) {
# Do something interesting with $header.
lib/AFS/Command/VOS.pod view on Meta::CPAN
This method returns an AFS::Object::FileServer object, which
contains one or more AFS::Object::Partition objects, which
have more interesting attributes than those returned by 'vos
partinfo'.
my $result = $vos->partinfo
(
server => $server,
cell => $cell,
) || die $vos->errors();
foreach my $partition ( $result->getPartitions() ) {
my $partname = $partition->partition();
my $available = $partition->available();
my $total = $partition->total();
print("Partition $partname has $available KB of " .
"space available out of $total KB total\n");
}
B<AFS::Object::FileServer>
lib/AFS/Command/VOS.pod view on Meta::CPAN
=item Return Values
This method returns an AFS::Object::VolServer object with one
attribute, which also may or may not contain one or more
AFS::Object::Transaction objects.
my $result = $vos->status
(
server => $server,
) || die $vos->errors();
print "Server has " . $result->transactions() . "active transactions\n";
foreach my $transaction ( $result->getTransactions() ) {
print("There are active transactions for volume ID " .
$transaction->volume() . "\n");
}
B<AFS::Object::VolServer>
This object has exactly one attribute, and several methods:
t/00vos_basic.t view on Meta::CPAN
partition => $partition_primary,
name => $volname,
cell => $cell,
);
if ( $result ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to create volume '$volname' on server '$server_primary:$partition_primary' " .
"in cell '$cell'\n" . "Errors from vos command:\n" . $vos->errors());
}
#
# Examine it.
#
$result = $vos->examine
(
id => $volname,
cell => $cell,
);
if ( ref $result && $result->isa("AFS::Object::Volume") ) {
print "ok $TestCounter\n";
$TestCounter++;
my $errors = 0;
#
# First, sanity check the volume header. There should be ONE of them only.
#
my @headers = $result->getVolumeHeaders();
if ( $#headers == 0 ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn "Incorrect number of headers returned by getVolumeHeaders()\n";
$errors++;
}
$TestCounter++;
my $header = $headers[0];
my $rwrite = 0;
if ( ref $header && $header->isa("AFS::Object::VolumeHeader") ) {
print "ok $TestCounter\n";
t/00vos_basic.t view on Meta::CPAN
#
# This had better be on the server and partition we created
# it on, and have the same name/id, obviously.
#
if ( $header->name() eq $volname ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Volume header 'name' is '" .
$header->name() . "', should be '$volname'\n");
$errors++;
}
$TestCounter++;
if ( $header->partition() eq $partition_primary ) {
print "ok $TestCounter\n";
} else {
warn("Volume header 'partition' is '" .
$header->partition() . "', should be '$partition_primary'\n");
print "not ok $TestCounter\n";
$errors++;
}
$TestCounter++;
if ( $header->server() eq $server_primary ) {
print "ok $TestCounter\n";
} else {
warn("Volume header 'server' is '" .
$header->server() . "', should be '$server_primary'\n");
print "not ok $TestCounter\n";
$errors++;
}
$TestCounter++;
#
# The volume has to be RW
#
if ( $header->type() eq 'RW' ) {
print "ok $TestCounter\n";
} else {
warn("Volume header 'type' is '" .
$header->type() . "', should be 'RW'\n");
print "not ok $TestCounter\n";
$errors++;
}
$TestCounter++;
#
# Check the volume IDs. rwrite shold be numeric, ronly and
# backup should b e 0.
#
$rwrite = $header->rwrite();
if ( $rwrite =~ /^\d+$/ ) {
print "ok $TestCounter\n";
} else {
warn("Volume header 'rwrite' is '$rwrite', should be a numeric value\n");
print "not ok $TestCounter\n";
$errors++;
}
$TestCounter++;
if ( $header->ronly() == 0 ) {
print "ok $TestCounter\n";
} else {
warn("Volume header 'ronly' is '" .
$header->ronly() . "', should be zero\n");
print "not ok $TestCounter\n";
$errors++;
}
$TestCounter++;
if ( $header->backup() == 0 ) {
print "ok $TestCounter\n";
} else {
warn("Volume header 'backup' is '" .
$header->backup() . "', should be zero\n");
print "not ok $TestCounter\n";
$errors++;
}
$TestCounter++;
#
# This is a new volume, so access should be 0, and size 2
#
if ( $header->accesses() == 0 ) {
print "ok $TestCounter\n";
} else {
warn("Volume header 'accesses' is '" .
$header->access() . "', should be zero\n");
print "not ok $TestCounter\n";
$errors++;
}
$TestCounter++;
if ( $header->size() == 2 ) {
print "ok $TestCounter\n";
} else {
warn("Volume header 'size' is '" .
$header->size() . "', should be 2\n");
print "not ok $TestCounter\n";
$errors++;
}
$TestCounter++;
#
# Both the update and creation times should be ctime values.
# NOTE: This test may very well break if LANG is set, and
# affects vos output syntax. Note that in that case, we'll
# need code in VOS.pm to deal with more generic time strings.
#
foreach my $method ( qw( update creation ) ) {
if ( $header->$method() =~ /^\S+\s+\S+\s+\d+\s+\d{2}:\d{2}:\d{2}\s+\d{4}$/ ) {
print "ok $TestCounter\n";
} else {
warn("Volume header '$method' is '" .
$header->$method() . "', should be a ctime date value\n");
print "not ok $TestCounter\n";
$errors++;
}
$TestCounter++;
}
#
# Finally, maxauota must be numeric, and status should be
# 'online'
#
if ( $header->maxquota() =~ /^\d+$/ ) {
print "ok $TestCounter\n";
} else {
warn("Volume header 'maxquota' is '" .
$header->maxquota() . "', should be numeric\n");
print "not ok $TestCounter\n";
$errors++;
}
$TestCounter++;
if ( $header->status() eq 'online' ) {
print "ok $TestCounter\n";
} else {
warn("Volume header 'status' is '" .
$header->status() . "', should be 'online'\n");
print "not ok $TestCounter\n";
$errors++;
}
$TestCounter++;
} else {
warn("Invalid object -- getVolumeHeaders() did not return an " .
"AFS::Object::VolumeHeader object\n");
print "not ok $TestCounter\n";
$errors++;
}
#
# Second, we check the VLDB entry for this volume.
#
my $vldbentry = $result->getVLDBEntry();
if ( ref $vldbentry && $vldbentry->isa("AFS::Object::VLDBEntry") ) {
print "ok $TestCounter\n";
} else {
t/00vos_basic.t view on Meta::CPAN
Data::Dumper->Dump([$result],['result']));
}
$TestCounter++;
if ( $vldbentry->rwrite() =~ /^\d+$/ ) {
print "ok $TestCounter\n";
} else {
warn("VLDB Entry 'rwrite' is '" .
$vldbentry->rwrite() . "', should be a numeric value\n");
print "not ok $TestCounter\n";
$errors++;
}
$TestCounter++;
#
# This should match the rwrite ID found in the volume headers,
# too.
#
if ( $vldbentry->rwrite() == $rwrite ) {
print "ok $TestCounter\n";
} else {
warn("VLDB entry rwrite id (" . $vldbentry->rwrite() .
"), does not match volume header rwrite id ($rwrite)\n");
print "not ok $TestCounter\n";
$errors++;
}
$TestCounter++;
my @vldbsites = $vldbentry->getVLDBSites();
if ( $#vldbsites == 0 ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn "Incorrect number of sites returned by getVLDBSites()\n";
$errors++;
}
$TestCounter++;
my $vldbsite = $vldbsites[0];
if ( ref $vldbsite && $vldbsite->isa("AFS::Object::VLDBSite") ) {
print "ok $TestCounter\n";
$TestCounter++;
if ( $vldbsite->partition() eq $partition_primary ) {
print "ok $TestCounter\n";
} else {
warn("VLDB Site 'partition' is '" .
$vldbsite->partition() . "', should be '$partition_primary'\n");
print "not ok $TestCounter\n";
$errors++;
}
$TestCounter++;
if ( $vldbsite->server() eq $server_primary ) {
print "ok $TestCounter\n";
} else {
warn("Volume VLDB Site 'server' is '" .
$vldbsite->server() . "', should be '$server_primary'\n");
print "not ok $TestCounter\n";
$errors++;
}
$TestCounter++;
} else {
warn("Invalid object -- getVLDBSites() did not return an " .
"AFS::Object::VLDBSite object\n");
print "not ok $TestCounter..$TestTotal\n";
$errors++;
}
die Data::Dumper->Dump([$result],['result']) if $errors;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to examine volume '$volname' in cell '$cell':\n" .
$vos->errors());
}
#
# Create a backup, an verify that the changes in the examine output.
#
$result = $vos->backup
(
id => $volname,
cell => $cell,
);
if ( $result ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to backup volume '$volname' in cell '$cell':\n" .
$vos->errors());
}
$result = $vos->examine
(
id => $volname,
cell => $cell,
);
if ( ref $result && $result->isa("AFS::Object::Volume") ) {
print "ok $TestCounter\n";
$TestCounter++;
my $errors = 0;
my @headers = $result->getVolumeHeaders();
if ( $#headers == 0 ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn "Incorrect number of headers returned by getVolumeHeaders()\n";
$errors++;
}
$TestCounter++;
my $header = $headers[0];
my $rwrite = 0;
if ( ref $header && $header->isa("AFS::Object::VolumeHeader") ) {
print "ok $TestCounter\n";
t/00vos_basic.t view on Meta::CPAN
$header->backup() . "', should be non-zero\n");
}
} else {
print "not ok $TestCounter\n";
$TestCounter++;
print "not ok $TestCounter\n";
warn("Volume header 'backup' is '" .
$header->backup() . "', should be numeric\n");
$errors++;
}
$TestCounter++;
} else {
warn("Invalid object -- getVolumeHeaders() did not return an " .
"AFS::Object::VolumeHeader object\n");
print "not ok $TestCounter\n";
$errors++;
}
die Data::Dumper->Dump([$result],['result']) if $errors;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to examine volume '$volname' in cell '$cell':\n" .
$vos->errors());
}
#
# Now let's add the other replica sites, and release the volume.
#
for ( my $index = 0 ; $index <= $#servers ; $index++ ) {
my $server = $servers[$index];
my $partition = $partitions[$index];
t/00vos_basic.t view on Meta::CPAN
server => $server,
partition => $partition,
cell => $cell,
);
if ( $result ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to addsite '$server:$partition' to volume '$volname' in cell '$cell':\n" .
$vos->errors());
}
}
$result = $vos->listvldb
(
name => $volname,
cell => $cell,
);
if ( ref $result && $result->isa("AFS::Object::VLDB") ) {
print "ok $TestCounter\n";
$TestCounter++;
my $errors = 0;
my @volnames = $result->getVolumeNames();
if ( $#volnames == 0 ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn "Incorrect number of volnames returned by getVolumeNames()\n";
$errors++;
}
$TestCounter++;
my $volname_queried = $volnames[0];
if ( $volname eq $volname_queried ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn "Volname returned by query ($volname_queried) does not match that specified ($volname)\n";
$errors++;
}
$TestCounter++;
#
# If either of the above failed, we can't go on...
#
die Data::Dumper->Dump([$result],['result']) if $errors;
my $vldbentry = $result->getVLDBEntryByName($volname);
if ( ref $vldbentry && $vldbentry->isa("AFS::Object::VLDBEntry") ) {
print "ok $TestCounter\n";
$TestCounter++;
my $rwrite = $vldbentry->rwrite();
my $altentry = $result->getVLDBEntryById($rwrite);
t/00vos_basic.t view on Meta::CPAN
my $serverindex = $index - 1;
$serverindex = 0 if $serverindex == -1;
if ( $vldbsite->server() eq $servers[$serverindex] ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("VLDB Site [$index] server is '" . $vldbsite->server() . "'\n" .
"Should be '" . $servers[$serverindex] . "'\n");
$errors++;
}
$TestCounter++;
if ( $vldbsite->partition() eq $partitions[$serverindex] ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("VLDB Site [$index] partition is '" . $vldbsite->partition() . "'\n" .
"Should be '" . $partitions[$serverindex] . "'\n");
$errors++;
}
$TestCounter++;
my $typeshould = $index == 0 ? "RW" : "RO";
if ( $vldbsite->type() eq $typeshould ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("VLDB Site [$index] type is '" . $vldbsite->type() . "'\n" .
"Should be '$typeshould'\n");
$errors++;
}
$TestCounter++;
my $statusshould = $index == 0 ? "" : "Not released";
if ( $vldbsite->status() eq $statusshould ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("VLDB Site [$index] status is '" . $vldbsite->status() . "'\n" .
"Should be '$statusshould'\n");
$errors++;
}
$TestCounter++;
}
die Data::Dumper->Dump([$vldbentry],['vldbentry']) if $errors;
} else {
warn("Invalid object -- getVLDBEntry() did not return an " .
"AFS::Object::VLDBEntry object\n");
print "not ok $TestCounter\n";
$errors++;
}
die Data::Dumper->Dump([$result],['result']) if $errors;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to listvldb volume '$volname' in cell '$cell':\n" .
$vos->errors());
}
foreach my $force ( qw( none f force ) ) {
$result = $vos->release
(
id => $volname,
cell => $cell,
(
$force eq 'none' ? () :
( $force => 1 )
),
);
if ( $result ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to release volume '$volname' in cell '$cell':\n" .
$vos->errors());
}
$TestCounter++;
}
#
# The volume is released, so now, let's examine the readonly, and make
# sure we get the correct volume headers.
#
$result = $vos->examine
(
id => $volname_readonly,
cell => $cell,
);
if ( ref $result && $result->isa("AFS::Object::Volume") ) {
print "ok $TestCounter\n";
$TestCounter++;
my $errors = 0;
my @headers = $result->getVolumeHeaders();
if ( $#headers == $#servers ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Number of headers returned by getVolumeHeaders ($#headers) " .
"does not match number of servers ($#servers)\n");
$errors++;
}
$TestCounter++;
for ( my $index = 0 ; $index <= $#headers ; $index++ ) {
my $header = $headers[$index];
if ( $header->name() eq $volname_readonly ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Volume header [$index] 'name' is '" .
$header->name() . "', should be '$volname_readonly'\n");
$errors++;
}
$TestCounter++;
if ( $header->partition() eq $partitions[$index] ) {
print "ok $TestCounter\n";
} else {
warn("Volume header [$index] 'partition' is '" .
$header->partition() . "', should be '$partitions[$index]'\n");
print "not ok $TestCounter\n";
$errors++;
}
$TestCounter++;
if ( $header->server() eq $servers[$index] ) {
print "ok $TestCounter\n";
} else {
warn("Volume header [$index] 'server' is '" .
$header->server() . "', should be '$servers[$index]'\n");
print "not ok $TestCounter\n";
$errors++;
}
$TestCounter++;
if ( $header->type() eq 'RO' ) {
print "ok $TestCounter\n";
} else {
warn("Volume header [$index] 'type' is '" .
$header->type() . "', should be 'RO'\n");
print "not ok $TestCounter\n";
$errors++;
}
$TestCounter++;
}
die Data::Dumper->Dump([$result],['result']) if $errors;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to examine volume '$volname' in cell '$cell':\n" .
$vos->errors());
}
#
# Finally, let's clean up after ourselves.
#
for ( my $index = 0 ; $index <= $#servers ; $index++ ) {
$result = $vos->remove
(
id => $volname_readonly,
server => $servers[$index],
partition => $partitions[$index],
cell => $cell,
);
if ( $result ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to remove volume '$volname_readonly' from server '$servers[$index]', " .
"partition '$partitions[$index]', in cell '$cell':\n" .
$vos->errors());
}
$TestCounter++;
}
#
# Test the vos offline functionality, if supported.
#
if ( $vos->supportsOperation('offline') ) {
t/00vos_basic.t view on Meta::CPAN
server => $servers[0],
partition => $partitions[0],
cell => $cell,
);
if ( $result ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
die("Unable to $method volume '$volname' from server '$servers[0]', " .
"partition '$partitions[0]', in cell '$cell':\n" .
$vos->errors());
}
$TestCounter++;
$result = $vos->examine
(
id => $volname,
cell => $cell,
);
if ( ref $result ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
die("Unable to examine volume '$volname' on server '$servers[0]', " .
"partition '$partitions[0]', in cell '$cell':\n" .
$vos->errors());
}
$TestCounter++;
my ($header) = $result->getVolumeHeaders();
if ( $header->status() eq $method ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Volume '$volname' on server '$servers[0]', " .
t/00vos_basic.t view on Meta::CPAN
partition => $partitions[0],
cell => $cell,
);
if ( $result ) {
print "ok $TestCounter\n";
delete $Volnames{$volname};
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to remove volume '$volname' from server '$servers[0]', " .
"partition '$partitions[0]', in cell '$cell':\n" .
$vos->errors());
}
$TestCounter++;
#
# Finally, one we *expect* to fail...
#
$result = $vos->examine
(
id => $volname,
cell => $cell,
);
if ( $result ) {
print "not ok $TestCounter..$TestTotal\n";
die("Volume '$volname' in cell '$cell', still exists after a successful vos remove!!\n");
} elsif ( $vos->errors() =~ /VLDB: no such entry/i ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unexpected result from vos examine:\n" . $vos->errors());
}
$TestCounter++;
exit 0;
END {
#$TestCounter--;
#warn "Total number of tests == $TestCounter\n";
t/01vos_dumprestore.t view on Meta::CPAN
name => $volname,
cell => $cell,
);
if ( $result ) {
print "ok $TestCounter\n";
$TestCounter++;
$Volnames{$volname}++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to create volume '$volname' on server '$server_primary:$partition_primary'" .
"in cell '$cell'\n" . "Errors from vos command:\n" . $vos->errors());
}
#
# OK, let's create a few dump files, in different ways.
#
# First, a vanilla dump, nothing special.
#
my %files =
(
raw => "$tmproot/$volname.dump",
t/01vos_dumprestore.t view on Meta::CPAN
id => $volname,
time => 0,
file => $files{raw},
cell => $cell,
);
if ( $result ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Unable to dump volume '$volname' in cell '$cell' to file '$files{raw}':\n" .
$vos->errors());
}
$TestCounter++;
foreach my $ctype ( qw(gzip bzip2) ) {
unless ( $enabled{$ctype} ) {
for ( my $count = 0 ; $count < 3 ; $count++ ) {
print "ok $TestCounter # skip Compression support for $ctype disabled\n";
$TestCounter++;
}
t/01vos_dumprestore.t view on Meta::CPAN
id => $volname,
time => 0,
file => $files{$ctype},
cell => $cell,
);
if ( $result ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Unable to dump volume '$volname' in cell '$cell' to file '$files{$ctype}':\n" .
$vos->errors());
}
$TestCounter++;
#
# Next, explicitly, using the gzip/bzip2 argument
#
$result = $vos->dump
(
id => $volname,
time => 0,
t/01vos_dumprestore.t view on Meta::CPAN
if ( $result ) {
if ( -f $files{$ctype} ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Unexpected result: dump method did not produce an output file\n");
}
} else {
print "not ok $TestCounter\n";
warn("Unable to dump volume '$volname' in cell '$cell' to file '$files{$ctype}':\n" .
$vos->errors());
}
$TestCounter++;
#
# Finally, when both are given.
#
$result = $vos->dump
(
id => $volname,
time => 0,
t/01vos_dumprestore.t view on Meta::CPAN
warn("Unexpected result: dump method created file '$files{raw}', " .
"should have been '$files{$ctype}'\n" .
"(Both -file $files{$ctype}, and -$ctype specified)\n");
} else {
print "not ok $TestCounter\n";
warn("Unexpected result: dump method did not produce an output file\n");
}
} else {
print "not ok $TestCounter\n";
warn("Unable to dump volume '$volname' in cell '$cell' to file '$files{$ctype}':\n" .
$vos->errors());
die Data::Dumper->Dump([$vos],['vos']);
}
$TestCounter++;
}
if ( $dumpfilter ) {
$result = $vos->dump
(
t/01vos_dumprestore.t view on Meta::CPAN
time => 0,
file => $files{raw},
cell => $cell,
filterout => [$dumpfilter],
);
if ( $result ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Unable to dump volume '$volname' in cell '$cell' to file '$files{raw}':\n" .
$vos->errors());
}
$TestCounter++;
my ($ctype) = ( $enabled{gzip} ? 'gzip' :
$enabled{bzip2} ? 'bzip2' : '' );
if ( $ctype ) {
$result = $vos->dump
(
t/01vos_dumprestore.t view on Meta::CPAN
file => $files{$ctype},
cell => $cell,
filterout => [$dumpfilter],
);
if ( $result ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Unable to dump volume '$volname' in cell '$cell' to file '$files{raw}':\n" .
"(Testing dump filter with compression)\n" .
$vos->errors());
}
} else {
print "ok $TestCounter # skip Compression support disabled\n";
}
$TestCounter++;
} else {
for ( my $count = 0 ; $count < 2 ; $count++ ) {
t/01vos_dumprestore.t view on Meta::CPAN
id => $volname,
cell => $cell,
);
if ( $result ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to remove volume '$volname' from server '$server_primary', " .
"partition '$partition_primary', in cell '$cell':\n" .
$vos->errors());
}
#
# If we made it this far, dump works fine. Now let's test restore...
#
$result = $vos->restore
(
server => $server_primary,
t/01vos_dumprestore.t view on Meta::CPAN
overwrite => 'full',
cell => $cell,
);
if ( $result ) {
print "ok $TestCounter\n";
$Volnames{$volname}++;
} else {
print "not ok $TestCounter\n";
warn("Unable to restore volume '$volname' from file '$files{raw}',\n" .
"to server '$server_primary', partition '$partition_primary', name '$volname':\n" .
$vos->errors());
}
$TestCounter++;
foreach my $ctype ( qw(gunzip bunzip2) ) {
unless ( $enabled{$ctype} ) {
for ( my $count = 0 ; $count < 1 ; $count++ ) {
print "ok $TestCounter # skip Compression support for $ctype disabled\n";
$TestCounter++;
}
t/01vos_dumprestore.t view on Meta::CPAN
file => $files{$ctype},
overwrite => 'full',
cell => $cell,
);
if ( $result ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Unable to restore volume '$volname' from file '$files{$ctype}',\n" .
"to server '$server_primary', partition '$partition_primary', name '$volname':\n" .
$vos->errors());
}
$TestCounter++;
}
if ( $restorefilter ) {
$result = $vos->restore
(
server => $server_primary,
t/01vos_dumprestore.t view on Meta::CPAN
cell => $cell,
filterin => [$restorefilter],
);
if ( $result ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Unable to restore volume '$volname' from file '$files{raw}',\n" .
"using restore filter '$restorefilter', " .
"to server '$server_primary', partition '$partition_primary', name '$volname':\n" .
$vos->errors());
}
$TestCounter++;
my ($ctype) = ( $enabled{gunzip} ? 'gunzip' :
$enabled{bunzip2} ? 'bunzip2' : '' );
if ( $ctype ) {
$result = $vos->restore
(
t/01vos_dumprestore.t view on Meta::CPAN
cell => $cell,
filterin => [$restorefilter],
);
if ( $result ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Unable to restore volume '$volname' from file '$files{$ctype}',\n" .
"using restore filter '$restorefilter', " .
"to server '$server_primary', partition '$partition_primary', name '$volname':\n" .
$vos->errors());
}
} else {
print "ok $TestCounter # skip Compression support disabled\n";
}
$TestCounter++;
} else {
for ( my $count = 0 ; $count < 2 ; $count++ ) {
t/01vos_dumprestore.t view on Meta::CPAN
cell => $cell,
);
if ( $result ) {
print "ok $TestCounter\n";
$TestCounter++;
delete $Volnames{$volname};
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to remove volume '$volname' from server '$server_primary', " .
"partition '$partition_primary', in cell '$cell':\n" .
$vos->errors());
}
exit 0;
END {
#$TestCounter--;
#warn "Total number of tests == $TestCounter\n";
if ( %Volnames ) {
t/02vos_volserver.t view on Meta::CPAN
server => $server_primary,
cell => $cell,
);
if ( ref $listpart && $listpart->isa("AFS::Object::FileServer") ) {
print "# AFS::Command::VOS->listpart()\n";
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to query partinfo on server '$server_primary', in cell '$cell':\n" .
$vos->errors());
}
my $partinfo = $vos->partinfo
(
server => $server_primary,
cell => $cell,
);
if ( ref $partinfo && $partinfo->isa("AFS::Object::FileServer") ) {
print "# AFS::Command::VOS->partinfo()\n";
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to query partinfo on server '$server_primary', in cell '$cell':\n" .
$vos->errors());
}
foreach my $objectpair ( [ $partinfo, $listpart ], [ $listpart, $partinfo ] ) {
my ($src,$dst) = @$objectpair;
my @partitions = $src->getPartitionNames();
if ( @partitions ) {
print "# AFS::Command::VOS->getPartitionNames()\n";
print "ok $TestCounter\n";
t/02vos_volserver.t view on Meta::CPAN
Data::Dumper->Dump([$vos],['vos']));
}
print "# AFS::Command::VOS->listvol()\n";
print "ok $TestCounter\n";
$TestCounter++;
my $listpart_names = { map { $_ => 1 } $listpart->getPartitionNames() };
my $listvol_names = { map { $_ => 1 } $listvol->getPartitionNames() };
my $partname_errors = 0;
foreach my $hashpair ( [ $listpart_names, $listvol_names ],
[ $listvol_names, $listpart_names ] ) {
my ($src,$dst) = @$hashpair;
foreach my $partname ( keys %$src ) {
$partname_errors++ unless $dst->{$partname};
}
}
if ( $partname_errors ) {
print "not ok $TestCounter\n";
warn("Partition lists from listpart and listvol are inconsistent:\n" .
Data::Dumper->Dump([$listpart_names,$listvol_names],['listpart','listvol']));
} else {
print "# AFS::Command::VOS, listpart vs. listvol comparison\n";
print "ok $TestCounter\n";
}
$TestCounter++;
#
t/02vos_volserver.t view on Meta::CPAN
print "not ok $TestCounter..$TestTotal\n";
die("Unable to query listvol for server '$server_primary', " .
"partition '$partition_primary', in cell '$cell':\n" .
Data::Dumper->Dump([$listvol],['listvol']));
}
print "# AFS::Command::VOS->getPartition()\n";
print "ok $TestCounter\n";
$TestCounter++;
my $id_errors = 0;
my @ids = $partition->getVolumeIds();
unless ( @ids ) {
warn "Empty volume id list returned by getVolumeIds()\n";
$id_errors++;
}
foreach my $id ( @ids ) {
my $errors_thisid = 0;
unless ( $id =~ /^\d+$/ ) {
warn("Non-numeric volume id '$id' returned by getVolumeIds()\n");
$id_errors++;
next;
}
my $volume_byid = $partition->getVolumeHeaderById($id);
unless ( ref $volume_byid && $volume_byid->isa("AFS::Object::VolumeHeader") ) {
warn("Object returned for id '$id' is not an AFS::Object::VolumeHeader\n");
$errors_thisid++;
$id_errors++;
}
my $volume_generic = $partition->getVolumeHeader( id => $id );
unless ( ref $volume_generic && $volume_generic->isa("AFS::Object::VolumeHeader") ) {
warn("Object returned for id '$id' is not an AFS::Object::VolumeHeader\n");
$errors_thisid++;
$id_errors++;
}
next if $errors_thisid;
unless ( $volume_byid->id() == $volume_generic->id() ) {
warn("Objects returned by getVolumeHeaderById and getVolumeHeader do not match:\n" .
Data::Dumper->Dump([$volume_byid,$volume_generic],
['getVolumeHeaderById','getVolumeHeader']));
$id_errors++;
}
}
print "not " if $id_errors;
print "# AFS::Command::VOS->getPartition id check\n";
print "ok $TestCounter\n";
$TestCounter++;
my $name_errors = 0;
my @names = $partition->getVolumeNames();
unless ( @names ) {
warn "Empty volume name list returned by get VolumeNames()\n";
$name_errors++;
}
my $volume_online = "";
foreach my $name ( sort @names ) {
my $errors_thisname = 0;
my $volume_byname = $partition->getVolumeHeaderByName($name);
unless ( ref $volume_byname && $volume_byname->isa("AFS::Object::VolumeHeader") ) {
warn("Object returned for name '$name' is not an AFS::Object::VolumeHeader\n");
$errors_thisname++;
$name_errors++;
}
my $volume_generic = $partition->getVolumeHeader( name => $name );
unless ( ref $volume_generic && $volume_generic->isa("AFS::Object::VolumeHeader") ) {
warn("Object returned for name '$name' is not an AFS::Object::VolumeHeader\n");
$errors_thisname++;
$name_errors++;
}
next if $errors_thisname;
unless ( $volume_byname->name() eq $volume_generic->name() ) {
warn("Objects returned by getVolumeHeaderByName and getVolumeHeader do not match:\n" .
Data::Dumper->Dump([$volume_byname,$volume_generic],
['getVolumeHeaderByName','getVolumeHeader']));
$id_errors++;
next;
}
if ( $volume_byname->status() eq 'online' && not ref $volume_online ) {
$volume_online = $volume_byname;
}
}
print "not " if $name_errors;
print "# AFS::Command::VOS->getPartition name check\n";
print "ok $TestCounter\n";
$TestCounter++;
#
# Since we trust examine by this point, we can examine the one online
# volume we kept track of, and make sure the headers match.
#
my $volname = $volume_online->name();
t/10bos_basic.t view on Meta::CPAN
(
server => $dbserver,
cell => $cell,
file => 'bosserver',
);
if ( $result ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to getdate for bosserver:\n" . $bos->errors());
}
my @files = $result->getFileNames();
if ( grep($_ eq 'bosserver',@files) ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Didn't find 'bosserver' in results from bos->getdate()");
}
$TestCounter++;
t/10bos_basic.t view on Meta::CPAN
(
server => $dbserver,
cell => $cell,
file => '/usr/afs/logs/BosLog',
);
if ( ref $result && $result->isa("AFS::Object::BosServer") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to getlog for bosserver:\n" . $bos->errors());
}
my $log = $result->log();
if ( $log ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to getlog for bosserver:\n" . $bos->errors());
}
my ($firstline) = split(/\n+/,$log);
my $tmpfile = "/var/tmp/.bos.getlog.results.$$";
$result = $bos->getlog
(
server => $dbserver,
cell => $cell,
file => '/usr/afs/logs/BosLog',
redirect => $tmpfile,
);
if ( ref $result && $result->isa("AFS::Object::BosServer") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to getlog for bosserver:\n" . $bos->errors());
}
$log = $result->log();
if ( $log eq $tmpfile ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to getlog for bosserver:\n" . $bos->errors());
}
$file = IO::File->new($tmpfile) || do {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to read $tmpfile: $ERRNO\n";
};
if ( $file->getline() eq "$firstline\n" ) {
print "ok $TestCounter\n";
} else {
t/10bos_basic.t view on Meta::CPAN
$result = $bos->getrestart
(
server => $dbserver,
cell => $cell,
);
if ( ref $result && $result->isa("AFS::Object::BosServer") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to getrestart for bosserver:\n" . $bos->errors());
}
foreach my $attr ( qw(restart binaries) ) {
if ( $result->$attr() ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Unable to get $attr time from bos->getrestart()\n");
}
$TestCounter++;
t/10bos_basic.t view on Meta::CPAN
$result = $bos->listhosts
(
server => $dbserver,
cell => $cell,
);
if ( ref $result && $result->isa("AFS::Object::BosServer") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to listhosts for bosserver:\n" . $bos->errors());
}
if ( $result->cell() eq $cell ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Cell name returned by listhosts '" . $result->cell() .
"' does not match '$cell'");
}
$TestCounter++;
t/10bos_basic.t view on Meta::CPAN
$result = $bos->listkeys
(
server => $dbserver,
cell => $cell,
);
if ( ref $result && $result->isa("AFS::Object::BosServer") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to listkeys for bosserver:\n" . $bos->errors());
}
my @indexes = $result->getKeyIndexes();
if ( @indexes ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to get indexes from listkeys for bosserver\n");
}
t/10bos_basic.t view on Meta::CPAN
$result = $bos->listusers
(
server => $dbserver,
cell => $cell,
);
if ( ref $result && $result->isa("AFS::Object::BosServer") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to listusers for bosserver:\n" . $bos->errors());
}
my $susers = $result->susers();
if ( ref $susers eq 'ARRAY' ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Not an ARRAY ref: bos->listusers->susers()\n");
}
$TestCounter++;
t/10bos_basic.t view on Meta::CPAN
$result = $bos->status
(
server => $dbserver,
cell => $cell,
);
if ( ref $result && $result->isa("AFS::Object::BosServer") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to get status from bosserver:\n" . $bos->errors());
}
my @instancenames = $result->getInstanceNames();
if ( @instancenames ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to get instance names from bos->status->getInstanceNames()\n");
}
t/10bos_basic.t view on Meta::CPAN
(
server => $dbserver,
cell => $cell,
long => 1,
);
if ( ref $result && $result->isa("AFS::Object::BosServer") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to get status from bosserver:\n" . $bos->errors());
}
foreach my $name ( qw(vlserver ptserver) ) {
my $instance = $result->getInstance($name);
if ( ref $instance && $instance->isa("AFS::Object::Instance") ) {
print "ok $TestCounter\n";
$TestCounter++;
t/20fs_basic.t view on Meta::CPAN
#
# fs checkservers
#
my $result = $fs->checkservers();
if ( ref $result && $result->isa("AFS::Object::CacheManager") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to call checkservers:\n" . $fs->errors();
}
my $servers = $result->servers();
if ( ref $servers eq 'ARRAY' ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Not an ARRAY ref: fs->checkservers->servers()\n");
}
$TestCounter++;
$result = $fs->checkservers
(
interval => 0,
);
if ( ref $result && $result->isa("AFS::Object::CacheManager") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to call checkservers:\n" . $fs->errors();
}
if ( $result->interval() =~ /^\d+$/ ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Not an integer: fs->checkservers->interval()\n");
}
$TestCounter++;
t/20fs_basic.t view on Meta::CPAN
$result = $fs->$pathop
(
( $pathop eq 'storebehind' ? 'files' : 'path' ) => $paths,
);
if ( ref $result && $result->isa("AFS::Object::CacheManager") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to call fs->$pathop:\n" . $fs->errors() .
Data::Dumper->Dump([$fs],['fs']));
}
if ( $pathop eq 'storebehind' ) {
if ( defined($result->asynchrony()) ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Result object for fs->storebehind() has no attr 'asynchrony'\n");
}
t/20fs_basic.t view on Meta::CPAN
if ( defined($path->$attr()) ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Path object for '$pathname' has no attr '$attr'\n");
}
$TestCounter++;
}
} else {
my $ok = 'ok';
unless ( $path->error() ) {
warn("Pathname '$pathname' should have given an error()\n");
$ok = 'not ok';
}
for ( my $count = 1 ; $count <= scalar(@{$pathops{$pathop}}) ; $count++ ) {
print "$ok $TestCounter\n";
$TestCounter++;
}
}
} else {
warn("Unable to retreive path object for '$pathname' from fs->$pathop()\n");
t/20fs_basic.t view on Meta::CPAN
$TestCounter++;
}
} else {
warn("Unable to determine if translator is enabled or not\n");
for ( my $count = 1 ; $count <= 4 ; $count++ ) {
print "not ok $TestCounter\n";
$TestCounter++;
}
}
} elsif ( $fs->errors() =~ /not supported/ ) {
for ( my $count = 1 ; $count <= 5 ; $count++ ) {
print "ok $TestCounter\n";
$TestCounter++;
}
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to call exportafs:\n" . $fs->errors();
}
#
# fs getcacheparms
#
$result = $fs->getcacheparms();
if ( ref $result && $result->isa("AFS::Object::CacheManager") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to call getcacheparms:\n" . $fs->errors();
}
foreach my $attr ( qw(avail used) ) {
if ( defined($result->$attr()) ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Result object from getcacheparms has no attr '$attr'\n");
}
$TestCounter++;
t/20fs_basic.t view on Meta::CPAN
#
$result = $fs->getcellstatus
(
cell => $cell,
);
if ( ref $result && $result->isa("AFS::Object::CacheManager") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to call getcellstatus:\n" . $fs->errors();
}
my $cellobj = $result->getCell($cell);
if ( ref $cellobj && $cellobj->isa("AFS::Object::Cell") ) {
print "ok $TestCounter\n";
$TestCounter++;
foreach my $attr ( qw(cell status) ) {
if ( defined($cellobj->$attr()) ) {
t/20fs_basic.t view on Meta::CPAN
# fs getclientaddrs
#
if ( $fs->supportsOperation('getclientaddrs') ) {
$result = $fs->getclientaddrs();
if ( ref $result && $result->isa("AFS::Object::CacheManager") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to call getclientaddrs:\n" . $fs->errors();
}
my $addresses = $result->addresses();
if ( ref $addresses eq 'ARRAY' ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Result object for fs->getclientaddrs() has no attr 'addresses'\n");
}
$TestCounter++;
t/20fs_basic.t view on Meta::CPAN
# fs getcrypt
#
if ( $fs->supportsOperation('getcrypt') ) {
$result = $fs->getcrypt();
if ( ref $result && $result->isa("AFS::Object::CacheManager") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to call getcrypt:\n" . $fs->errors();
}
if ( defined($result->crypt()) ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Result object for fs->getcrypt() has no attr 'crypt'\n");
}
$TestCounter++;
t/20fs_basic.t view on Meta::CPAN
#
# fs getserverprefs
#
$result = $fs->getserverprefs();
if ( ref $result && $result->isa("AFS::Object::CacheManager") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to call getserverprefs:\n" . $fs->errors();
}
my ($server) = $result->getServers();
if ( ref $server && $server->isa("AFS::Object::Server") ) {
print "ok $TestCounter\n";
$TestCounter++;
foreach my $attr ( qw(server preference) ) {
if ( defined($server->$attr()) ) {
t/20fs_basic.t view on Meta::CPAN
#
# fs listcells
#
$result = $fs->listcells();
if ( ref $result && $result->isa("AFS::Object::CacheManager") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to call listcells:\n" . $fs->errors();
}
$cellobj = $result->getCell($cell);
if ( ref $cellobj && $cellobj->isa("AFS::Object::Cell") ) {
print "ok $TestCounter\n";
$TestCounter++;
if ( $cellobj->cell() eq $cell ) {
print "ok $TestCounter\n";
t/20fs_basic.t view on Meta::CPAN
#
# fs sysname
#
$result = $fs->sysname();
if ( ref $result && $result->isa("AFS::Object::CacheManager") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to call sysname:\n" . $fs->errors();
}
if ( defined($result->sysname()) ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Result object for fs->sysname() has no attr 'sysname'\n");
}
$TestCounter++;
t/30pts_basic.t view on Meta::CPAN
#
my $result = $pts->listmax
(
cell => $cell,
);
if ( ref $result && $result->isa("AFS::Object::PTServer") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to call listmax:\n" . $pts->errors();
}
foreach my $attr ( qw( maxuserid maxgroupid ) ) {
if ( defined($result->$attr()) ) {
my $id = $result->$attr();
my $ok ='not ok';
if ( $attr eq 'maxuserid' ) {
$ok = 'ok' if $id > 0;
} else {
$ok = 'ok' if $id < 0;
t/30pts_basic.t view on Meta::CPAN
# First, let's make sure our test IDs aren't defined, so we can
# redefine them.
#
my $result = $pts->delete
(
nameorid => $name,
cell => $cell,
);
if ( $result ) {
print "ok $TestCounter\n";
} elsif ( defined($pts->errors()) && $pts->errors() =~ /unable to find entry/ ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to delete the test pts id ($name), or verify it doesn't exist\n" .
Data::Dumper->Dump([$pts],['pts']));
}
$TestCounter++;
my $method = $name eq $ptsgroup ? 'creategroup' : 'createuser';
my $type = $name eq $ptsgroup ? 'Group' : 'User';
t/30pts_basic.t view on Meta::CPAN
$result = $pts->$method
(
name => $name,
cell => $cell,
);
if ( ref $result && $result->isa("AFS::Object::PTServer") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to call $method:\n" . $pts->errors();
}
my $byname = $name eq $ptsgroup ? 'getGroupByName' : 'getUserByName';
my $byid = $name eq $ptsgroup ? 'getGroupById' : 'getUserById';
my $getall = $name eq $ptsgroup ? 'getGroups' : 'getUsers';
my $entry = $result->$byname($name);
if ( ref $entry && $entry->isa($class) ) {
print "ok $TestCounter\n";
t/30pts_basic.t view on Meta::CPAN
$result = $pts->examine
(
nameorid => $name,
cell => $cell,
);
if ( ref $result && $result->isa("AFS::Object::PTServer") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to call examine:\n" . $pts->errors();
}
($entry) = $result->$getall();
if ( ref $entry && $entry->isa($class) ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Unable to retreive pts entry from pts->examine using $getall\n");
}
$TestCounter++;
t/30pts_basic.t view on Meta::CPAN
(
name => $ptsgroup,
owner => $ptsuser,
cell => $cell,
);
if ( $result ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter\n";
die("Unable to chown $ptsgroup to $ptsuser:" . $pts->errors());
}
$result = $pts->listowned
(
nameorid => $ptsuser,
cell => $cell,
);
if ( ref $result && $result->isa("AFS::Object::PTServer") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to call listowned:\n" . $pts->errors();
}
my ($user) = $result->getUsers();
if ( ref $user && $user->isa("AFS::Object::User") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to get User object from pts->listowned result\n");
}
t/30pts_basic.t view on Meta::CPAN
(
user => $ptsuser,
group => $ptsgroup,
cell => $cell,
);
if ( $result ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to call adduser:\n" . $pts->errors();
}
foreach my $name ( $ptsgroup, $ptsuser ) {
$result = $pts->membership
(
nameorid => $name,
cell => $cell,
);
if ( ref $result && $result->isa("AFS::Object::PTServer") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to call membership:\n" . $pts->errors();
}
my $type = $name eq $ptsgroup ? 'Group' : 'User';
my $class = 'AFS::Object::' . ( $name eq $ptsgroup ? 'Group' : 'User' );
my $getall = $name eq $ptsgroup ? 'getGroups' : 'getUsers';
my ($entry) = $result->$getall();
if ( ref $entry && $entry->isa($class) ) {
print "ok $TestCounter\n";
} else {
t/30pts_basic.t view on Meta::CPAN
my $result = $pts->listentries
(
cell => $cell,
$flag => 1,
);
if ( ref $result && $result->isa("AFS::Object::PTServer") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to call listentries:\n" . $pts->errors();
}
my $entry = $result->$getentry($name);
if ( ref $entry && $entry->isa($class) ) {
foreach my $attr ( qw(id owner creator) ) {
if ( defined($entry->$attr()) ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
t/30pts_basic.t view on Meta::CPAN
}
} else {
for ( my $count = 1 ; $count <= 8 ; $count++ ) {
print "ok $TestCounter\n";
$TestCounter++;
}
}
#
# Test membership error checking
#
$result = $pts->membership
(
nameorid => "ThisSurelyDoesNotExist",
cell => $cell,
);
if ( ref $result && $result->isa("AFS::Object::PTServer") ) {
print "not ok $TestCounter\n";
warn("membership should have failed, not succeeded for 'ThisSurelyDoesNotExist'");
} else {
t/40fs_complex.t view on Meta::CPAN
partition => $partition,
name => $volname,
cell => $cell,
);
if ( $result ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to create volume '$volname' on server '$server:$partition'" .
"in cell '$cell'\n" . "Errors from vos command:\n" . $vos->errors());
}
#
# Mount it (several different ways)
#
my %mtpath =
(
rw => "$pathafs/$volname-rw",
cell => "$pathafs/$volname-cell",
plain => "$pathafs/$volname-plain",
t/40fs_complex.t view on Meta::CPAN
$type eq 'rw' ?
( rw => 1 ) : ()
),
);
if ( $result ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to create mount point for $volname in $cell on $mtpath{$type}:" .
$fs->errors() .
Data::Dumper->Dump([$fs],['fs']));
}
}
$result = $fs->lsmount
(
dir => [values %mtpath],
);
if ( ref $result && $result->isa("AFS::Object::CacheManager") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to lsmount dirs:" .
$fs->errors() .
Data::Dumper->Dump([$fs],['fs']));
}
foreach my $type ( keys %mtpath ) {
my $mtpath = $mtpath{$type};
my $path = $result->getPath($mtpath);
if ( ref $path && $path->isa("AFS::Object::Path") ) {
print "ok $TestCounter\n";
t/40fs_complex.t view on Meta::CPAN
(
dir => [ $mtpath{rw}, $mtpath{plain} ],
);
if ( $result ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to remove mount points for $volname in $cell:\n" .
"[ $mtpath{rw}, $mtpath{plain} ]\n" .
$fs->errors() .
Data::Dumper->Dump([$fs],['fs']));
}
#
# This is the one mtpt we know will work. The AFS pasth you gave me
# might NOT be in the same cell you specified, so using the
# cell-specific mount is necessary.
#
my $mtpath = $mtpath{cell};
t/40fs_complex.t view on Meta::CPAN
$result = $fs->listacl
(
path => $paths,
);
if ( ref $result && $result->isa("AFS::Object::CacheManager") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to listacl dirs:" .
$fs->errors() .
Data::Dumper->Dump([$fs],['fs']));
}
my %acl = ();
foreach my $pathname ( @$paths ) {
my $path = $result->getPath($pathname);
if ( ref $path && $path->isa("AFS::Object::Path") ) {
print "ok $TestCounter\n";
t/40fs_complex.t view on Meta::CPAN
%acl =
(
normal => $normal,
negative => $negative,
);
} else {
my $ok = 'ok';
unless ( $path->error() ) {
warn("Pathname '$pathname' should have given an error()\n");
$ok = 'not ok';
}
for ( my $count = 1 ; $count <= 2 ; $count++ ) {
print "$ok $TestCounter\n";
$TestCounter++;
}
}
}
t/40fs_complex.t view on Meta::CPAN
$type eq 'negative' ?
( negative => 1 ) : ()
),
);
if ( $result ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to setacl dirs:" .
$fs->errors() .
Data::Dumper->Dump([$fs],['fs']));
}
$result = $fs->listacl
(
path => $mtpath,
);
if ( ref $result && $result->isa("AFS::Object::CacheManager") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to listacl dirs:" .
$fs->errors() .
Data::Dumper->Dump([$fs],['fs']));
}
my $path = $result->getPath($mtpath);
if ( ref $path && $path->isa("AFS::Object::Path") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to get Path object from result of fs->listacl:\n" .
t/40fs_complex.t view on Meta::CPAN
$result = $fs->rmmount
(
dir => $mtpath,
);
if ( $result ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to remove mount points for $volname in $cell:\n" .
$fs->errors() .
Data::Dumper->Dump([$fs],['fs']));
}
#
# Blow away the volume
#
$result = $vos->remove
(
server => $server,
partition => $partition,
id => $volname,
cell => $cell,
);
if ( $result ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to remove volume '$volname' from server '$server:$partition'" .
"in cell '$cell'\n" . "Errors from vos command:\n" . $vos->errors());
}
delete $Volnames{$volname};
END {
#$TestCounter--;
#warn "Total number of tests == $TestCounter\n";
if ( %Volnames ) {
warn("The following temporary volumes were created, and may be left over:\n\t" .
t/99pts_cleanup.t view on Meta::CPAN
(
nameorid => [ $ptsgroup, $ptsuser ],
cell => $cell,
);
if ( $result ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to delete pts entries:\n" .
$pts->errors() .
Data::Dumper->Dump([$pts],['pts']));
}
exit 0;
# END {
# $TestCounter--;
# warn "Total number of tests == $TestCounter\n";
# }
util/bin/check_copyright view on Meta::CPAN
join("\n\t",@missing) . "\n");
}
if ( ! $args{update} && @old ) {
warn("The following files have an old copyright notice:\n\t" .
join("\n\t",@old) . "\n");
}
exit 0 unless $args{update};
$errors = 0;
#
# Update the copyrights (add the year 2000) if asked to.
#
foreach my $old ( @old) {
warn "Updating copyright notice in $old\n";
#
# If the file is in RCS, we have to check it out/in.
#
my $rcs = rcs($old);
if ( $rcs ) {
system("co -l $old > /dev/null");
if ( $? >> 8 ) {
warn "Unable to co -l $old\n";
$errors++;
next;
}
}
#
# Hey, I *know* its a hack to call perl from inside perl, but
# this is a hack...
#
# Hmm. This doesn't work. Must be a quoting issue. I dunno...
# system("perl -i -pe 's/(\(c\) 1999)/\1, 2000/g;' $old");
util/bin/check_copyright view on Meta::CPAN
rename("$old.new",$old) || die "Unable to rename $old.new to $old: $!\n";
if ( $rcs ) {
system("echo 'Updated copyright year' | ci -u $old > /dev/null");
die "Unable to ci -u $old\n" if $? >> 8;
}
}
exit $errors ? 1 : 0;
sub rcs {
my ($file) = @_;
my $dirname = dirname($file);
my $basename = basename($file);
return -f "$dirname/RCS/$basename,v" ? "$dirname/RCS/$basename,v" : "";
util/lib/parse_config view on Meta::CPAN
die "Unable to locate CONFIG file\n" unless -f $config;
open(CONFIG,"$config") or
die "Unable to open CONFIG file: $ERRNO\n";
while ( <CONFIG> ) {
next if /^\#/;
next unless ($key,$value) = /^(\w+)\s*=\s*(.*)\s*$/;
if ( $ENV{$key} ) {
#print "Environment variable '$key' overrides CONFIG definition\n";
$Config{$key} = $ENV{$key};
} else {
$Config{$key} = $value;
}
}
close(CONFIG) or
die "Unable to close CONFIG file: $ERRNO\n";
foreach my $key ( keys %ENV ) {
( run in 1.457 second using v1.01-cache-2.11-cpan-49f99fa48dc )