CIS 33A Perl handout week 11 part 1
Preliminary material should be here.
Sample programs from Clare Nguyen (edited by Ira Oldham)
############## more reference ############
Lecture week 11 hour 1 Example Part 1
#########################
# subroutine to swap the contents of two arrays
1. @arr1=(1,2,3);
2. @arr2=(10,20,30);
# pass a pointer to each array
3. swap(\@arr1,\@arr2);
# print the resulting arrays
4. foreach(@arr1){print "$_\n"}
5. foreach(@arr2){print "$_\n"}
6. sub swap
7. {
# save arguments in local variables
8. my ($arrRef1, $arrRef2) = @_;
9. my @temp;
# three way swap, using temporary storage
# @ is used to dereference the array references
10. @temp = @$arrRef1;
11. @$arrRef1 = @$arrRef2;
12. @$arrRef2 = @temp;
13. }
#########################
Lecture week 11 hour 1 Example Part 2
#########################
1. $arrRef = makeList();
2. foreach (@$arrRef) {print "$_\n"};
3. sub makeList
4. {
# local variable points to a anonymous empty array
5. my ($listRef) = [];
# push the numbers 2 3 4 5 into the array
# we have used push to push one value onto the end of the
# array
# this shows pushing a list of 4 values all at the end of
# the array
6. push(@$listRef,2..5);
7. return $listRef;
8. }
# The very interesting thing about this example is the use
# of my
# my is used to make $listRef local
# while the pointer variable $listRef is local,
# the anonymous array itself is NOT
# thus after the value of the pointer has been returned,
# that pointer value can be access the global anonymous
# array
#########################
Lecture week 11 hour 1 Example Part 3
#########################
# subroutine computes the dot product of two vectors
1. @arr1 = (1,2,3);
2. @arr2 = (3,2,1);
# pass pointers to the arrays
3. $result = dot_product(\@arr1,\@arr2);
4. print "$result\n"; # prints 10
5. sub dot_product
6. {
# copy pointers to local variables
7. my ($ref1, $ref2) = @_ ;
# initialize the product to zero
8. my $product = 0;
# error return if the lengths of the vectors do not match
# note the arrays are used in scalar context
9. return 0 if @$ref1 != @$ref2;
# multiply the corresponding vector elements
# and add up the total
# $i is the loop variable, goes through the subscripts
10. for ($i=0; $i<@$ref1; $i++)
11. {
# dereference the pointers and use the matching elements
12. $product += $ref1->[$i] * $ref2->[$i];
13. }
14. return $product;
15. }
#########################
Lecture week 11 hour 1 Example Part 4
#########################
1. %h1 = (a,1,b,2,c,3,d,4);
2. %h2 = (b,9,c,10);
3. $sum = sum_values_of_common_keys(\%h1,\%h2);
4. print "$sum\n";
5. sub sum_values_of_common_keys
6. {
7. my ($href1, $href2) = @_;
8. my $total=0;
# for each key in the first hash
9. foreach $key (keys %$href1)
10. {
# if there is a matching key in the second hash
11. if exists $href2->{$key}
12. {
# add the corresponding values from both hashes
13. $total += $href1->{$key} + $href2->{$key};
14. }
15. }
16. return $total;
17. }
#########################
Lecture week 11 hour 1 Example Part 5
#########################
1. $hashRef = make_hash();
2. foreach (keys %$hashRef)
3. {
4. print "$_ $hashRef->{$_}\n;
5. }
6. sub make_hash
7. {
# create a pointer to an empty anonymous hash
8. my $hashref = {};
# use A B C D E as keys with values 65 66 67 68 69
9. foreach ('A'..'E')
10. {
# save the corresponding ASCII number for the key
11. $hashRef->{$_} = ord($_);
12. }
13. return $hashRef;
14. }
# output
# A 65
# B 66
# C 67
# D 68
# E 69
# Similar to the array example, this subroutine has a local
# pointer, that points to a global anonymous hash
More discussion should go here.
Sample File programs from Clare Nguyen (edited by Ira Oldham)
############## File::Copy, File::Find ############
Lecture week 11 hour 1 Example File::Copy, File::Find
#########################
1. use File::Copy;
2. system ("ls -l fileA fileB");
3. print "fileA copied to fileB\n" if copy("fileA","fileB");
4. system ("ls -l fileA fileB");
5. print "fileA copied to dir1/fileB\n" if copy("fileA", "dir1/fileB");
6. system ("ls -l dir1/fileB");
7. print "fileA copied to dir1\n" if copy("fileA", "dir1");
8. system ("ls -l dir1/file*");
# screen output
# Cannot access fileB: No such file or directory
# -rw-r--r-- 1 unc2140 staff 4 Mar 10 09:58 fileA
# fileA copied to fileB
# -rw-r--r-- 1 unc2140 staff 4 Mar 10 09:58 fileA
# -rw-r--r-- 1 unc2140 staff 4 Mar 11 23:42 fileB
# fileA copied to dir1/fileB
# -rw-r--r-- 1 unc2140 staff 4 Mar 11 23:42 dir1/fileB
# fileA copied to dir1
# -rw-r--r-- 1 unc2140 staff 4 Mar 11 23:42 dir1/fileA
# -rw-r--r-- 1 unc2140 staff 4 Mar 11 23:42 dir1/fileB
#########################
1. use File::Find;
# use printLab subroutine; start in the current directory
2. find (\&printLab, ".");
# use printText sub; start in pwd, then cis70 under parent
# directory
3. find (\&printText, ".", "../cis70");
4. sub printLab
5. {
# print all file names containing lab4
# uses the dir command in the Find library
6. print "$File::Find::dir/$_\n" if /lab4/;
7. }
8. sub printText
9. {
10. print all file names that have size over 10,000 Bytes
11. print "$File::Find::dir/$_\n" if -s $_ > 10000;
12. }
# $_ contains the current file name
# $File::Find::dir contains the current directory
############## File::Find ############
Lecture week 11 hour 1 Example 2 for File::Find
#########################
# Recursive Directory Descent using find
# Print the directory and name of all your files with
# names ending with .txt
1. use File::Find ;
# Process each file name using the printTxt subroutine
# Start in ~ which is your home directory
2. find ( \&printTxt, "~" ) ;
3. sub printTxt
4. {
5. if (/\.txt$/) # match operator default binding to $_
6. {
7. print "$File::Find::name\n" ;
8. }
9. }
# $_ contains the current file name
# $File::Find::dir contains the current directory
# $File::Find::name contains the directory and file:
# "$File::Find::dir/$_"
# match operator and if test selects file names that
# end with .txt
############## File::Path ############
Lecture week 11 hour 1 Example File::Path
#########################
1. use File::Path 2. mkpath (['/foo/bar/baz', 'blurf1/quux'], 1, 0711) ; 3. rmtree (['/foo/bar/baz', 'blurf1/quux'], 1, 1) ; # this code makes and removes two paths # the first argument references an anonymous array of paths # (If you have only one path, an array is not needed) # the second argument is TRUE, causing each directory name # to be printed as it is created # the third argument in mkpath specifies the permissions # the third argument in rmtree is TRUE, skips files you do # not have permission to delete