#----------------------------- @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); #-----------------------------
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: $!";
#----------------------------- 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"; } #-----------------------------
#----------------------------- 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; }; }
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 } } #-----------------------------
#----------------------------- 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 } #-----------------------------
$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 #-----------------------------
#----------------------------- # 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); }
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; } #-----------------------------
#----------------------------- # 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: $!"; } }
#----------------------------- #% 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;
# 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}; }
扫一扫
1万+
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
