Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
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 wandering the Monastery: (13)
As of 2014-08-22 14:17 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (158 votes), past polls