#!/usr/local/bin/perl


############
# this program reads itself, that is, when it runs, it reads this
# file, parses the code into sections, grabs the topic for each
# section, shows the menu of topics, and lets you choose which
# topic to demonstrate.
############

#D#

# variable declarations
### variables
$flower = "tulip";
$house_number = "1344";
$entry_code = 'c';
$line1 = "this is the house that Jack built";
$line2 = "first_name,last_name,address,city,state,zip";
$line3 = '';


### arrays
@clouds;   # declares the existence of an array
@clouds = ();   # declares an empty array, or makes it empty if it exists
@cloudsnew = qw(nimbus cumulus stratus fluffy dark);
$clouds[0] = "nimbus";
$clouds[1] = "cumulus";
$clouds[2] = "stratus";
$clouds[3] = "fluffy";
$clouds[4] = "dark";


### hashes
%temperature;   # declares the existence of a hash
%temperature = ();   # declares an empty hash, or makes it empty if it exists
%temperature = ("inside", "70", "outside", "50", "furnace", "1200");
$temperature{"sun"} = "2000000";


### lists
($var1, $var2, $var3);


#D#


# other variables
@sections = ();
$idx = 0;
$rundelimiter = "***********************************************************";
$exedelimiter = "-----------------------------------------------------------";
%exitchoice = qw(Q Q QUIT QUIT EXIT EXIT STOP STOP BYE BYE);
@demowords = ();
$infile = "input.test";
$outfile = "output.test";

if ($^O eq "solaris")
{
  $clearcmd = "clear";
  $stuff = "cat $infile";
  $printinfilecmd = "cat $infile";
  $printoutfilecmd = "cat $outfile";
}
elsif ($^O eq "MSWin32")
{
  $clearcmd = "cls";
  $stuff = "type $infile";
  $printinfilecmd = "type $infile";
  $printoutfilecmd = "type $outfile";
}

