File::Copy, File::Find, File::Mkpath, etc.
#!/usr/bin/perl -w
############################# File Copy Demo #############################
use File::Copy;
use Cwd;
system("ls -l a b"); ###### ls 1
print "a copied to b\n" if copy("a","b"); ##### It WILL overwrite b!!
system("ls -l a b"); ###### ls 2
system("ls -l cdir"); ###### ls 3
print "b copied to cdir\n" if copy("b","cdir/b"); ##### Give dir path!!
system("ls -l cdir"); ###### ls 4
open(F,"a") or die "Cannot open a.\n";
system("ls -l k"); ###### ls 5
print "Filehandle F copied to file k.\n" if copy(\*F,"k");
system("ls -l k"); ###### ls 6
print tell(F),"\n"; ####### Where's the file pointer?
close(F);
########## What about wildcards? #########
print "a b and c copied to cdir.\n" if copy("[abc]","cdir");
######################### Copy Demo Output ##########################
$ file.pl
Cannot access b: No such file or directory
-rw------- 1 jwp2286 staff 10 Feb 23 14:28 a ###### ls 1
a copied to b
-rw------- 1 jwp2286 staff 10 Feb 23 14:28 a ###### ls 2
-rw------- 1 jwp2286 staff 10 Feb 25 01:06 b
total 0 ###### ls 3
b copied to cdir
total 1 ###### ls 4
-rw------- 1 jwp2286 staff 10 Feb 25 01:06 b
Cannot access k: No such file or directory ###### ls 5
Filehandle F copied to file k.
-rw------- 1 jwp2286 staff 10 Feb 25 01:06 k ###### ls 6
10 ###### Value of tell after implicit read by copy()
################ Recursive Directory Descent with Find ###############
#!/usr/bin/perl -w
use Cwd;
use File::Find;
find(\&getpm, ".."); ####### 2nd thru last argument are all directories.
sub getpm
{
if (/\.pm$/)
{
$cwd = cwd();
print "$File::Find::dir/$_\n";
print "$cwd/$_\n"; ###### Always use path given by cwd()
} ###### when in find. You'll be given
} ###### a reason in class!!!
######################### Find Demo Output ###########################
../perl/MainWindow.pm ## From $File::Find::dir/$_
/mnt/diska/staff/jwp2286/perl/MainWindow.pm ## From $cwd/$_
../perl/clean.pm
/mnt/diska/staff/jwp2286/perl/clean.pm
../perl/junk/pkg.pm
/mnt/diska/staff/jwp2286/perl/junk/pkg.pm
../perl/junk/newpkg.pm
/mnt/diska/staff/jwp2286/perl/junk/newpkg.pm
../perl/pkg.pm
/mnt/diska/staff/jwp2286/perl/pkg.pm
../perl/strclean.pm
/mnt/diska/staff/jwp2286/perl/strclean.pm
../temp/MainWindow.pm
/mnt/diska/staff/jwp2286/temp/MainWindow.pm
../temp/clean.pm
/mnt/diska/staff/jwp2286/temp/clean.pm
../temp/pkg.pm
/mnt/diska/staff/jwp2286/temp/pkg.pm
######### Making/Removing Directory Trees with Mkpath and Rmtree ########
use File::Path;
umask(0); ## Otherwise, existing umask will negate my attempts to create
## my own permissions.
@created = mkpath(['sub1','sub2','sub3','sub4/foo', 'cdir'], 1, 0755);
print "Created dirs: @created\n";
system("ls -F | grep '/'"); ###### See if mkpath worked.
system("touch sub4/foo/junkfile"); ###### Put file in to-be-deleted dir.
rmtree(['sub1','sub2','sub3','sub4'],1);
system("ls -F | grep '/'"); ##### Did the directories go bye-bye?
########################## Mkpath/Rmtree Output ########################
mkdir sub1 ####### Output from mkpath. Notice the trace.
mkdir sub2
mkdir sub3
mkdir sub4
mkdir sub4/foo
Created dirs: sub1 sub2 sub3 sub4 sub4/foo ###### Print output.
Tk/ ####### From system("ls -F | grep '/'");
cdir/
exams/
sub1/
sub2/
sub3/
sub4/
rmdir sub1 ###### Execution trace from rmtree().
rmdir sub2
rmdir sub3
unlink sub4/foo/junkfile
rmdir sub4/foo
rmdir sub4
Tk/ ###### system("ls -l | grep '/'"); again!!
cdir/
exams/
########################## File Permissions ############################
#!/usr/bin/perl -w
print "Files with no group/other privileges\n";
print "------------------------------------\n";
foreach $file (sort glob("* .*"))
{
print "$file\n" if (((stat $file)[2] & 077) == 0)
}
########################## Program Output ###########################
Files with no group/other privileges
------------------------------------
.
.bar
.foo
c
d
mask.pl
newpkg.pm
############################## Result Verification ########################
ls -la of the above files:
drwx------ 2 jwp2286 staff 512 Nov 1 23:05 .
-rw------- 1 jwp2286 staff 0 Oct 18 23:55 .bar
-rw------- 1 jwp2286 staff 0 Oct 18 23:55 .foo
-rw------- 1 jwp2286 staff 0 Oct 18 23:40 c
-rw------- 1 jwp2286 staff 0 Oct 19 00:14 d
-rwx------ 1 jwp2286 staff 267 Nov 1 23:10 mask.pl
-rw------- 1 jwp2286 staff 159 Mar 8 1998 newpkg.pm
############### How to Create an ls -l Permission Mask ###################
#!/usr/bin/perl -w
@files = sort glob("* .*");
@permlist = qw(--- --x -w- -wx r-- r-x rw- rwx);
foreach $file (@files)
{
$perms = sprintf("%3o", (stat($file))[2] & 0777);
$perms = join("", @permlist[split //,$perms ]);
$perms = "d$perms" if -d $file;
$perms = "-$perms" if !-d $file;
printf "%-20s: %10s\n", $file, $perms;
}
############################## Program Results ###############################
. : drwx------
.. : drwxr-xr-x
.bar : -rw-------
.foo : -rw-------
a : -rw-r--r--
c : -rw-------
d : -rw-------
defined.pl : -rwx--x--x
mask.pl : -rwx------
newpkg.pm : -rw-------
perms.demo : -rwxr--r--
pkg.pm : -rw-------
x : -rw-r--r--
##################### Chdir, Mkdir, and Rmdir ####################
#!/usr/bin/perl -w
use Cwd;
if (chdir(".."))
{
print "Absolute path is: ", cwd(),"\n\n";
}
else {print "Could not chdir up one level!\n"}
chdir("perl") or die "Could not chdir to perl directory!\n";
system("touch foo");
if (-e "foo") ###### If foo exists, can I rename it like with mv?
{
print "It worked with destination directory only!\n\n" if rename("foo","..");
print "Needed full path spec for rename!\n\n" if rename("foo","../foo");
}
print "Did foo move up one level: ", glob("../foo*"),"\n";
umask(0); ###### To control my own permission mask when I create files
###### or directories.
mkdir("subperl", 0755) or die "Couldn't make subperl!\n"; ##### drwxr-xr-x
system("ls -ld subperl");
chdir("subperl") or die "Could not chdir to subperl!\n";
system("touch foobar"); ##### Put a file in my new subdirectory.
chdir("..") or die "Cannot chdir one level up!\n";
rmdir("subperl") || print "Can't get rid of subperl yet!\n\n";
unlink("subperl/foobar") or die "Cannot unlink!\n"; ## Unlink can take a list!!
rmdir("subperl") || print "Still can't get rid of subperl!\n\n";
############################# Output Below ##############################
drwxr-xr-x 2 jwp2286 staff 512 May 2 17:20 subperl
Absolute path is: /mnt/diska/staff/jwp2286
Needed full path spec for rename!
Did foo move up one level: ../foo
Can't get rid of subperl yet!
############################ The Stat Function ###########################
#!/usr/bin/perl -w
print "Using the stat function\n";
print "-----------------------\n\n";
@filespecs = stat("junk");
foreach $spec (@filespecs)
{
print "$spec\n";
}
printf("%o are permissions.\n", $filespecs[2] & 07777);
$last_access_time = localtime($filespecs[8]) ;
print "Last accessed at: $last_access_time\n";
$last_modification_time = localtime($filespecs[9]);
print "Last modified at:$last_modification_time\n";
############################# Program Output ###########################
Using the stat function
-----------------------
33555216 ######## Device number of filesystem (usually useless)
4018 ######## Inode number of file.
16832 ######## File type and permissions.
2 ######## Number of hard links to the file.
2286 ######## User id (uid) of owner.
24 ######## Group id (gid) of owner.
0 ######## Device id (usually useless).
512 ######## Size of file in bytes (better to use -s file).
909991835 ######## Last access time in seconds since the epoch.
909990923 ######## Last modification time in seconds since the epoch.
909990923 ######## Last time since inode number was changed.
32768 ######## Filesystem block size (usually useless).
1 ######## Number of blocks allocated for file (usually useless).
700 are permissions.
Last accessed at: Sun Nov 1 23:30:35 1998
Last modified at: Sun Nov 1 23:15:23 1998
################### Understanding the Time Functions ####################
#!/usr/bin/perl -w
use Time::Local; ###### For timelocal function ONLY!
$then = time();
printf("Time is: %ld\n\n", $then);
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($then);
print "Seconds = $sec\n";
print "Minutes = $min\n";
print "Hours = $hour\n";
print "Day of month = $mday\n";
print "Month = $mon\n";
print "Year = $year\n";
print "Day of week = $wday\n";
print "Day of year = $yday\n";
print "Daylight time? $isdst\n\n";
print "Localtime in scalar context: ",scalar(localtime($then)),"\n\n";
$now = timelocal($sec, $min, $hour, $mday, $mon, $year);
printf("New time is: %ld\n\n", $now);
############ Tricks to Convert Numeric Day/Month to a String ###########
$day = (Sun,Mon,Tue,Wed,Thu,Fri,Sat) [$wday];
$month = (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec)[$mon];
print "Today is: $day, $month $mday\n";
###################### Wall Clock Benchmarking Trick #####################
$then = time();
for($i = 0; $i < 1000000; $i++){} ##### Nonsense but good for a demo!
$now = time();
print "One million for loops took ",$now - $then," seconds.\n";
########################## Program Output Below ##########################
Time is: 896163189
Seconds = 9
Minutes = 13
Hours = 23
Day of month = 25
Month = 4
Year = 98
Day of week = 1
Day of year = 144
Daylight time? 1
Localtime in scalar context: Mon May 25 23:13:09 1998
New time is: 896163189 ##### Timelocal is the inverse of localtime!!
Today is: Mon, May 25
One million for loops took 13 seconds.
######################### Setting File Permissions ########################
#!/usr/bin/perl -w
system("touch xxx yyy");
system("ls -l xxx yyy");
## Chmod can take a list of filenames!
chmod 0777, "xxx","yyy" or die "Cannot chmod file xxx and/or yyy!\n";
system("ls -l xxx yyy");
############################## Program Output #############################
-rw------- 1 jwp2286 staff 0 Nov 1 23:51 xxx
-rw------- 1 jwp2286 staff 0 Nov 1 23:51 yyy
-rwxrwxrwx 1 jwp2286 staff 0 Nov 1 23:51 xxx
-rwxrwxrwx 1 jwp2286 staff 0 Nov 1 23:51 yyy