File-Find-Node

 view release on metacpan or  search on metacpan

lib/File/Find/Node.pm  view on Meta::CPAN

package File::Find::Node;

use 5.006;
use strict;
use warnings;
use Carp;

our $VERSION = '0.03';

#
# constructor
#

use constant PATH     =>  0;
use constant NAME     =>  1;
use constant LEVEL    =>  2;
use constant PRUNE    =>  3;
use constant FOLLOW   =>  4;
use constant PARENT   =>  5;
use constant PROCESS  =>  6;
use constant POSTPROC =>  7;
use constant FILTER   =>  8;
use constant ERRPROC  =>  9;
use constant STAT     => 10;
use constant ARG      => 11;
use constant USER     => 12;
use constant GROUP    => 13;
use constant MAXFORK  => 14;

sub new {
    my ($class, $path) = @_;
    defined($path) or $path = ".";
    $path =~ s{/+}{/}g;
    $path =~ s{/$}{} if $path ne "/";
    my $self = [
        $path,  # PATH
        $path,  # NAME
        0,      # LEVEL
        0,      # PRUNE
        0,      # FOLLOW
        undef,  # PARENT
        undef,  # PROCESS
        undef,  # POSTPROC
        undef,  # FILTER
        undef,  # ERRPROC
        undef,  # STAT
        undef,  # ARG
        {},     # USER  cache for getpwuid()
        {},     # GROUP cache for getgrgid()
        0       # MAXFORK
    ];
    $self->[NAME] =~ s{.*/}{};
    bless($self);
}

#
# private object methods
#

# _error calls error callback function or calls carp().

sub _error {
    my ($self, $what) = @_;
    if ($self->[ERRPROC]) {
        $self->[ERRPROC]->($self, $what);
    }
    else {
        my $path = $self->[PATH];
        carp(__PACKAGE__, " - $what($path) - $!");
    }
}

# _cycle returns true if this directory is in the parent chain

sub _cycle {
    my $self = shift;
    my ($inum, $dev) = ($self->inum, $self->dev);
    for (my $p = $self->[PARENT]; $p; $p = $p->[PARENT]) {
        return 1 if $dev == $p->dev && $inum == $p->inum;
    }
    0;
}

#
# public object methods
#

sub process {
    my $self = shift;
    $self->[PROCESS] = shift;
    $self;
}

sub post_process {
    my $self = shift;
    $self->[POSTPROC] = shift;
    $self;
}

sub filter {
    my $self = shift;
    $self->[FILTER] = shift;
    $self;
}

sub error_process {
    my $self = shift;
    $self->[ERRPROC] = shift;

lib/File/Find/Node.pm  view on Meta::CPAN

}

sub level {
    shift->[LEVEL];
}

# These methods return saved stat info

sub stat {
    @{shift->[STAT]};
}

sub dev {
    shift->[STAT]->[0];
}

sub inum {
    shift->[STAT]->[1];
}

sub ino {
    shift->[STAT]->[1];
}

sub mode {
    shift->[STAT]->[2];
}

sub perm {
    shift->[STAT]->[2] & 07777;
}

sub type {
    my $idx = (shift->[STAT]->[2] >> 12) & 017;
    ("?", "p", "c", "?", "d", "?", "b", "?",
     "f", "?", "l", "?", "s", "?", "?", "?")[$idx];
}

sub links {
    shift->[STAT]->[3];
}

sub nlink {
    shift->[STAT]->[3];
}

sub uid {
    shift->[STAT]->[4];
}

sub gid {
    shift->[STAT]->[5];
}

sub user {
    my $self = shift;
    my $uid = $self->uid;
    if (exists($self->[USER]->{$uid})) {
        return $self->[USER]->{$uid};
    }
    my $user = getpwuid($uid);
    $self->[USER]->{$uid} = defined($user) ? $user : $uid;
}

sub group {
    my $self = shift;
    my $gid = $self->gid;
    if (exists($self->[GROUP]->{$gid})) {
        return $self->[GROUP]->{$gid};
    }
    my $group = getgrgid($gid);
    $self->[GROUP]->{$gid} = defined($group) ? $group : $gid;
}

sub rdev {
    shift->[STAT]->[6];
}

sub size {
    shift->[STAT]->[7];
}

sub atime {
    shift->[STAT]->[8];
}

sub mtime {
    shift->[STAT]->[9];
}

sub ctime {
    shift->[STAT]->[10];
}

sub blksize {
    shift->[STAT]->[11];
}

sub blocks {
    shift->[STAT]->[12];
}

# empty returns true for an empty directory or a zero length regular file,
# otherwise false.

sub empty {
    my $self = shift;
    my $ftype = $self->type;
    if ($ftype eq "f") {
        return $self->size == 0;
    }
    elsif ($ftype eq "d") {
        my $dirh;
        if (!opendir($dirh, $self->[PATH])) {
            $self->_error("opendir");
            return 0;
        }
        my $ret = 1;
        while (my $name = readdir($dirh)) {
            if ($name ne "." && $name ne "..") {
                $ret = 0;

lib/File/Find/Node.pm  view on Meta::CPAN

Returns the device number of the filesystem containing
the item.  You can determine when you cross mount points
with

  if ($f->parent &&  $f->dev != $f->parent->dev) { ... }

=item $f->inum

=item $f->ino

Returns the inode number.

=item $f->mode

Returns the mode bits.

=item $f->type

Returns a lower case letter indicating the type of the item:
  "f" - regular file
  "d" - directory
  "l" - symbolic link
  "b" - block device file
  "c" - character device file
  "p" - named pipe (FIFO)
  "s" - socket
  "?" - unknown (probably an error)

=item $f->perm

Returns the permission bits ($f->mode masked with 07777).
Here are the Unix permission bit definitions in octal:

            user  group other
          +------------------
  read    | 0400   040    04
  write   | 0200   020    02
  execute | 0100   010    01

  set user:   04000
  set group:  02000
  sticky:     01000

For example, to see if write is enabled for group or other:

  if (($f->perm & 022) != 0) { ... }

=item $f->links

=item $f->nlink

Returns the number of hard links.

=item $f->uid

Returns the user id number.

=item $f->user

Returns the user name or else returns the user id
number if getpwuid() fails.  Uses a cache to avoid
extra calls to getpwuid().

=item $f->gid

Returns the group id number.

=item $f->group

Returns the group name or else returns the group id
number if getgrgid() fails.  Uses a cache to avoid
extra calls to getgrgid().

=item $f->rdev

Returns the device number of a device file.

=item $f->size

Returns the size in bytes.

=item $f->atime

Returns the access time.

=item $f->mtime

Returns the modification time.

=item $f->ctime

Returns the inode change time.

=item $f->blksize

Returns the I/O block size of the containing filesystem.

=item $f->blocks

Returns the number of 512 byte blocks allocated for
the item.

=item $f->stat

Returns the array of saved stat information.

  @stat = $f->stat;

=item $f->refresh

Calls stat() or lstat() (depending on $f->follow) to refresh
the saved stat information.  Returns the object.  For
example, you may want to call $f->refresh after changing the
permissions of an object with chmod() or else $f->perm returns
the old saved permissions.

=back

=head1 Efficiency

File::Find::Node is both space and time efficient.  Although it
creates an object for each item in the traversal, at any given time