Perl/FAQ/Директории

Материал из Wiki.crossplatform.ru

Перейти к: навигация, поиск
Perl ·

Содержание

Introduction

#-----------------------------
@entry = stat("/usr/bin/vi") or die "Couldn't stat /usr/bin/vi : $!";
 
#-----------------------------
@entry = stat("/usr/bin")    or die "Couldn't stat /usr/bin : $!";
#-----------------------------
 
@entry = stat(INFILE)        or die "Couldn't stat INFILE : $!";
#-----------------------------
use File::stat;
 
$inode = stat("/usr/bin/vi");
$ctime = $inode->ctime;
$size  = $inode->size;
#-----------------------------
open( F, "< $filename" )
 
    or die "Opening $filename: $!\n";
unless (-s F && -T _) {
 
    die "$filename doesn't have text in it.\n";
}
#-----------------------------
opendir(DIRHANDLE, "/usr/bin") or die "couldn't open /usr/bin : $!";
 
while ( defined ($filename = readdir(DIRHANDLE)) ) {
 
    print "Inside /usr/bin is something called $filename\n";
}
closedir(DIRHANDLE);
#-----------------------------

Getting and Setting Timestamps

#-----------------------------
($READTIME, $WRITETIME) = (stat($filename))[8,9];
 
utime($NEWREADTIME, $NEWWRITETIME, $filename);
#-----------------------------
$SECONDS_PER_DAY = 60 * 60 * 24;
 
($atime, $mtime) = (stat($file))[8,9];
$atime -= 7 * $SECONDS_PER_DAY;
 
$mtime -= 7 * $SECONDS_PER_DAY;
 
utime($atime, $mtime, $file)
    or die "couldn't backdate $file by a week w/ utime: $!";
 
#-----------------------------
$mtime = (stat $file)[9];
utime(time, $mtime, $file);
#-----------------------------
 
use File::stat;
utime(time, stat($file)->mtime, $file);
 
#-----------------------------
# download the following standalone program
#!/usr/bin/perl -w
# uvi - vi a file without changing its access times
 
$file = shift or die "usage: uvi filename\n";
($atime, $mtime) = (stat($file))[8,9];
 
system($ENV{EDITOR} || "vi", $file);
utime($atime, $mtime, $file)
 
    or die "couldn't restore $file to orig times: $!";
 
#-----------------------------

Deleting a File

#-----------------------------
unlink($FILENAME)                 or die "Can't delete $FILENAME: $!\n";
 
unlink(@FILENAMES) == @FILENAMES  or die "Couldn't unlink all of @FILENAMES: $!\n";
 
#-----------------------------
unlink($file) or die "Can't unlink $file: $!";
#-----------------------------
unless (($count = unlink(@filelist)) == @filelist) {
 
    warn "could only delete $count of "
            . (@filelist) . " files";
}
 
#-----------------------------

Copying or Moving a File

#-----------------------------
use File::Copy;
copy($oldfile, $newfile);
#-----------------------------
open(IN,  "< $oldfile")                     or die "can't open $oldfile: $!";
 
open(OUT, "> $newfile")                     or die "can't open $newfile: $!";
 
$blksize = (stat IN)[11] || 16384;          # preferred block size?
 
while ($len = sysread IN, $buf, $blksize) {
    if (!defined $len) {
 
        next if $! =~ /^Interrupted/;       # ^Z and fg
        die "System read error: $!\n";
    }
 
    $offset = 0;
    while ($len) {          # Handle partial writes.
        defined($written = syswrite OUT, $buf, $len, $offset)
 
            or die "System write error: $!\n";
        $len    -= $written;
        $offset += $written;
    };
 
}
 
close(IN);
close(OUT);
#-----------------------------
system("cp $oldfile $newfile");       # unix
 
system("copy $oldfile $newfile");     # dos, vms
#-----------------------------
use File::Copy;
 
copy("datafile.dat", "datafile.bak")
 
    or die "copy failed: $!";
 
move("datafile.new", "datafile.dat")
    or die "move failed: $!";
 
#-----------------------------

Recognizing Two Names for the Same File

#-----------------------------
%seen = ();
 
sub do_my_thing {
 
    my $filename = shift;
    my ($dev, $ino) = stat $filename;
 
    unless ($seen{$dev, $ino}++) {
        # do something with $filename because we haven't
        # seen it before
 
    }
}
#-----------------------------
foreach $filename (@files) {
    ($dev, $ino) = stat $filename;
 
    push( @{ $seen{$dev,$ino} }, $filename);
}
 
