File Coverage

blib/lib/File/Properties/Generic.pm

Criterion	Covered	Total	%
statement	90	112	80.3
branch	30	52	57.6
condition	2	3	66.6
subroutine	21	23	91.3
pod	11	11	100.0
total	154	201	76.6

# ----------------------------------------------------------------------------
#
# This module provides a class representing properties of a generic
# disk file.
#
# Copyright © 2010,2011 Brendt Wohlberg
# See distribution LICENSE file for license details.
#
# Most recent modification: 5 November 2011
#
# ----------------------------------------------------------------------------

package File::Properties::Generic;
our $VERSION = 0.01;

use File::Properties::Error;

require 5.005;
use strict;
use warnings;
use Error qw(:try);
use Cwd;
use File::stat;
use Fcntl ':mode';
use File::Spec;
use DirHandle;

# This approach copied from File::Spec
my $OSTypes = {MacOS   => 'Mac',   MSWin32 => 'Win32',
	       os2     => 'OS2',   VMS     => 'VMS',
	       epoc    => 'Epoc',  NetWare => 'Win32',
	       symbian => 'Win32', dos     => 'OS2',
	       cygwin  => 'Cygwin'};
my $OSType = $OSTypes->{$^O} || 'Unix';
# Flag indicating whether stat is fully supported. Currently only set
# true for Unix, since other operating systems not available for
# testing.
our $FullStatSupport = ($OSType eq 'Unix')?1:0;


# ----------------------------------------------------------------------------
# Constructor
# ----------------------------------------------------------------------------
sub new {
  my $this = shift;
  my $clss = ref($this) || $this;
  my $self = {};
  bless $self, $clss;
  $self->_init(@_);
  return $self;
}


# ----------------------------------------------------------------------------
# Initialiser
# ----------------------------------------------------------------------------
sub _init {
  my $self = shift;
  my $path = shift; # File path
  my $fpcr = shift; # File::Properties::Cache reference

  # Ensure path specified
  throw File::Properties::Error("Path is not defined")
    if not defined $path;
  # Ensure specified path is readable
  throw File::Properties::Error("Path $path is not readable")
    if not -r $path;
  # Convert specified path to canonical, absolute path
  $self->path(Cwd::realpath($path));
  ## Get file properties via stat call
  my $fstt = stat($path);
  throw File::Properties::Error("Stat failed on $path") if not defined $fstt;
  $self->device($fstt->dev) if ($FullStatSupport);
  $self->inode($fstt->ino) if ($FullStatSupport);
  $self->size($fstt->size);
  $self->mtime($fstt->mtime);
  $self->mode($fstt->mode);
  ## If specified path is a directory, construct child properties
  ## objects for each directory entry
  if ($self->isdir) {
    $self->children($self->_scandir($path, $fpcr));
  } else {
    $self->children(undef);
  }
}


# ----------------------------------------------------------------------------
# Get file path
# ----------------------------------------------------------------------------
sub path {
  my $self = shift;

  $self->{'path'} = shift if (@_);
  return $self->{'path'};
}


# ----------------------------------------------------------------------------
# Get file device number
# ----------------------------------------------------------------------------
sub device {
  my $self = shift;

  if ($FullStatSupport) {
    $self->{'devc'} = shift if (@_);
    return $self->{'devc'};
  } else {
    throw File::Properties::Error("Stat not fully supported");
  }
}


# ----------------------------------------------------------------------------
# Get file inode number
# ----------------------------------------------------------------------------
sub inode {
  my $self = shift;

  if ($FullStatSupport) {
    $self->{'inod'} = shift if (@_);
    return $self->{'inod'};
  } else {
    throw File::Properties::Error("Stat not fully supported");
  }
}


# ----------------------------------------------------------------------------
# Get file size
# ----------------------------------------------------------------------------
sub size {
  my $self = shift;

  $self->{'size'} = shift if (@_);
  return $self->{'size'};
}


# ----------------------------------------------------------------------------
# Get file modification time
# ----------------------------------------------------------------------------
sub mtime {
  my $self = shift;

  $self->{'mtim'} = shift if (@_);
  return $self->{'mtim'};
}


# ----------------------------------------------------------------------------
# Get file mode
# ----------------------------------------------------------------------------
sub mode {
  my $self = shift;

  $self->{'mode'} = shift if (@_);
  return $self->{'mode'};
}


# ----------------------------------------------------------------------------
# Get directory content
# ----------------------------------------------------------------------------
sub children {
  my $self = shift;

  $self->{'chld'} = shift if (@_);
  return $self->{'chld'};
}



# ----------------------------------------------------------------------------
# Test whether file is a regular (plain) file
# ----------------------------------------------------------------------------
sub isreg {
  my $self = shift;

  return $FullStatSupport?S_ISREG($self->mode):(-f $self->path);
}


# ----------------------------------------------------------------------------
# Test whether file is a directory
# ----------------------------------------------------------------------------
sub isdir {
  my $self = shift;

  return $FullStatSupport?S_ISDIR($self->mode):(-d $self->path);
}


# ----------------------------------------------------------------------------
# Construct string description of object
# ----------------------------------------------------------------------------
sub string {
  my $self = shift;
  my $levl = shift;

  $levl = 0 if (!defined $levl);
  my $lpfx = ' ' x (2*$levl);
  my $s;
  $s = $lpfx . "Path: ".$self->path."\n";
  $s .= $lpfx . "Device: ".$self->device." Inode: ".$self->inode." "
    if $FullStatSupport;
  $s .= "Size: ".$self->size." MTime: ".$self->mtime."\n";
  $s .= $self->_dirstring($levl) if ($self->isdir);

  return $s;
}


# ----------------------------------------------------------------------------
# Scan a directory, constructing a hash mapping file basenames to
# File::Properties::Generic objects
# ----------------------------------------------------------------------------
sub _scandir {
  my $self = shift;
  my $path = shift; # Directory path
  my $fpcr = shift; # File::Properties::Cache reference

  throw File::Properties::Error("Path $path is not readable")
    if (not -r $path);
  throw File::Properties::Error("Path $path is not a directory")
    if (not -d $path);
  my $dh = new DirHandle $path;
  throw File::Properties::Error("Error constructing DirHandle for $path")
    if (!defined $dh);
  my $dhsh = {};
  my ($dp, $fp);
  ## Create File::Properties::Generic object for each directory entry
  while (defined($dp = $dh->read)) {
    # Skip . and .. directory entries
    next if ($dp =~ /^\.{1,2}$/);
    # Total path of current directory entry
    $fp = File::Spec->catdir($path, $dp);
    # Add hash entry for current directory entry
    $dhsh->{$dp} = $self->new($fp, $fpcr);
  }
  return $dhsh;
}


# ----------------------------------------------------------------------------
# Construct a string description of an object representing a directory file
# ----------------------------------------------------------------------------
sub _dirstring {
  my $self = shift;
  my $levl = shift;

  $levl = 0 if (!defined $levl);
  my $s = '';
  my $chsh = $self->children;
  if (defined $chsh) {
    my $chld;
    foreach $chld ( sort keys %$chsh ) {
      $s .= $chsh->{$chld}->string($levl + 1);
    }
  }
  return $s;
}


# ----------------------------------------------------------------------------
# End of method definitions
# ----------------------------------------------------------------------------


1;
__END__