Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

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

by chunlou (Curate)
on Jul 04, 2003 at 02:02 UTC ( #271358=note: print w/ replies, xml ) Need Help??


in reply to Confession - Getting hit with "Use it or lose it"

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();


Comment on Re: Confession - Getting hit with "Use it or lose it"
Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://271358]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others scrutinizing the Monastery: (18)
As of 2015-07-29 18:30 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (267 votes), past polls