foreach $devino (sort keys %seen) {
    ($dev, $ino) = split(/$;/o, $devino);
 
    if (@{$seen{$devino}} > 1) {
 
        # @{$seen{$devino}} is a list of filenames for the same file
    }
}
#-----------------------------

Processing All Files in a Directory

#-----------------------------
opendir(DIR, $dirname) or die "can't opendir $dirname: $!";
 
while (defined($file = readdir(DIR))) {
    # do something with "$dirname/$file"
 
}
closedir(DIR);
#-----------------------------
$dir = "/usr/local/bin";
print "Text files in $dir are:\n";
 
opendir(BIN, $dir) or die "Can't open $dir: $!";
while( defined ($file = readdir BIN) ) {
 
    print "$file\n" if -T "$dir/$file";
}
closedir(BIN);
 
#-----------------------------
while ( defined ($file = readdir BIN) ) {
 
    next if $file =~ /^\.\.?$/;     # skip . and ..
    # ...
}
#-----------------------------
use DirHandle;
 
sub plainfiles {
   my $dir = shift;
   my $dh = DirHandle->new($dir)   or die "can't opendir $dir: $!";
 
   return sort                     # sort pathnames
          grep {    -f     }       # choose only "plain" files
 
          map  { "$dir/$_" }       # create full paths
          grep {  !/^\./   }       # filter out dot files
 
          $dh->
read()
;             # read all entries
}
#-----------------------------

Globbing, or Getting a List of Filenames Matching a Pattern

#-----------------------------
@list = <*.c>;
 
@list = glob("*.c");
#-----------------------------
opendir(DIR, $path);
@files = grep { /\.c$/ } readdir(DIR);
 
closedir(DIR);
#-----------------------------
use File::KGlob;
 
@files = glob("*.c");
 
#-----------------------------
@files = grep { /\.[ch]$/i } readdir(DH);
 
#-----------------------------
use DirHandle;
 
$dh = DirHandle->new($path)   or die "Can't open $path : $!\n";
 
@files = grep { /\.[ch]$/i } $dh->read();
 
#-----------------------------
opendir(DH, $dir)        or die "Couldn't open $dir for reading: $!";
 
@files = ();
 
while( defined ($file = readdir(DH)) ) {
    next unless /\.[ch]$/i;
 
    my $filename = "$dir/$file";
    push(@files, $filename) if -T $file;
 
}
#-----------------------------
@dirs = map  { $_->[1] }                # extract pathnames
 
        sort { $a->[0] <=> $b->[0] }    # sort names numeric
 
        grep { -d $_->[1] }             # path is a dir
        map  { [ $_, "$path/$_" ] }     # form (name, path)
 
        grep { /^\d+$/ }                # just numerics
        readdir(DIR);                   # all files
#-----------------------------

Processing All Files in a Directory Recursively

#-----------------------------
 
use File::Find;
sub process_file {
    # do whatever;
}
find(\&process_file, @DIRLIST);
 
#-----------------------------
@ARGV = qw(.) unless @ARGV;
use File::Find;
 
find sub { print $File::Find::name, -d && '/', "\n" }, @ARGV;
 
#-----------------------------
use File::Find;
@ARGV = ('.') unless @ARGV;
 
my $sum = 0;
find sub { $sum += -s }, @ARGV;
 
print "@ARGV contains $sum bytes\n";
#-----------------------------
use File::Find;
@ARGV = ('.') unless @ARGV;
 
my ($saved_size, $saved_name) = (-1, '');
sub biggest {
 
    return unless -f && -s _ > $saved_size;
    $saved_size = -s _;
 
    $saved_name = $File::Find::name;
}
find(\&biggest, @ARGV);
print "Biggest file $saved_name in @ARGV is $saved_size bytes long.\n";
 
#-----------------------------
use File::Find;
@ARGV = ('.') unless @ARGV;
 
my ($age, $name);
sub youngest {
    return if defined $age && $age > (stat($_))[9];
 
    $age = (stat(_))[9];
    $name = $File::Find::name;
}
find(\&youngest, @ARGV);
 
print "$name " . scalar(localtime($age)) . "\n";
#-----------------------------
# download the following standalone program
 
#!/usr/bin/perl -lw
# fdirs - find all directories
@ARGV = qw(.) unless @ARGV;
use File::Find ();
 
sub find(&@) { &File::Find::find }
*name = *File::Find::name;
find { print $name if -d } @ARGV;
 
#-----------------------------
find sub { print $File::Find::name if -d }, @ARGV;
 
#-----------------------------
find { print $name if -d } @ARGV;
#-----------------------------

Removing a Directory and Its Contents

