File Coverage

blib/lib/Filesys/Ext2.pm

Criterion	Covered	Total	%
statement	56	92	60.8
branch	15	44	34.0
condition	0	17	0.0
subroutine	10	15	66.6
pod	5	5	100.0
total	86	173	49.7

package Filesys::Ext2;
require 5;
use strict;
use vars q($VERSION);
use IO::Handle;
use IO::Select;
use IPC::Open3;
$VERSION = 0.20;
local($_);

#XXX You may want to change this default if you installed
#XXX e2fsprogs in a non-standard location
local $ENV{PATH} = '/usr/bin/';

my %attr = (
	    s => 0x00000001, u => 0x00000002, c => 0x00000004, S => 0x00000008,
	    i => 0x00000010, a => 0x00000020, d => 0x00000040, A => 0x00000080,
	    Z => 0x00000100,                  X => 0x00000400, E => 0x00000800,
	    I => 0x00001000,                  j => 0x00004000, t => 0x00008000,
	    D => 0x00010000, T => 0x00020000,
	   );

sub import{
  no strict 'refs';
  my $caller = caller(1);
  shift;

  @_ = map { $_ eq ':all' ? qw(chattr lsattr stat lstat calcSymMask) : $_ } @_;
  foreach( @_ ){
    if(ref($_) eq 'HASH'){
      if(exists($_->{PATH})){
	$ENV{PATH} = $_->{PATH};
      }
    }
    else{
      *{$caller."::$_"} = \&{'Filesys::Ext2::'.$_};
    }
  }
}

sub chattr($$;@){
  my($mask, @files) = @_;
  my @mask = $mask =~ /^\d+/ ?
    '=' . join('', grep { y/+// } _calcSymMask($mask)) :
      split(/\s+|(?=[+-=])/, $mask);

  my($R, $E) = _multi("chattr", @mask, @files);

  die($E) if $?;
  return 0;
}

sub lsattr(@){
  my $dir = '-d' if grep { -d } @_;

  my %attr;

  #Skip things that we know lsattr will croak on
  $attr{$_} = undef for grep{ -l || ! (-d || -f || -r) }  @_;
  my($R, $E) = _multi("lsattr", $dir, grep { (-d || -f || -r) && ! -l } @_);

  die($E) if($?);

  foreach( split(/\n\r?|\r/, $R) ){
    my($val, $key) = split(/\s+/, $_, 2);
    $attr{$key} = (_calcBitMask($val)||"0 but true");
  }

  my @mask = @attr{@_};

  return wantarray ? @mask : $mask[0];
}

sub stat($) {
  my $lsattr = eval { lsattr($_[0]) };
  my $stat = CORE::stat($_[0]);
  if( $@ ){
    return wantarray ? () : 0;
  }
  else{
    return wantarray ? (CORE::stat(_), $lsattr) : $stat && ($@ ? 0 : 1);
  }
}

sub lstat($) {
  my $lsattr = eval { lsattr($_[0]) };
  my $stat = CORE::lstat($_[0]);
  if( $@ ){
    return wantarray ? () : 0;
  }
  else{
    return wantarray ? (CORE::stat(_), $lsattr) : $stat && ($@ ? 0 : 1);
  }
}

sub calcSymMask($) {
  my @F = _calcSymMask($_[0]);
  return @F if wantarray;

  $_ = join('', @F);
  y/+//d;
  s/(?<=-)[sucSiadAZXEIjtDT]//g;
  return $_;
}

sub _multi{
  my($WFH, $RFH, $EFH, $ERR, $OUT);

  #XXX splice to limited no. of files at a time?
  my $pid = open3(
		  $WFH = new IO::Handle,
		  $RFH = new IO::Handle,
		  $EFH = new IO::Handle,
		  @_
		 );

  $_->autoflush() for $RFH, $EFH;

  my $selector = IO::Select->new();
  $selector->add($RFH, $EFH);
  while( my @ready = $selector->can_read ){
    foreach my $fh ( @ready ){
      if( fileno($fh) == fileno($RFH) ){
	my $ret = $RFH->sysread($_, 1024);
	$OUT .= $_;
	$selector->remove($fh) unless $ret;
      }
      if( fileno($fh) == fileno($EFH) ){
	my $ret = $EFH->sysread($_, 1024);
	$ERR .= $_;
	$selector->remove($fh) unless $ret;
      }
    }
  }

  waitpid $pid, 0;

  return $OUT, $ERR;
}

sub _calcBitMask($) {
  my $bitmask;
  while ( my($key, $val) = each(%attr) ){
    $bitmask += (index($_[0], $key)>=0) * $val;
  }
  return $bitmask;
}

sub _calcSymMask($) {
  my @mask;
  foreach ( sort { $attr{$a} <=> $attr{$b} } keys %attr ){
    push @mask, ($_[0] & $attr{$_} ? "+$_" : "-$_");
  }
  return @mask;
}

1;
__END__