view release on metacpan or  search on metacpan

lib/Paranoid/Filesystem.pm  view on Meta::CPAN

%EXPORT_TAGS = ( all => [@EXPORT_OK], );

use constant PERMMASK => 0777;

#####################################################################
#
# Module code follows
#
#####################################################################

sub pmkdir ($;$\%) {

    # Purpose:  Simulates a 'mkdir -p' command in pure Perl
    # Returns:  True (1) if all targets were successfully created,
    #           False (0) if there are any errors
    # Usage:    $rv = pmkdir("/foo/{a1,b2}");
    # Usage:    $rv = pmkdir("/foo", 0750);
    # Usage:    $rv = pmkdir("/foo", 0750, %errors);

    my $path = shift;
    my $mode = shift;
    my $eref = shift || {};
    my ( $dirs, $directory, $subdir, @parts, $i );
    my $rv = 1;

    subPreamble( PDLEVEL1, '$;$\%', $path, $mode, $eref );

    # Create a glob object if we weren't handed one.
    if ( defined $path ) {
        $dirs =
            ref $path eq 'Paranoid::Glob'
            ? $path
            : Paranoid::Glob->new( globs => [$path] );
    }

    # Leave Paranoid::Glob's errors in place if there was a problem
    $rv = 0 unless defined $dirs;

    # Set and detaint mode
    if ($rv) {
        $mode = ptranslatePerms( defined $mode ? $mode : umask ^ PERMMASK );
        unless ( detaint( $mode, 'int' ) ) {
            Paranoid::ERROR =
                pdebug( 'invalid mode argument passed', PDLEVEL1 );
            $rv = 0;
        }
    }

    # Start creating directories
    if ($rv) {

        # Iterate over each directory in the glob
        foreach $directory (@$dirs) {
            pdebug( 'processing %s', PDLEVEL2, $directory );

            # Skip directories already present
            next if -d $directory;

            # Otherwise, split so we can backtrack to the first available
            # subdirectory and start creating subdirectories from there
            @parts = split m#/+#s, $directory;
            $i = $parts[0] eq '' ? 1 : 0;
            $i++ while $i < $#parts and -d join '/', @parts[ 0 .. $i ];
            while ( $i <= $#parts ) {
                $subdir = join '/', @parts[ 0 .. $i ];
                unless ( -d $subdir ) {
                    if ( mkdir $subdir, $mode ) {

                        # Make sure perms are applied
                        chmod $mode, $subdir;

                    } else {

                        # Error out and halt all work
                        Paranoid::ERROR = pdebug( 'failed to create %s: %s',
                            PDLEVEL1, $subdir, $! );
                        $rv = 0;
                        last;
                    }
                }
                $i++;
            }
        }
    }

    subPostamble( PDLEVEL1, '$', $rv );

    return $rv;
}

sub prm ($;\%) {

    # Purpose:  Simulates a "rm -f" command in pure Perl
    # Returns:  True (1) if all targets were successfully removed,
    #           False (0) if there are any errors
    # Usage:    $rv = prm("/foo");
    # Usage:    $rv = prm("/foo", %errors);

    my $target = shift;
    my $errRef = shift;
    my $rv     = 1;
    my ( $glob, $tglob, @fstat );

    subPreamble( PDLEVEL1, '$;\%', $target, $errRef );

    # Prep error hash
    $errRef = {} unless defined $errRef;
    %$errRef = ();

    # Create a glob object if we weren't handed one.
    if ( defined $target ) {
        $glob =
            ref $target eq 'Paranoid::Glob'
            ? $target
            : Paranoid::Glob->new( globs => [$target] );
    }
    $rv = 0 unless defined $glob;

    # Start removing files
    if ($rv) {