#-----------------------------
# download the following standalone program
#!/usr/bin/perl
# rmtree1 - remove whole directory trees like rm -r
use File::Find qw(finddepth);
die "usage: $0 dir ..\n" unless @ARGV;
 
*name = *File::Find::name;
finddepth \&zap, @ARGV;
sub zap {
    if (!-l && -d _) {
 
        print "rmdir $name\n";
        rmdir($name)  or warn "couldn't rmdir $name: $!";
 
    } else {
        print "unlink $name";
        unlink($name) or warn "couldn't unlink $name: $!";
 
    }
}
 
#-----------------------------
# download the following standalone program
#!/usr/bin/perl
# rmtree2 - remove whole directory trees like rm -r
use File::Path;
die "usage: $0 dir ..\n" unless @ARGV;
 
    foreach $dir (@ARGV) {
    rmtree($dir);
 
}
 
#-----------------------------

Renaming Files

#-----------------------------
foreach $file (@NAMES) {
    my $newname = $file;
 
    # change $newname
    rename($file, $newname) or  
        warn "Couldn't rename $file to $newname: $!\n";
 
}
#-----------------------------
# download the following standalone program
#!/usr/bin/perl -w
# rename - Larry's filename fixer
$op = shift or die "Usage: rename expr [files]\n";
chomp(@ARGV = <STDIN>) unless @ARGV;
 
for (@ARGV) {
    $was = $_;
    eval $op;
 
    die $@ if $@;
    rename($was,$_) unless $was eq $_;
 
}
 
#-----------------------------
#% rename 's/\.orig$//'  *.orig
#% rename 'tr/A-Z/a-z/ unless /^Make/'  *
#% rename '$_ .= ".bad"'  *.f
#% rename 'print "$_: "; s/foo/bar/ if <STDIN> =~ /^y/i'  *
#% find /tmp -name '*~' -print | rename 's/^(.+)~$/.#$1/'
#-----------------------------
#% rename 'use locale; $_ = lc($_) unless /^Make/' *
#-----------------------------

Splitting a Filename into Its Component Parts

#-----------------------------
use File::Basename;
 
$base = basename($path);
$dir  = dirname($path);
($base, $dir, $ext) = fileparse($path);
 
#-----------------------------
$path = '/usr/lib/libc.a';
$file = basename($path);    
$dir  = dirname($path);     
 
print "dir is $dir, file is $file\n";
# dir is /usr/lib, file is libc.a
#-----------------------------
$path = '/usr/lib/libc.a';
($name,$dir,$ext) = fileparse($path,'\..*');
 
print "dir is $dir, name is $name, extension is $ext\n";
# dir is /usr/lib/, name is libc, extension is .a
#-----------------------------
fileparse_set_fstype("MacOS");
$path = "Hard%20Drive:System%20Folder:README.txt";
($name,$dir,$ext) = fileparse($path,'\..*');
 
print "dir is $dir, name is $name, extension is $ext\n";
# dir is Hard%20Drive:System%20Folder, name is README, extension is .txt
#-----------------------------
sub extension {
    my $path = shift;
 
    my $ext = (fileparse($path,'\..*'))[2];
    $ext =~ s/^\.//;
 
    return $ext;
}
#-----------------------------

Program: symirror

#-----------------------------
# download the following standalone program
#!/usr/bin/perl -w
# symirror - build spectral forest of symlinks
use strict;
 
use File::Find;
use Cwd;
 
my ($srcdir, $dstdir);
 
my $cwd = getcwd();
die "usage: $0 realdir mirrordir" unless @ARGV == 2;
 
for (($srcdir, $dstdir) = @ARGV) {
    my $is_dir = -d;
 
    next if $is_dir;                        # cool
    if (defined ($is_dir)) {
 
        die "$0: $_ is not a directory\n";
    } else {                                # be forgiving
        mkdir($dstdir, 07777) or die "can't mkdir $dstdir: $!";
 
    }
} continue {
    s#^(?!/)#$cwd/#;                        # fix relative paths
}
 
chdir $srcdir;
 
find(\&wanted, '.');
 
sub wanted {
    my($dev, $ino, $mode) = lstat($_);
 
    my $name = $File::Find::name;
    $mode &= 07777;                 # preserve directory permissions
    $name =~ s!^\./!!;              # correct name
 
    if (-d _) {                     # then make a real directory
        mkdir("$dstdir/$name", $mode)
 
            or die "can't mkdir $dstdir/$name: $!";
    } else {                        # shadow everything else
        symlink("$srcdir/$name", "$dstdir/$name")
 
            or die "can't symlink $srcdir/$name to $dstdir/$name: $!";
    }
}
 
#-----------------------------

Program: lst

