view release on metacpan or  search on metacpan

lib/MDK/Common/File.pm  view on Meta::CPAN

            open(my $F, $src) or die "can't open $src for reading: $!\n";
            open(my $G, "> $dest") or die "can't cp to file $dest: $!\n";
            local $_; while (<$F>) { print $G $_ }
            chmod((stat($src))[2], $dest);
        }
    }
    1;
}

sub cp_f  { cp_with_option('f', @_) }
sub cp_af { cp_with_option('af', @_) }
sub cp_afx { cp_same_filesystem_with_options(-1, 'af', @_) }

sub touch {
    my ($f) = @_;
    unless (-e $f) {
	my $F;
	open($F, ">$f");
    }
    my $now = time();
    utime $now, $now, $f;
}


sub all {
    my $d = shift;

    local *F;
    opendir F, $d or return;
    my @l = grep { $_ ne '.' && $_ ne '..' } readdir F;
    closedir F;

    @l;
}

sub all_files_rec {
    my ($d) = @_;

    map { $_, -d $_ ? all_files_rec($_) : () } map { "$d/$_" } all($d);
}

sub glob_ {
    my ($d, $f) = $_[0] =~ /\*/ ? (dirname($_[0]), basename($_[0])) : ($_[0], '*');

    $d =~ /\*/ and die "glob_: wildcard in directory not handled ($_[0])\n";
    ($f = quotemeta $f) =~ s/\\\*/.*/g;

    $d =~ m|/$| or $d .= '/';
    map { $d eq './' ? $_ : "$d$_" } grep { /^$f$/ } all($d);
}


sub substInFile(&@) {
    my ($f, $file) = @_;
    #FIXME we should follow symlinks, and fail in case of loop
    if (-l $file) {
        my $targetfile = readlink $file;
        $file = $targetfile;
    }
    if (-s $file) {
	local @ARGV = $file;
	local $^I = '.bak';
	local $_;
	while (<>) { 
	    $_ .= "\n" if eof && !/\n/;
	    &$f($_); 
	    print;
	}
	open(my $F, $file);
	fsync($F);
	unlink "$file$^I"; # remove old backup now that we have closed new file
    } else {
	#- special handling for zero-sized or nonexistent files
	#- because while (<>) will not do any iteration
	open(my $F, "+> $file") or return;
	#- "eof" without an argument uses the last file read
	my $dummy = <$F>;
	local $_ = '';
	&$f($_);
	print $F $_;
	fsync($F);
    }
}


sub concat_symlink {
    my ($f, $l) = @_;
    $l =~ m|^\.\./(/.*)| and return $1;

    $f =~ s|/$||;
    while ($l =~ s|^\.\./||) { 
	$f =~ s|/[^/]+$|| or die "concat_symlink: $f $l\n";
    }
    "$f/$l";
}
sub expand_symlinks {
    my ($first, @l) = split '/', $_[0];
    $first eq '' or die "expand_symlinks: $_[0] is relative\n";
    my ($f, $l);
    foreach (@l) {
	$f .= "/$_";
	$f = concat_symlink($f, "../$l") while $l = readlink $f;
    }
    $f;
}


sub openFileMaybeCompressed { 
    my ($f) = @_;
    -e $f || -e "$f.gz" or die "file $f not found";
    open(my $F, -e $f ? $f : "gzip -dc '$f.gz'|") or die "file $f is not readable";
    $F;
}
sub catMaybeCompressed { cat__(openFileMaybeCompressed($_[0])) }

1;