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