#-----------------------------
#% lst -l /etc
#12695 0600      1     root    wheel      512 Fri May 29 10:42:41 1998 
 
#
#    /etc/ssh_random_seed
#
#12640 0644      1     root    wheel    10104 Mon May 25  7:39:19 1998 
#
#    /etc/ld.so.cache
#
#12626 0664      1     root    wheel    12288 Sun May 24 19:23:08 1998 
#
#    /etc/psdevtab
#
#12304 0644      1     root     root      237 Sun May 24 13:59:33 1998 
#
#    /etc/exports
#
#12309 0644      1     root     root     3386 Sun May 24 13:24:33 1998 
#
#    /etc/inetd.conf
#
#12399 0644      1     root     root    30205 Sun May 24 10:08:37 1998 
#
#    /etc/sendmail.cf
#
#18774 0644      1     gnat  perldoc     2199 Sun May 24  9:35:57 1998 
 
#
#    /etc/X11/XMetroconfig
#
#12636 0644      1     root    wheel      290 Sun May 24  9:05:40 1998 
#
#    /etc/mtab
#
#12627 0640      1     root     root        0 Sun May 24  8:24:31 1998 
#
#    /etc/wtmplock
#
#12310 0644      1     root  tchrist       65 Sun May 24  8:23:04 1998 
#
#    /etc/issue
#
#....
#-----------------------------
# download the following standalone program
#!/usr/bin/perl
# lst - list sorted directory contents (depth first)
 
use Getopt::Std;
 
use File::Find;
use File::stat;
use User::pwent;
use User::grent;
 
getopts('lusrcmi')    			or die <<DEATH;
Usage: $0 [-mucsril] [dirs ...]
 
 or    $0 -i [-mucsrl] < filelist
 
Input format:
    -i  read pathnames from stdin
Output format:
    -l  long listing
Sort on:
    -m  use mtime (modify time) [DEFAULT]
 
    -u  use atime (access time)
    -c  use ctime (inode change time)
 
    -s  use size for sorting
Ordering:
    -r  reverse sort
 
NB: You may only use select one sorting option at a time.
DEATH
 
unless ($opt_i || @ARGV) { @ARGV = ('.') }
 
if ($opt_c + $opt_u + $opt_s + $opt_m > 1) {
    die "can only sort on one time or size";
 
}
 
$IDX = 'mtime';
$IDX = 'atime' if $opt_u;
$IDX = 'ctime' if $opt_c;
 
$IDX = 'size'  if $opt_s;
 
$TIME_IDX = $opt_s ? 'mtime' : $IDX;
 
*name = *File::Find::name;  # forcibly import that variable
 
# the $opt_i flag tricks wanted into taking
# its filenames from ARGV instead of being
# called from find.
 
if ($opt_i) {
     *name = *_;  # $name now alias for $_
 
     while (<>) { chomp; &wanted; }   # ok, not stdin really
 
}  else {
    find(\&wanted, @ARGV);
}
 
# sort the files by their cached times, youngest first
@skeys = sort { $time{$b} <=> $time{$a} } keys %time;
 
# but flip the order if -r was supplied on command line
@skeys = reverse @skeys if $opt_r;
 
for (@skeys) {
 
    unless ($opt_l) {  # emulate ls -l, except for permissions
        print "$_\n";
        next;
 
    }
    $now = localtime $stat{$_}->$TIME_IDX();
    printf "%6d %04o %6d %8s %8s %8d %s %s\n",
    	$stat{$_}->ino(),
    	$stat{$_}->mode() & 07777,
    	$stat{$_}->nlink(),
    	user($stat{$_}->uid()),
    	group($stat{$_}->gid()),
    	$stat{$_}->size(),
    	$now, $_;
 
}
 
# get stat info on the file, saving the desired
# sort criterion (mtime, atime, ctime, or size)
# in the %time hash indexed by filename.
# if they want a long list, we have to save the
# entire stat object in %stat.  yes, this is a
# hash of objects
sub wanted {
    my $sb = stat($_);  # XXX: should be stat or lstat?
 
    return unless $sb;
    $time{$name} = $sb->$IDX();  # indirect method call
 
    $stat{$name} = $sb if $opt_l;
}
 
# cache user number to name conversions
sub user {
 
    my $uid = shift;
    $user{$uid} = getpwuid($uid)->name || "#$uid"
 
        unless defined $user{$uid};
    return $user{$uid};
 
}
 
# cache group number to name conversions
sub group {
    my $gid = shift;
 
    $group{$gid} = getgrgid($gid)->name || "#$gid"
        unless defined $group{$gid};
 
    return $group{$gid};
}
 
#-----------------------------