#!/usr/bin/perl
# example of all kinds of perl features, last revised 18 April 2011 
print "Hello, world!\n";  # a short Perl example

# modify that top line to point to a particular version of perl
# on a UNIX system (like gl.umbc.edu) 

# use the chmod command to make this file executable, e.g. 
# chmod +x PerlCheatSheet.pl
# then just run this file like any executable, e.g. ./PerlCheatSheet
# no .pl suffix is needed since the shell will find it
# or involve perl explicitly, e.g.
# perl -w -Mdiagnostics PerlCheatSheet.pl

use strict;  # an example of a pragma
use warnings;

# let's make sure we can run this "program" using its own source as input!
# some example functions may need to be executed using their own input

# Perl statements end with a semicolon
# ordinary variables begin with $
my $nDocs = 0;

# perl is great for working with strings
# strings are delimited with either single quotes or double quotes
my $aString = 'This string extends over two lines, and most escapes like \n
have no effect';
my $bString = "Inside double quotes, usual escapes apply";
# period . is the string concatenation operator
my $aLongString = $aString."\nconcatenated with the period operator\n".
"and the x factor for repetition\n$bString\nand interpolation!";
print $aLongString x 2;
# note use of . as part of assignment, like several ops in C
$bString .= "\n";

# LOTS of pattern matching operators, including s for substitute
$aString = "Do not do that!\n";
print $aString;
$aString =~ s/Do not/Don't/;
print $aString;

# usual operators, with associativity and precedence as in C
# exceptions being comaprison ops for strings
my $fred = "fred\n";
my $barney = "barney\n";
print "is fred lt barney?\n";
# nothing special about Boolean variables
# if it's zero, it's false, otherwise it's true
my $aBoolean = $fred lt $barney;

# control structures include if
# although we just defined $aBoolean, we can always test
if (defined($aBoolean) && $aBoolean) {
    print "fred is less than barney\n";
} else {
    print "fred is NOT less than barney\n";
}

#control structures include while, for, and foreach

# Perl supports lists and arrays, closely related concepts
# but there's no notion of type
# subscripts start at zero normally, as in C
my @fred;
$fred[0] = 2.8;
$fred[1] = "Wilma!";
$fred[2] = 'dino' x 2;
my @barney = ("this is", "also a list but with ", 4, "elements");

# negative subscripts (!) count from the end of the array
print "last SUBSCRIPT of array fred is $#fred\n";
print "but the last element of array fred is $fred[-1]\n";

# push and pop add or delete elements from the end of a list
# use $fs to access an individual element of the list
# but we can use @fs to refer to the whole list
#
# sometimes we consider what Perl expects, i.e. list vs. scalar context
#
my @fs = qw/fred wilma barney betty/;
push @fs, qw/bambam pebbles/;
# shift and unshift delete or elements from the start of a list
unshift @fs, "dino";
# list elements are separated by blanks when interpolated
print "@fs\n"; 
my @sf = reverse(@fs);
printf "Print the list in reverse @sf\n"; 

# run an external command and save the output
# from Learning Perl by Brian d foy
my @lines = `perldoc -u -f atan2`;

# simple echo of a given input file (default to STDIN) to STDOUT
sub echoDemo {
    # note use of @_ in both the scalar and list contexts in this if
    my $XLSfile = "default.xls";
    if (@_ == 1) {
	# list of arguments in list context
	($XLSfile) = @_;
    } else {
	print "usage: echoDemo(inputFile=STDIN[,XLSfile=default.xls]\n";
    }
	
    my $word;
    my $nTerms=0;

    # Perl has built-in hash functions
    my %aHashTable = ();  # will be used in example below

    while (my $inputLine = <STDIN>) {
	chomp $inputLine;  # get rid of trailing newline
	print STDOUT "$inputLine\n";   #  I/O looks very C-like, eh?

	# recall that array names begin with @ 
	# split $inputLine into an array of blank-separated words

	my @words=split(" ", $inputLine); 
	foreach $word (@words) {
	    $aHashTable{$word} += 1;

	    # to practice with regular expression matching, see if word
	    # would be a good password, i.e. having at least one
	    # digit, one lower case letter, and one upper case letter

	    # make sure it finds a good password when run on itself XYzzy18
	    if ($word =~ /[A-Z]/ && $word =~ /[a-z]/ && $word =~ /[0-9]/) {
		print "$word would be a good password.\n";
	    }
	}
    }

    for $word (sort(keys(%aHashTable))) {
	$nTerms++;
	# but let's make each word lower-case
	# and make a variable wordlc local to this block
	my $wordlc = $word;
	$wordlc =~ tr/A-Z/a-z/;  # tr stands for translate
	printf STDOUT "%s, %d\n", $wordlc, $aHashTable{$word};
    }

# let's make a spreadsheet
    use Spreadsheet::WriteExcel;
# make some new objects
# the my keyword makes them local to this sub
    my $workbook = Spreadsheet::WriteExcel->new($XLSfile);
    my $worksheet = $workbook->add_worksheet();
# write two column headers
    $worksheet->write(0,0,"term");
    $worksheet->write(0,1,"count");

# now write each term, and its count, on its own row
    my $row = 1;
    for (sort(keys(%aHashTable))) {
	# using $_ as the default variable, common in Perl
	# put $word in quotes, so excel won't try to evaluate it
	$worksheet->write($row, 0, sprintf("\"%s\"", $_)); 
	$worksheet->write($row, 1, $aHashTable{$_}); 
	$row++;
    }
    # a sub can return a scalar or a list, depending on context
    # Some packages like R do something similar e.g. [u,sigma,vt] = svd(M)
    return $row;   # in case the calling routine is checking, which it isn't
}

#
# invoke a subroutine
my $nRowsWritten = &echoDemo("PCSlexicon.xls");
print "Wrote a spreadsheet with $nRowsWritten row(s) written.\n";

# 
# working with files and directories, and patterns
my @files = <*>;
foreach my $myFile (@files) {
    if (-f $myFile and -r $myFile) {   # see if it's a readable file 
	my ($nl, $nw, $nch) = 
	    `wc $myFile` =~ /([0-9]+)\s+([0-9]+)\s+([0-9]+)/;
	print "file $myFile has $nl lines, $nw words and $nch characters\n";
    }
}