view release on metacpan or  search on metacpan

lib/ChordPro/Files.pm  view on Meta::CPAN

}

sub _fs_test( $test, $name ) {
    return Win32::LongPath::testL( $test, $name ) if is_msw;

    my $uname = $name;
    $uname = encode_utf8($name) if utf8::is_utf8($uname);

    if    ( $test eq 'b' ) { return -b $uname }
    elsif ( $test eq 'c' ) { return -c $uname }
    elsif ( $test eq 'd' ) { return -d $uname }
    elsif ( $test eq 'e' ) { return -e $uname }
    elsif ( $test eq 'f' ) { return -f $uname }
    elsif ( $test eq 'l' ) { return -l $uname }
    elsif ( $test eq 'o' ) { return -o $uname }
    elsif ( $test eq 'O' ) { return -O $uname }
    elsif ( $test eq 'r' ) { return -r $uname }
    elsif ( $test eq 'R' ) { return -R $uname }
    elsif ( $test eq 's' ) { return -s $uname }
    elsif ( $test eq 'w' ) { return -w $uname }
    elsif ( $test eq 'W' ) { return -W $uname }
    elsif ( $test eq 'x' ) { return -x $uname }
    elsif ( $test eq 'X' ) { return -X $uname }
    elsif ( $test eq 'z' ) { return -z $uname }
    else { die("Invalid test '$test' for $name\n") }
}

push( @EXPORT, qw(fs_test) );

sub fs_unlink( $name ) {

    return Win32::LongPath::unlinkL($name) if is_msw;

    my $uname = $name;
    $uname = encode_utf8($name) if utf8::is_utf8($uname);
    unlink($uname);
}

push( @EXPORT, qw(fs_unlink) );

sub fs_find( $folder, $opts = {} ) {

    my $filter = $opts->{filter} // qr/[.]/i;
    my $recurse = $opts->{recurse} // 1;
    $opts->{subfolders} = 0;

    unless ( is_msw ) {
	my $ufolder = $folder;
	$ufolder = encode_utf8($folder) if utf8::is_utf8($folder);

	use File::Find qw(find);
	my @files;

	find sub {
	    if ( -d && $File::Find::name ne $folder ) {
		$File::Find::prune = !$recurse;
		$opts->{subfolders} = 1;
	    }
	    elsif ( -s _ && $_ =~ $filter ) {
		my $i = 0;
		my @st = stat(_);
		push( @files,
		      { name => decode_utf8($File::Find::name =~ s;^\Q$ufolder\E/?;;r),
			map { $_ => $st[$i++] }
			qw{ dev ino mode nlink uid gid rdev size
			    atime mtime ctime blksize blocks }
		      } );
	    }
	}, $ufolder;

	@files = sort { $a->{name} cmp $b->{name} } @files;
	return \@files;
    }

    sub search_tree( $path, $opts, $folder ) {

	my $filter = $opts->{filter} // qr/[.]/i;
	my $recurse = $opts->{recurse} // 1;
	my $dir = Win32::LongPath->new;
	my @files;
	$dir->opendirL($path)
	  or die ("$path: $^E\n");

	foreach my $file ( $dir->readdirL ) {
	    # Skip parent dir.
	    next if $file eq '..';
	    # Get file stats.
	    my $name = $file eq '.' ? $path : "$path/$file";
	    my $stat = Win32::LongPath::lstatL($name)
	      or die( "stat($name,", Win32::LongPath::getcwdL(), "): $^E\n" );

	    # Recurse if dir.
	    if (    ( $file ne '.' )
		 && ( ($stat->{attribs}
		       & ( Win32::LongPath::FILE_ATTRIBUTE_DIRECTORY()
			   | Win32::LongPath::FILE_ATTRIBUTE_REPARSE_POINT() ) )
		      == Win32::LongPath::FILE_ATTRIBUTE_DIRECTORY() ) ) {
		push( @files, @{ search_tree( $name, $opts, $folder ) } )
		  if $recurse;
		$opts->{subfolders} = 1;
		next;
	    }
	    $name =~ s;^\Q$folder\E/?;;;
	    push( @files, { #%$stat,
			    name => $name,
			    full => Win32::LongPath::abspathL($name) } )
	      if $file =~ $filter;
	}

	$dir->closedirL;
	return \@files;
    }

    return [ sort { $a->{name} cmp $b->{name} }
	     @{ search_tree( $folder, $opts, $folder ) } ];

}

push( @EXPORT, qw(fs_find) );

sub fs_copy( $from, $to ) {
    return Win32::LongPath::copyL( $from, $to ) if is_msw;

    $to   = encode_utf8($to)   if utf8::is_utf8($to);
    $from = encode_utf8($from) if utf8::is_utf8($from);

    use File::Copy;
    copy( $from, $to );
}

push( @EXPORT, qw(fs_copy) );

# Wrapper for File::LoadLines.

sub fs_load( $name, $opts = {} ) {

    use File::LoadLines;

    $opts->{fail} //= "soft";

    my $ret;
    eval {
	if ( is_ref($name) || $name =~ m;^\w\w+:; ) {
	    $ret = loadlines( $name, $opts );
	}
	else {
	    my $fd = $name eq '-' ? \*STDIN : fs_open($name);
	    $ret = loadlines( $fd, $opts );
	    $opts->{_filesource} = $name;
	}