view release on metacpan or  search on metacpan

lib/File/Dir/Dumper/Scanner.pm  view on Meta::CPAN

sub _up_to_level
{
    my $self = shift;
    my $target_level = shift;

    my $last_result = $self->_last_result();

    for my $level (
        reverse($target_level .. $#{$last_result->dir_components()})
    )
    {
        $self->_add(
            {
                type => "updir",
                depth => $level+1,
            }
        )
    }

    return;
}

sub _find_new_common_depth
{
    my $self = shift;

    my $result = $self->_result();
    my $last_result = $self->_last_result();

    my $depth = 0;

    my $upper_limit =
        min(
            scalar(@{$last_result->dir_components()}),
            scalar(@{$result->dir_components()}),
        );

    FIND_I:
    while ($depth < $upper_limit)
    {
        if ($last_result->dir_components()->[$depth] ne
            $result->dir_components()->[$depth]
        )
        {
            last FIND_I;
        }
    }
    continue
    {
        $depth++;
    }

    return $depth;
}

BEGIN
{
    if (os_is('Unix'))
    {
        *_my_getpwuid =
            sub {
                my $uid = shift; return scalar(getpwuid($uid));
            };
        *_my_getgrgid =
            sub {
                my $gid = shift; return scalar(getgrgid($gid));
            };
    }
    else
    {
        *_my_getpwuid = sub { return "unknown"; };
        *_my_getgrgid = sub { return "unknown"; };
    }
}

sub _get_user_name
{
    my $self = shift;
    my $uid = shift;

    if (!exists($self->_user_cache()->{$uid}))
    {
        $self->_user_cache()->{$uid} = _my_getpwuid($uid);
    }

    return $self->_user_cache()->{$uid};
}

sub _get_group_name
{
    my $self = shift;
    my $gid = shift;

    if (!exists($self->_group_cache()->{$gid}))
    {
        $self->_group_cache()->{$gid} = _my_getgrgid($gid);
    }

    return $self->_group_cache()->{$gid};
}

sub _calc_file_digests_key
{
    my ($self, $stat) = @_;

    my $digests = $self->_digests;

    if (!defined$digests)
    {
        return [];
    }
    my $result = $self->_result();
    my $path = $result->path;
    my $ret = $self->_digest_cache->get_digests(
        {
            path => $result->full_components,
            mtime => $stat->[9],
            digests => $digests,
            calc_cb => sub {
                my %ret;
                foreach my $d (@$digests)
                {
                    my $o = Digest->new($d);
                    open my $fh, '<', $path;
                    binmode $fh;
                    $o->addfile($fh);
                    $ret{$d} = $o->hexdigest;
                    close ($fh);
                }
                return \%ret;
            },
        }
    );
    return [digests => $ret,];
}

sub _calc_file_or_dir_token
{
    my $self = shift;

    my $result = $self->_result();

    my @stat = stat($result->path());