view release on metacpan or  search on metacpan

lib/AFS/Command/FS.pm  view on Meta::CPAN

    my $self = shift;
    return $self->_paths_method('diskfree',@_);
}

sub examine {
    my $self = shift;
    return $self->_paths_method('examine',@_);
}

sub listquota {
    my $self = shift;
    return $self->_paths_method('listquota',@_);
}

sub quota {
    my $self = shift;
    return $self->_paths_method('quota',@_);
}

sub storebehind {
    my $self = shift;
    return $self->_paths_method('storebehind',@_);
}

sub whereis {
    my $self = shift;
    return $self->_paths_method('whereis',@_);
}

sub whichcell {
    my $self = shift;
    return $self->_paths_method('whichcell',@_);
}

sub listacl {
    my $self = shift;
    return $self->_paths_method('listacl',@_);
}

sub _paths_method {

    my $self = shift;
    my $operation = shift;
    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/ ) {

		    $path->_setAttribute( path => $1 );
		    delete $paths{$1};

		    my $normal 		= AFS::Object::ACL->new();
		    my $negative 	= AFS::Object::ACL->new();

		    my $type = 0;

		    while ( defined($_ = $self->{handle}->getline()) ) {

			s/^\s+//g;
			s/\s+$//g;
			last if /^\s*$/;

			$type = 1, next if /^Normal rights:/;
			$type = -1, next if /^Negative rights:/;

			my ($principal,$rights) 	= split;

			if ( $type == 1 ) {
			    $normal->_addEntry( $principal => $rights );
			} elsif ( $type == -1 ) {
			    $negative->_addEntry( $principal => $rights );
			}

		    }

		    $path->_setACLNormal($normal);
		    $path->_setACLNegative($negative);

		}

	    }

	    if ( $operation eq 'whichcell' ) {

		if ( /^File (\S+) lives in cell \'([^\']+)\'/ ) {

		    $path->_setAttribute
		      (
		       path	=> $1,
		       cell 	=> $2,
		      );
		    delete $paths{$1};

		}

	    }

	    if ( $operation eq 'whereis' ) {

		if ( /^File (.*) is on hosts? (.*)$/ ) {

		    $path->_setAttribute
		      (
		       path 			=> $1,
		       hosts			=> [split(/\s+/,$2)],
		      );
		    delete $paths{$1};

		}

	    }

	    if ( $operation eq 'storebehind' ) {

		if ( /Default store asynchrony is (\d+) kbytes/ ) {

		    $default = $1;
		    next;

		} elsif ( /Will store (.*?) according to default./ ) {

		    $path->_setAttribute
		      (
		       path 			=> $1,
		       asynchrony 		=> 'default',
		      );

		    delete $paths{$1};
		    @paths = grep($_ ne $1,@paths);

		} elsif ( /Will store up to (\d+) kbytes of (.*?) asynchronously/ ) {

		    $path->_setAttribute
		      (
		       path 			=> $2,
		       asynchrony 		=> $1,
		      );

		    delete $paths{$2};
		    @paths = grep($_ ne $2,@paths);

		}

	    }

	    if ( $operation eq 'quota' ) {

		if ( /^\s*(\d{1,2})%/ ) {

		    $path->_setAttribute
		      (
		       path 			=> $paths[0],
		       percent			=> $1,
		      );
		    delete $paths{$paths[0]};
		    shift @paths;

		}

	    }

	    if ( $operation eq 'listquota' ) {

		#
		# This is a bit lame.  We want to be lazy and split on white
		# space, so we get rid of this one annoying instance.
		#
		s/no limit/nolimit/g;

		my ($volname,$quota,$used,$percent,$partition) = split;

		$quota = 0 if $quota eq "nolimit";
		$percent =~ s/\D//g; # want numeric result
		$partition =~ s/\D//g; # want numeric result

		$path->_setAttribute
		  (
		   path				=> $paths[0],
		   volname			=> $volname,
		   quota			=> $quota,
		   used				=> $used,
		   percent			=> $percent,
		   partition			=> $partition,
		  );
		delete $paths{$paths[0]};

lib/AFS/Command/FS.pm  view on Meta::CPAN

		shift @paths;

	    }

	    if ( $operation eq 'examine' ) {

		if ( /Volume status for vid = (\d+) named (\S+)/ ) {

		    $path->_setAttribute
		      (
		       path			=> $paths[0],
		       id			=> $1,
		       volname			=> $2,
		      );

		    #
		    # Looking at Transarc's code, we can safely assume we'll
		    # get this output in the order shown. Note we ignore the
		    # "Message of the day" and "Offline reason" output for
		    # now.  Read until we hit a blank line.
		    #
		    while ( defined($_ = $self->{handle}->getline()) ) {

			last if /^\s*$/;

			if ( /Current disk quota is (\d+|unlimited)/ ) {
			    $path->_setAttribute
			      (
			       quota		=>  $1 eq "unlimited" ? 0 : $1,
			      );
			}

			if ( /Current blocks used are (\d+)/ ) {
			    $path->_setAttribute( used => $1 );
			}

			if ( /The partition has (\d+) blocks available out of (\d+)/ ) {
			    $path->_setAttribute
			      (
			       avail		=> $1,
			       total		=> $2,
			      );
			}
		    }

		    delete $paths{$paths[0]};
		    shift @paths;

		}

	    }

	}

	$result->_addPath($path);

    }

    if ( $operation eq 'storebehind' ) {

	$result->_setAttribute( asynchrony => $default );

	#
	# This is ugly, but we get the default last, and it would be nice
	# to put this value into the Path objects as well, rather than the
	# string 'default'.
	#
	foreach my $path ( $result->getPaths() ) {
	    if ( defined($path->asynchrony()) && $path->asynchrony() eq 'default' ) {
		$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 );
	};

	/convert owner mode bits/ && do {
	    $result->_setAttribute( convert => 1 );
	};

	/strict unix/ && do {
	    $result->_setAttribute( convert => 0 );
	};

	/strict \'?passwd sync\'?/ && do {
	    $result->_setAttribute( uidcheck => 1 );