File Coverage

blib/lib/Test/Directory.pm

Criterion	Covered	Total	%
statement	177	177	100.0
branch	71	72	98.6
condition	15	15	100.0
subroutine	30	30	100.0
pod	19	19	100.0
total	312	313	99.6

package Test::Directory;

use strict;
use warnings;

use Carp;
use Fcntl;
use File::Spec;
use File::Temp;
use Test::Builder::Module;

our $VERSION = '0.051';
our @ISA = 'Test::Builder::Module';

##############################
# Constructor / Destructor
##############################

my $template = 'test-directory-tmp-XXXXX';

sub new {
    my $class = shift;
    my $dir = shift;
    my %opts = @_;

    if (defined $dir) {
      $dir = File::Spec->join(split '/', $dir);
      mkdir $dir or croak "Failed to create '$dir': $!";
    } else {
      $dir = File::Temp->newdir( $template, CLEANUP=>0, DIR=>'.' )->dirname;
    };

    my %self = (dir => $dir);
    bless \%self, $class;
}

sub DESTROY {
    $_[0]->clean;
}

##############################
# Utility Functions
##############################

sub name {
    my ($self,$path) = @_;
    my @path = split /\//, $path;
    my $file = pop @path;
    return @path ? File::Spec->catfile(@path,$file) : $file;
};

sub path {
    my ($self,$file) = @_;
    return defined($file)?
      File::Spec->catfile($self->{dir}, $self->name($file)):
      $self->{dir};
};


sub touch {
  my $self = shift;
  foreach my $file (@_) {
    my $path = $self->path($file);
    sysopen my($fh), $path, O_WRONLY|O_CREAT|O_EXCL
      or croak "$path: $!";
    $self->{files}{$file} = 1;
  };
};

sub create {
  my ($self, $file, %opt) = @_;
  my $path = $self->path($file);

  sysopen my($fh), $path, O_WRONLY|O_CREAT|O_EXCL
    or croak "$path: $!";

  $self->{files}{$file} = 1;

  if (defined $opt{content}) {
    print $fh $opt{content};
  };
  if (defined $opt{time}) {
    utime $opt{time}, $opt{time}, $path;
  };
  return $path;
}

sub mkdir {
  my ($self, $dir) = @_;
  my $path = $self->path($dir);
  mkdir($path) or croak "$path: $!";
  $self->{directories}{$dir} = 1;
}

sub check_file {
    my ($self,$file) = @_;
    my $rv;
    if (-f $self->path($file)) {
      $rv = $self->{files}{$file} = 1;
    } else {
      $rv = $self->{files}{$file} = 0;
    }
    return $rv;
}

sub check_directory {
    my ($self,$dir) = @_;
    my $rv;
    if (-d $self->path($dir)) {
      $rv = $self->{directories}{$dir} = 1;
    } else {
      $rv = $self->{directories}{$dir} = 0;
    }
    return $rv;
}

sub clean {
    my $self = shift;
    foreach my $file ( keys %{$self->{files}} ) {
    	unlink $self->path($file);
    };
    #get subdirs before parents
    foreach my $dir (sort {length($b) <=> length($a)}
		     keys %{$self->{directories}} ) {
      rmdir $self->path($dir);
    };
    my $rv = rmdir $self->{dir};
    carp "$self->{dir}: $1" unless $rv;
    return $rv;
}

sub _path_map {
    my $self = shift;
    my %path;
    while (my ($k,$v) = each %{$self->{files}}) {
	$path{ $self->name($k) } = $v;
    };
    while (my ($k,$v) = each %{$self->{directories}}) {
	$path{ $self->name($k) } = $v;
    };
    return \%path;
}

sub count_unknown {
    my $self = shift;
    my $path = $self->_path_map;
    opendir my($dh), $self->{dir} or croak "$self->{dir}: $!";

    my $count = 0;
    while (my $file = readdir($dh)) {
	next if $file eq '.';
	next if $file eq '..';
	next if $path->{$file};
	++ $count;
    }
    return $count;
};

sub count_missing {
    my $self = shift;

    my $count = 0;
    while (my($file,$has) = each %{$self->{files}}) {
	++ $count if ($has and not(-f $self->path($file)));
    }
    while (my($file,$has) = each %{$self->{directories}}) {
	++ $count if ($has and not(-d $self->path($file)));
    }
    return $count;
}


sub remove_files {
  my $self = shift;
  my $count = 0;
  foreach my $file (@_) {
    my $path = $self->path($file);
    $self->{files}{$file} = 0;
    $count += unlink($path);
  }
  return $count;
}

sub remove_directories {
  my $self = shift;
  my $count = 0;
  foreach my $file (@_) {
    my $path = $self->path($file);
    $self->{directories}{$file} = 0;
    $count ++ if rmdir($path);
  }
  return $count;
}

##############################
# Test Functions
##############################

sub has {
    my ($self,$file,$text) = @_;
    $text = "Has file $file." unless defined $text;
    $self->builder->ok( $self->check_file($file), $text );
}

sub hasnt {
    my ($self,$file,$text) = @_;
    $text = "Doesn't have file $file." unless defined $text;
    $self->builder->ok( not($self->check_file($file)), $text );
}

sub has_dir {
    my ($self,$file,$text) = @_;
    $text = "Has directory $file." unless defined $text;
    $self->builder->ok( $self->check_directory($file), $text );
}

sub hasnt_dir {
    my ($self,$file,$text) = @_;
    $text = "Doesn't have directory $file." unless defined $text;
    $self->builder->ok( not($self->check_directory($file)), $text );
}

sub clean_ok {
    my ($self,$text) = @_;
    $self->builder->ok($self->clean, $text);
}

sub _check_dir {
    my ($dir, $path, $unknown) = @_;
    opendir my($dh), $dir or croak "$dir: $!";

    while (my $file = readdir($dh)) {
	next if $file eq '.';
	next if $file eq '..';
	next if $path->{$file};
	push @$unknown, $file;
    }
};

sub _check_subdir {
    my ($self, $dir, $path, $unknown) = @_;
    opendir my($dh), $self->path($dir) or croak "$self->path(dir): $!";

    while (my $file = readdir($dh)) {
	next if $file eq '.';
	next if $file eq '..';
	my $name = $self->name("$dir/$file");
	next if $path->{ $name };
	push @$unknown, $name;
    }
};

sub is_ok {
    my $self = shift;
    my $name = shift;
    my $test = $self->builder;
    $name = "Directory is consistent" unless defined $name;

    my @miss;
    while (my($file,$has) = each %{$self->{files}}) {
	if ($has and not(-f $self->path($file))) {
	    push @miss, $file;
	}
    }
    my @miss_d;
    while (my($file,$has) = each %{$self->{directories}}) {
	if ($has and not(-d $self->path($file))) {
	    push @miss_d, $file;
	}
    }


    my $path = $self->_path_map;
    my @unknown;

    _check_dir($self->{dir}, $path, \@unknown);
    while (my($file,$has) = each %{$self->{directories}}) {
	my $dir = $self->path($file);
	if ($has and -d $dir) {
	    $self->_check_subdir($file, $path, \@unknown);
	}
    }

    my $rv = $test->ok((@miss+@unknown+@miss_d) == 0, $name);
    unless ($rv) {
	$test->diag("Missing file: $_") foreach @miss;
	$test->diag("Missing directory: $_") foreach @miss_d;
	$test->diag("Unknown file: $_") foreach @unknown;
    }
    return $rv;
}



1;
__END__