Re: Confession - Getting hit with "Use it or lose it"

[chunlou]

This is also a common problem for scientists and engineers who need to program in whatever on an as-needed basis. Sometimes you did something in C for some math stuff. Two years later, you don't even remember how to compile a source file.

I keep a bunch of short cheating scripts that basically illustrate various important aspects of a language. Could be something as basic as this:

#! /usr/local/bin/perl -w
use strict;
# ------------------------------------------------------------------
my $num = 7;
my $compare = 6;
my $str = "This+is+an+example+of+string.+How+cool+is+this!";
my @ar = ("a","b","c");
my %hash = ("key 1","val 1","key 2","val 2","key 3","val 3");
sub print_sep {print "\n-------------------------------\n";}
# ------------------------------------------------------------------
open(INFILE, 'try.pl'); my @file = <INFILE>;
my $num_eg = scalar grep(/^\$print_eg/, @file); close(INFILE);
# ------------------------------------------------------------------
sub print_eg {    # this is a closure
    my $count = shift ; 
    return sub {print "Example " . $count-- . ": " . shift() . "\n\n"}
}
my $print_eg = print_eg($num_eg) ;
# ------------------------------------------------------------------
# EXAMPLES BEGIN
# ------------------------------------------------------------------
$print_eg->("\$sub = \\&sub");
{
    sub count {my $i = shift; print "$i\n"; return count(--$i) if $i >
+= 1;};
    my $sub = \&count ;    
    $sub->(5) ;    
}
print_sep();
# ------------------------------------------------------------------
$print_eg->("while vs until vs i++ vs ++i");
{    
    my $i ;
    
    $i = 0; print "while(i < 4) {i++}:\t";
    while ($i < 4) {print "$i "; $i++ ;}
    print "\n";
    # ---------------------------------------    
    $i = 0; print "while(i < 4) {++i}:\t";
    while ($i < 4) {print "$i "; ++$i ;}
    print "\n";
    # ---------------------------------------
    $i = 0; print "do{} while i++ < 4 :\t";
    do {print "$i "} while $i++ < 4 ;
    print "\n";
    # ---------------------------------------
    $i = 0; print "do{} while ++i < 4:\t";
    do {print "$i "} while ++$i < 4 ;
    print "\n";
    # ---------------------------------------
    $i = 0; print "do{} until i++ >= 4:\t";
    do {print "$i "} until $i++ >= 4 ;
    print "\n";
    # ---------------------------------------
    $i = 0; print "do{} until ++i >= 4:\t";
    do {print "$i "} until ++$i >= 4 ;
    print "\n";
}
print_sep();
# ------------------------------------------------------------------
$print_eg->("caller and +()");
{
    sub subname1 { return( (caller(0))[3] ) }
    sub subname2 { return( (caller(1))[3] ) }
    sub try1 { return( (caller(0))[3] ) }; 
    sub try2 { return +(caller(0))[3] };     # with  +(), return won't
+ become return(caller(0))[3]
    sub trysubname1 {return subname1()}
    sub trysubname2 {return subname2()}
    print try1() . "\n" ;    
    print try2() . "\n" ;    
    print trysubname1() . "\n" ;    
    print trysubname2() . "\n" ;    
    
}
print_sep();
# ------------------------------------------------------------------
$print_eg->("binary 'x' - repeat operator");
{
    print "here " . "w" x 10 . "e go..."
}
print_sep();
# ------------------------------------------------------------------
$print_eg->("eval");
{
    my $msg = "this is a message.";
    my $cmd = "print";
    $cmd = "$cmd" . "\"" . "$msg" . "\"";
    print $cmd, "\n";
    eval $cmd;
    print "\n";
    # die() won't die in eval
    # but returns err to $@
    $cmd = "die";
    $cmd = "$cmd" . "\"" . "$msg" . "\"";
    print $cmd, "\n";
    eval $cmd;
    print $@ if $@;
}
print_sep();
# ------------------------------------------------------------------
$print_eg->("map");
{
    print "Original:", join(' ', @ar), "\n";
    my @ar = map {$_."x"} @ar;
    print "Mapped:", join(' ', @ar);
}
print_sep();
# ------------------------------------------------------------------
$print_eg->("here-doc syntax <<");
{
    # notice a TAB before FINIS at the following line of codes,
    # because the terminating string FINIS 3 lines later
    # has a preceding TAB 
    my $quote = <<"    FINIS";
        The Road goes ever on and on, 
        down from the door where it began.
        
    FINIS
    print $quote;
    $quote =~ s/^\s+//gm;
    print $quote;
}
print_sep();
# ------------------------------------------------------------------
$print_eg->("sub proto");
{
    my @a=(1,2,3,4);
    sub trythis {
        my $a = shift;
        my @a = @$a;
        return pop @a;
    }
    print "trythis(\\\@a)\n";
    print "pop:", trythis(\@a), "\n";
    print "\@a: @a\n";
    print "\n";
    sub trythat {
        my $a = shift;
        return pop @$a;
    }
    print "trythat(\\\@a)\n";
    print "pop:", trythat(\@a), "\n";
    print "\@a: @a\n";
    print "\n";
    sub tryproto(\@) {
        my $a = shift;
        return pop @$a;
    }
    print "tryproto(\@a)\n";
    print "pop:", tryproto(@a), "\n";
    print "\@a: @a\n";
    print "\n";
}
print_sep();
# ------------------------------------------------------------------
$print_eg->("reference anonymous (& qq, q)");
{
    my $ref = ["a", "b", "c"];
    print qq(assign: \$ref = ["a", "b", "c"]\n);
    print "\$ref = $ref\n";
    print "\@\$ref = @$ref\n";
    print "\n";
    $ref = {"key 1","val 1","key 2","val 2","key 3","val 3"};
    print qq(assign: \$ref = {"key 1","val 1","key 2","val 2","key 3",
+"val 3"}\n);
    print "\$ref = $ref\n";
    print q($$ref{'key 1'} = ), $$ref{'key 1'}, "\n";
    print '%$ref = ', %$ref, "\n";
    print "\n";
    $ref = sub {print "I'm an anon ref sub.\n";};
    print qq(assign: \$ref = sub {print "Im an anon ref sub.\\n";}\n);
    print '&$ref = ';
    &$ref;
}
print_sep();
# ------------------------------------------------------------------
$print_eg->("reference");
{
    my $ref = \$str;
    print "\$ref = $ref\n";
    print "\$\$ref = $$ref\n";
    print "\n";
    $ref = \@ar;
    print "\$ref = $ref\n";
    print "\$\$ref[0] = $$ref[0]\n";
    print "\@\$ref = @$ref\n";
    print "\n";
    $ref = \%hash;
    print "\$ref = $ref\n";
    print "\$\$ref{'key 1'} = $$ref{'key 1'}\n";
    print "\%\$ref = ", %$ref, "\n";
    print "\n";
    $ref = \&print_eg;
    print "\$ref = $ref\n";
    print "\&\$ref(\"ref\") = ";
    &$ref("ref")
}
print_sep();
# ------------------------------------------------------------------
$print_eg->("scalar @_, pop, push, shift, unshift, splice, eval");
{
    my @new_ar = @ar;
    print "The array '@new_ar' has ", scalar @new_ar, " elements.\n";
    print "\n";
    # - - - - - - - - -
    print "\@new_ar:\t\t\t\t@new_ar\n";
    print "pop \@new_ar:\t\t\t\t", pop @new_ar, "\n";
    print "\@new_ar after pop:\t\t\t@new_ar\n";
    push(@new_ar, '+');
    print "\@new_ar after push(\@new_ar,'+'):\t@new_ar\n";
    print "\n";
    # - - - - - - - - -
    @new_ar = @ar;
    print "\@new_ar:\t\t\t\t@new_ar\n";
    print "shift \@new_ar:\t\t\t\t", shift @new_ar, "\n";
    print "\@new_ar after shift:\t\t\t@new_ar\n";
    unshift(@new_ar, '+');
    print "\@new_ar after unshift(\@new_ar,'+'):\t@new_ar\n";
    print "\n";
    # - - - - - - - - -
    @new_ar = @ar;
    print "\@new_ar:\t\t\t\t@new_ar\n";
    my $cmd = 'splice(@new_ar, 1, 0, \'X\');';
    eval $cmd;
    print "$cmd:\t\t@new_ar\n";
    print "\n";
    # - - - - - - - - -
    @new_ar = @ar;
    print "\@new_ar:\t\t\t\t@new_ar\n";
    $cmd = 'splice(@new_ar, 1, 1, \'X\');';
    eval $cmd;
    print "$cmd:\t\t@new_ar\n";
}
print_sep();
# ------------------------------------------------------------------
$print_eg->("translation: tr// & reverse");
{
    print "Original String\n$str\n";
    print "Processed String #1\n";
    (my $new_str = $str) =~ tr/[a-z]+/[A-Z] /;
    print "$new_str\n";
    print "Processed String #2\n";
    ($new_str = reverse $str) =~ tr/[A-Z]+/[a-z]\%/;
    print "$new_str\n";
    print "Processed String #3\n";                    
    my $cnt = ($new_str =$str) =~ tr/+/+/;   # $cnt = tr/*/*/; counts 
+the stars in $_
    print "The string has $cnt \+ in it.\n";

}
print_sep();
# ------------------------------------------------------------------
$print_eg->("print match: /()/");
{
    print "Original String\n$str\n";
    print "Processed String\n";
    $str =~ /(.*)(example)(.*)(how)(.*)/i;   # i <-- case insensitive
    print "$1\n$2\n$3\n$4\n$5\n";
}
print_sep();
# ------------------------------------------------------------------
$print_eg->("split w/ (): include delimiter");
{
    print "Original String\n$str\n";
    print "Processed String\n";
    foreach (split(/(\+)/,$str)){
      print "$_\n";
    }
}
print_sep();
# ------------------------------------------------------------------
$print_eg->("split, foreach, \$_");
{
    print "Original String\n$str\n";
    print "Processed String\n";
    foreach (split(/\+/,$str)){
      print "$_\n" if /i[a-z]*/;
    }
}
print_sep();
# ------------------------------------------------------------------
$print_eg->("split & join");
{
    print "Original String\n$str\n";
    my @ar=split(/\+/,$str);   # @ar not visible outside this block
                                   # %ar also possible, if hash needed
    my $new_str = join('% ', @ar);
    print "\nProcessed String\n$new_str\n";
    print "(This string contains ".eval($#ar+1)." words.)\n";
    $new_str =~ s/is/Izzz/g;
    print "\nChange All With s/search/replace/g\n$new_str\n";
}
print_sep();
# ------------------------------------------------------------------
$print_eg->("\%hash = map {\$_, [1]} \@ar");
{
    print "\@ar:\t@ar\n";
    my %hash = map {($_ , [1])} @ar; 
    print "\%hash:\t";
    while (my($k,$v) = each %hash){print "$k=>@$v ";}
}
print_sep();
# ------------------------------------------------------------------
$print_eg->("foreach / while each -- hash");
{
    print "foreach hash...\n";
    foreach my $key (keys(%hash)){
        print "$key => $hash{$key}.\n";
    }
    print "\nwhile each hash...\n";
    while (my ($key, $value) = each %hash){
        print "$key => $hash{$key}.\n";
    }
}
print_sep();
# -------------------------------------
$print_eg->("if-elsif-else");
if ($num < $compare){
  print "$num is too little. I need $compare.\n";
} elsif ($num == $compare) {
  print "$num is just right\n";
} else {
  print "$num is too big. I need $compare.\n";
}
print_sep();
# ------------------------------------------------------------------
$print_eg->("for loop");
for (my $i=0; $i <= $#ar; $i++){   # $#ar = last index
  print "here is $ar[$i]\n";   # @ar[$i] will work too, but not as saf
+e
}
print_sep();
# ------------------------------------------------------------------
$print_eg->("foreach loop");
foreach (@ar){
  print "here is $_\n";
}
print_sep();