$fopen = sprintf("Cannot open %s for input\n", $0);
open(infile, "$0") or die $fopen;
$linectr = 0;
while ($line = <infile>)
{
  chomp $line;
  if ($line !~ /^#Z#/)   # section divider
  {
    if ($linectr == 4) {$all_topics[$idx] = substr($line, 2);}
    if (($linectr > 4) and ($line ne "}")) {$sections[$idx] .= "$line\n";}
    $linectr++;
  }
  else {$idx++; $linectr = 0;}
}
close(infile);

@seczerostuff = split /#D#/, $sections[0];
$sections[0] = $seczerostuff[1];
$all_topics[0] = "variable declarations";

show_menu();

while ($choice != $exitnum)
{
  print "\n   Please enter the topic number of your choice: ";
  $choice = <STDIN>;
  chomp $choice;
  if (exists($exitchoice{uc($choice)})) {$choice = $exitnum;}
  if (($choice >= 0) and ($choice < $exitnum))
  {
    do_section($choice);
    show_menu();
  }
}


sub show_menu()
{
  system($clearcmd);
  print "   Demonstrating Perl Functionality\n\n";
  print "   Choose a Topic by its Number\n\n";
  for ($idx=0; $idx<@all_topics; $idx++)
  {
    if (($idx == 6) or ($idx == 15) or ($idx == 22) or ($idx == 25)) {print "\n";}
    printf ("    %2.2s  %s\n", $idx, $all_topics[$idx]);
  }
  printf ("\n    %2.2s  Exit this program\n", $idx);
  $exitnum = $idx;
}


sub do_section
{
  my ($secnumber) = @_;

  # show the code and its output
  system($clearcmd);
  print "\n\nThe topic is: $all_topics[$secnumber]\n$rundelimiter\n";
  print "The code for this section is: \n\n";
  @seclines = split /\n/, $sections[$secnumber];
  foreach $l (@seclines)
  {
    my $startpoint = 2;
    if ($secnumber == 0) {$startpoint = 0;}
    print substr($l, $startpoint) . "\n";
  }
  print "\n$exedelimiter\nThe output for this section is:\n\n";
  $cmd = sprintf("program%d", $secnumber);
  eval($cmd);
  print "$rundelimiter\n";
  print "\n\n\nPress Return to continue...";
  $junk = <STDIN>;
}


sub usage
{
  print "\nThis is the subroutine that typically is called when\n";
  print "the expected number of command line arguments is not\n";
  print "supplied. Usually, it shows a skeleton of how this program\n";
  print "is expected to be called, with at least a minimal explanation\n";
  print "of the arguments and the program's purpose/functionality.\n";
  print "Normally, \"exit(-1)\" is called here to stop the program NOW.\n\n";
  exit();
}


#Z#


sub program1
{
# our first Perl Program
  print "Hello, world\n";
}


#Z#


sub program2
{
# special built-in variables
  print "There are many special, built-in variables; here's one:\n";
  print "Which operating system are we running?\n";
  print "We are running $^O\n";
}


#Z#


sub program3
{
# command line arguments (usage)
  print "illustrating command line arguments and \"program usage\"\n";
  print "the usage paragraph will be shown if the incorrect number\n";
  print "of arguments is supplied\n";
  if ($#ARGV < 1) {usage();}
  else
  {
    $argument1 = $ARGV[0];
    $argument2 = $ARGV[1];
    $argument3 = $ARGV[2];
    print "here's how this program was executed:\n$0 $argument1 $argument2 $argument3\n\n";
  }
}


#Z#


sub program4
{
# quotemarks and more quotemarks
  print "\$stuff = \"$stuff\"\n";
  print "using singlequotes\n";
  $result = '$stuff';
  print "the result is <<$result>>\n";
  print "using doublequotes\n";
  $result = "$stuff";
  print "the result is <<$result>>\n";
  print "using backward singlequotes\n";
  $result = `$stuff`;
print "the result is <<$result>>\n";
}


#Z#


sub program5
{
# the "system" command
  print "the command is <<$printinfilecmd>>\n";
  print "--this is the input file:\n";
  system($printinfilecmd);
  print "\n";
  print "the command is <<$printoutfilecmd>>\n";
  print "--this is the output file:\n";
  system($printoutfilecmd);
}


#Z#


sub program6
{
# printf
  print "syntax example:\nprintf (\"formatted variable is %formatspec\\n\", \$formatted_variable);\n";
  print "\nsome printf format examples\n";
  system("format.pl");
}


#Z#


sub program7
{
# the substr function
  print "using substr\nline1 is: $line1\n";
  print "and here's part of that string: " . substr($line1, 9, 10) . "\n";
}


#Z#


sub program8
{
# the index function
  print "\n\n";
  print "using index\nline1 is: $line1\n";
  print "\"Jack\" occurs at position: " . index($line1, "Jack") . "\n";
}


#Z#


sub program9
{
# the length function
  print "\$flower is <<$flower>> and its length is " . length($flower) . "\n";
  print "\$line1 is <<$line1>> and its length is " . length($line1) . "\n";
}


#Z#


sub program10
{
# the ord and char functions
  print "the ASCII value of the 'l' in tulip is: " . ord(substr($flower, 2, 1)) . "\n";
  print "the character corresponding to 65 is: " . chr(65) . "\n";
}


#Z#


sub program11
{
# the uc and lc functions
  print "line1: $line1\nin upper case, it is: " . uc($line1) . "\n";
  print "in lower case, it is: " . lc($line1) . "\n";
}


#Z#


sub program12
{
# the ucfirst and lcfirst functions
  print "line1: $line1\nwith init caps, it is: " . ucfirst($line1) . "\n";
  print "in initial lower case letters it is: " . lcfirst($line1) . "\n";
}


#Z#


sub program13
{
# the split function
  $line1 = "this is the house that Jack built";
  $line2 = "first_name,last_name,address,city,state,zip";
  $line3 = '';

  print "using split\n";
  print "line1 is: $line1\n";
  print "words from line1 are:\n";
  @demowords = split / /, $line1;
  for ($this=0; $this<@demowords; $this++) {print "$demowords[$this]\n";}
  print "\n";
  print "line2 is: $line2\n";
  print "words from line2 are:\n";
  @demowords = split /,/, $line2;
  for ($this=0; $this<@demowords; $this++) {print "$demowords[$this]\n";}
}


#Z#


sub program14
{
# the join function
  print "using join\n";
  print "at start, line3 is: $line3\n";
  $line3 = join ':', $clouds[0], $clouds[1], $clouds[2], $clouds[3], $clouds[4];
  print "after join, line 3 is $line3\n";
}


#Z#


sub program15
{
# using foreach with an array
  $clouds[0] = "nimbus";
  $clouds[1] = "cumulus";
  $clouds[2] = "stratus";
  $clouds[3] = "fluffy";
  $clouds[4] = "dark";
  foreach $type (@clouds)
  {
    print "cloud type: $type\n";
  }
}


#Z#


sub program16
{
# using foreach with a hash
  print "RANDOM list of temperatures and locations\n";
  foreach $temp (keys %temperature) {print "temperature is $temperature{$temp} in location $temp\n";}

  print "\n";
  print "SORTED list of temperatures and locations\n";
  foreach $temp (sort keys %temperature) {print "temperature is $temperature{$temp} in location $temp\n";}
}


#Z#


sub program17
{
# using while, with an array
  $idx = 0;
  while ($idx < @cloudsnew)
  {
    print "cloud type: $cloudsnew[$idx++]\n";
  }
}


#Z#


sub program18
{
# using a for loop, traversing an array backwards
  for ($idx=scalar(@clouds); $idx--; $idx>=0)
  {
    print "cloud type: $clouds[$idx]\n";
  }
}


#Z#


sub program19
{
# using "next" in a loop
  $idx = -1;
  while ($idx < @clouds)
  {
    $idx++;
    print "cloud type: $clouds[$idx]\n";
    next if $clouds[$idx] eq "cumulus";
    print "........I like this cloud\n";
  }
}


#Z#


sub program20
{
# using "last" in a loop
  $idx = -1;
  while ($idx < @clouds)
  {
    $idx++;
    print "cloud type: $clouds[$idx]\n";
    last if $clouds[$idx] eq "stratus";
    print "........this cloud is one of my favorites\n";
  }
}


#Z#


sub program21
{
# using "push" to populate an array
  foreach $temp (sort keys %temperature)
  {
    $line = "location <<$temp>> has a temperature of $temperature{$temp}; gee, that's hot\n";
    push @newstuff, $line
  }
  foreach $this (@newstuff) {print $this;}
}


#Z#


sub program22
{
# file input/output
  open(infile, "$infile") or die "cannot open input file $infile";
  open(outfile, ">$outfile") or die "cannot open output file $outfile";

  # reading a file line by line
  $ctr = 1;
  while ($line1 = <infile>)
  {
    print $line1;
    print outfile "line1 $ctr is: $line1";
    $ctr++;
  }
  close(infile);
  close(outfile);
}


#Z#


sub program23
{
# "slurping" a file, reading the previous output file
  open(infile, $infile) or die "cannot open input file $infile";
  @filestuff = <infile>;
  close(infile);
  foreach $fs (@filestuff) {print $fs;}
}


#Z#


sub program24
{
# -x file test operators
  if (-e $infile) {print "file <$infile> exists\n";}
  else            {print "file <$infile> does not exist\n";}
  $filesize = -s $infile;
  printf ("size of <%s> is %s bytes\n", $infile, -s $infile);
}


#Z#


sub program25
{
# date and time stuff
  ($sec, $min, $hour, $day, $month, $year, $wday, $yday, $isdst) = localtime;

  $today = sprintf ("%4.4d.%2.2d.%2.2d", $year+1900, $month+1, $day);
  $timenow = sprintf ("%2.2d:%2.2d:%2.2d", $hour, $min, $sec);

  print "today is $today (in \"Voyager\" format) and the time is $timenow\n";

  $thisday = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat')[(localtime)[6]];
  print "the day today is $thisday\n";

  print "\nsome date math examples\n";
  system("datemath.pl");
}


#Z#