summaryrefslogtreecommitdiffstats
path: root/lib/MDK/Common/File.pm
diff options
context:
space:
mode:
authorPascal Rigaux <pixel@mandriva.com>2007-04-25 15:08:17 +0000
committerPascal Rigaux <pixel@mandriva.com>2007-04-25 15:08:17 +0000
commit1a06fa7e4a300880848047118f0adba68d38348d (patch)
treee6b01d6f4feae969f9905d5245648532db254c42 /lib/MDK/Common/File.pm
parente895f6b48826f09aeaada321d03a1d10548fc9ce (diff)
downloadperl-MDK-Common-1a06fa7e4a300880848047118f0adba68d38348d.tar
perl-MDK-Common-1a06fa7e4a300880848047118f0adba68d38348d.tar.gz
perl-MDK-Common-1a06fa7e4a300880848047118f0adba68d38348d.tar.bz2
perl-MDK-Common-1a06fa7e4a300880848047118f0adba68d38348d.tar.xz
perl-MDK-Common-1a06fa7e4a300880848047118f0adba68d38348d.zip
re-sync after the big svn loss
Diffstat (limited to 'lib/MDK/Common/File.pm')
-rw-r--r--lib/MDK/Common/File.pm332
1 files changed, 332 insertions, 0 deletions
diff --git a/lib/MDK/Common/File.pm b/lib/MDK/Common/File.pm
new file mode 100644
index 0000000..effea87
--- /dev/null
+++ b/lib/MDK/Common/File.pm
@@ -0,0 +1,332 @@
+package MDK::Common::File;
+
+=head1 NAME
+
+MDK::Common::File - miscellaneous file/filename manipulation functions
+
+=head1 SYNOPSIS
+
+ use MDK::Common::File qw(:all);
+
+=head1 EXPORTS
+
+=over
+
+=item dirname(FILENAME)
+
+=item basename(FILENAME)
+
+returns the dirname/basename of the file name
+
+=item cat_(FILES)
+
+returns the files contents: in scalar context it returns a single string, in
+array context it returns the lines.
+
+If no file is found, undef is returned
+
+=item cat_or_die(FILENAME)
+
+same as C<cat_> but dies when something goes wrong
+
+=item cat_utf8(FILES)
+
+same as C(<cat_>) but reads utf8 encoded strings
+
+=item cat_utf8_or_die(FILES)
+
+same as C(<cat_or_die>) but reads utf8 encoded strings
+
+=item cat__(FILEHANDLE REF)
+
+returns the file content: in scalar context it returns a single string, in
+array context it returns the lines
+
+=item output(FILENAME, LIST)
+
+creates a file and outputs the list (if the file exists, it is clobbered)
+
+=item output_utf8(FILENAME, LIST)
+
+same as C(<output>) but writes utf8 encoded strings
+
+=item secured_output(FILENAME, LIST)
+
+likes output() but prevents insecured usage (it dies if somebody try
+to exploit the race window between unlink() and creat())
+
+=item append_to_file(FILENAME, LIST)
+
+add the LIST at the end of the file
+
+=item output_p(FILENAME, LIST)
+
+just like C<output> but creates directories if needed
+
+=item output_with_perm(FILENAME, PERMISSION, LIST)
+
+same as C<output_p> but sets FILENAME permission to PERMISSION (using chmod)
+
+=item mkdir_p(DIRNAME)
+
+creates the directory (make parent directories as needed)
+
+=item rm_rf(FILES)
+
+remove the files (including sub-directories)
+
+=item cp_f(FILES, DEST)
+
+just like "cp -f"
+
+=item cp_af(FILES, DEST)
+
+just like "cp -af"
+
+=item linkf(SOURCE, DESTINATION)
+
+=item symlinkf(SOURCE, DESTINATION)
+
+=item renamef(SOURCE, DESTINATION)
+
+same as link/symlink/rename but removes the destination file first
+
+=item touch(FILENAME)
+
+ensure the file exists, set the modification time to current time
+
+=item all(DIRNAME)
+
+returns all the file in directory (except "." and "..")
+
+=item all_files_rec(DIRNAME)
+
+returns all the files in directory and the sub-directories (except "." and "..")
+
+=item glob_(STRING)
+
+simple version of C<glob>: doesn't handle wildcards in directory (eg:
+*/foo.c), nor special constructs (eg: [0-9] or {a,b})
+
+=item substInFile { CODE } FILENAME
+
+executes the code for each line of the file. You can know the end of the file
+is reached using C<eof>
+
+=item expand_symlinks(FILENAME)
+
+expand the symlinks in the absolute filename:
+C<expand_symlinks("/etc/X11/X")> gives "/usr/X11R6/bin/XFree86"
+
+=item openFileMaybeCompressed(FILENAME)
+
+opens the file and returns the file handle. If the file is not found, tries to
+gunzip the file + .gz
+
+=item catMaybeCompressed(FILENAME)
+
+cat_ alike. If the file is not found, tries to gunzip the file + .gz
+
+=back
+
+=head1 SEE ALSO
+
+L<MDK::Common>
+
+=cut
+
+
+use Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(dirname basename cat_ cat_or_die cat__ output output_p output_with_perm append_to_file linkf symlinkf renamef mkdir_p rm_rf cp_f cp_af touch all all_files_rec glob_ substInFile expand_symlinks openFileMaybeCompressed catMaybeCompressed);
+our %EXPORT_TAGS = (all => [ @EXPORT_OK ]);
+
+sub dirname { local $_ = shift; s|[^/]*/*\s*$||; s|(.)/*$|$1|; $_ || '.' }
+sub basename { local $_ = shift; s|/*\s*$||; s|.*/||; $_ }
+sub cat_ { my @l = map { my $F; open($F, '<', $_) ? <$F> : () } @_; wantarray() ? @l : join '', @l }
+sub cat_utf8 { my @l = map { my $F; open($F, '<:utf8', $_) ? <$F> : () } @_; wantarray() ? @l : join '', @l }
+sub cat_or_die { open(my $F, '<', $_[0]) or die "can't read file $_[0]: $!\n"; my @l = <$F>; wantarray() ? @l : join '', @l }
+sub cat_utf8_or_die { open(my $F, '<:utf8', $_[0]) or die "can't read file $_[0]: $!\n"; my @l = <$F>; wantarray() ? @l : join '', @l }
+sub cat__ { my ($f) = @_; my @l = <$f>; wantarray() ? @l : join '', @l }
+sub output { my $f = shift; open(my $F, ">$f") or die "output in file $f failed: $!\n"; print $F $_ foreach @_; 1 }
+sub output_utf8 { my $f = shift; open(my $F, '>:utf8', $f) or die "output in file $f failed: $!\n"; print $F $_ foreach @_; 1 }
+sub append_to_file { my $f = shift; open(my $F, ">>$f") or die "output in file $f failed: $!\n"; print $F $_ foreach @_; 1 }
+sub output_p { my $f = shift; mkdir_p(dirname($f)); output($f, @_) }
+sub output_with_perm { my ($f, $perm, @l) = @_; mkdir_p(dirname($f)); output($f, @l); chmod $perm, $f }
+sub linkf { unlink $_[1]; link $_[0], $_[1] }
+sub symlinkf { unlink $_[1]; symlink $_[0], $_[1] }
+sub renamef { unlink $_[1]; rename $_[0], $_[1] }
+
+sub secured_output {
+ my ($f, @l) = @_;
+ require POSIX;
+ unlink($f);
+ sysopen(my $F, $f, POSIX::O_CREAT() | POSIX::O_EXCL() | POSIX::O_RDWR()) or die "secure output in file $f failed: $! $@\n";
+ print $F $_ foreach @l;
+ 1;
+}
+
+sub mkdir_p {
+ my ($dir) = @_;
+ if (-d $dir) {
+ # nothing to do
+ } elsif (-e $dir) {
+ die "mkdir: error creating directory $dir: $dir is a file and i won't delete it\n";
+ } else {
+ mkdir_p(dirname($dir));
+ mkdir($dir, 0755) or die "mkdir: error creating directory $dir: $!\n";
+ }
+ 1;
+}
+
+sub rm_rf {
+ foreach (@_) {
+ if (!-l $_ && -d $_) {
+ rm_rf(glob_($_));
+ rmdir($_) or die "can't remove directory $_: $!\n";
+ } else {
+ unlink $_ or die "rm of $_ failed: $!\n";
+ }
+ }
+ 1;
+}
+
+sub cp_with_option {
+ my $option = shift @_;
+ my $keep_special = $option =~ /a/;
+
+ my $dest = pop @_;
+
+ @_ or return;
+ @_ == 1 || -d $dest or die "cp: copying multiple files, but last argument ($dest) is not a directory\n";
+
+ foreach my $src (@_) {
+ my $dest = $dest;
+ -d $dest and $dest .= '/' . basename($src);
+
+ unlink $dest;
+
+ if (-l $src && $keep_special) {
+ unless (symlink(readlink($src) || die("readlink failed: $!"), $dest)) {
+ warn "symlink: can't create symlink $dest: $!\n";
+ }
+ } elsif (-d $src) {
+ -d $dest or mkdir $dest, (stat($src))[2] or die "mkdir: can't create directory $dest: $!\n";
+ cp_with_option($option, glob_($src), $dest);
+ } elsif ((-b $src || -c $src) && $keep_special) {
+ my @stat = stat($src);
+ require MDK::Common::System;
+ MDK::Common::System::syscall_('mknod', $dest, $stat[2], $stat[6]) or die "mknod failed (dev $dest): $!";
+ } else {
+ 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 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) = @_;
+ my $linkdest;
+ #- try hard to keep symlinks as they were set
+ if (-l $file) {
+ my $targetfile = readlink $file;
+ unlink $file;
+ $linkdest = $file;
+ $file = $targetfile;
+ }
+ if (-s $file) {
+ local @ARGV = $file;
+ local $^I = '';
+ local $_;
+ while (<>) {
+ $_ .= "\n" if eof && !/\n/;
+ &$f($_);
+ print;
+ }
+ } else {
+ local *F; my $old = select F; # that way eof return true
+ local $_ = '';
+ &$f($_);
+ select $old;
+ eval { output($file, $_) };
+ }
+ $linkdest and symlink $file, $linkdest;
+}
+
+
+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;