#----------------------------- sub somefunc { my $variable; # $variable is invisible outside somefunc() my ($another, @an_array, %a_hash); # declaring many variables at once
# ... } #----------------------------- my ($name, $age) = @ARGV; my $start = fetch_time(); #----------------------------- my ($a, $b) = @pair; my $c = fetch_time();
sub check_x { my $x = $_[0]; my $y = "whatever"; run_check(); if ($condition) { print "got $x/n"; } } #----------------------------- sub save_array { my @arguments = @_; push(@Global_Array, /@arguments); } #-----------------------------
#----------------------------- $age = 18; # global variable if (CONDITION) { local $age = 23; func(); # sees temporary value of 23 } # restore old value at block exit #----------------------------- $para = get_paragraph(*FH); # pass filehandle glob $para = get_paragraph(/*FH); # pass filehandle by glob reference $para = get_paragraph(*IO{FH}); # pass filehandle by IO reference sub get_paragraph { my $fh = shift; local $/ = ''; my $paragraph = <$fh>; chomp($paragraph); return $paragraph; } #----------------------------- $contents = get_motd(); sub get_motd { local *MOTD; open(MOTD, "/etc/motd") or die "can't open motd: $!"; local $/ = undef; # slurp full file; local $_ = <MOTD>; close (MOTD); return $_; } #----------------------------- return *MOTD; #----------------------------- my @nums = (0 .. 5); sub first { local $nums[3] = 3.14159; second(); } sub second { print "@nums/n"; } second(); 0 1 2 3 4 5
first(); 0 1 2 3.14159 4 5 #----------------------------- sub first { local $SIG{INT} = 'IGNORE'; second(); } #----------------------------- sub func { local($x, $y) = @_; #.... } #----------------------------- sub func { my($x, $y) = @_; #.... } #----------------------------- &func(*Global_Array); sub func { local(*aliased_array) = shift; for (@aliased_array) { .... } } #----------------------------- func(/@Global_Array); sub func { my $array_ref = shift; for (@$array_ref) { .... } } #-----------------------------
{ local *grow = /&shrink; # only until this block exists grow(); # calls shrink() } #----------------------------- *one::var = /%two::Table; # make %one::var alias for %two::Table *one::big = /&two::small; # make &one::big alias for &two::small #----------------------------- local *fred = /&barney; # temporarily alias &fred to &barney #----------------------------- $string = red("careful here"); print $string; <FONT COLOR='red'>careful here</FONT> #----------------------------- sub red { "<FONT COLOR='red'>@_</FONT>" } #----------------------------- sub color_font { my $color = shift; return "<FONT COLOR='$color'>@_</FONT>"; } sub red { color_font("red", @_) } sub green { color_font("green", @_) } sub blue { color_font("blue", @_) } sub purple { color_font("purple", @_) } # etc #----------------------------- @colors = qw(red blue green yellow orange purple violet); for my $name (@colors) { no strict 'refs'; *$name = sub { "<FONT COLOR='$name'>@_</FONT>" }; } #----------------------------- *$name = sub ($) { "<FONT COLOR='$name'>$_[0]</FONT>" }; #-----------------------------
#----------------------------- # download the following standalone program #!/usr/bin/perl # bysub1 - simple sort by subject my(@msgs, @sub); my $msgno = -1; $/ = ''; # paragraph reads while (<>) { if (/^From/m) { /^Subject:/s*(?:Re:/s*)*(.*)/mi; $sub[++$msgno] = lc($1) || ''; } $msgs[$msgno] .= $_; } for my $i (sort { $sub[$a] cmp $sub[$b] || $a <=> $b } (0 .. $#msgs)) { print $msgs[$i]; }
#----------------------------- # download the following standalone program #!/usr/bin/perl -n00 # bysub2 - awkish sort-by-subject BEGIN { $msgno = -1 } $sub[++$msgno] = (/^Subject:/s*(?:Re:/s*)*(.*)/mi)[0] if /^From/m; $msg[$msgno] .= $_; END { print @msg[ sort { $sub[$a] cmp $sub[$b] || $a <=> $b } (0 .. $#msg) ] }
#----------------------------- # download the following standalone program #!/usr/bin/perl -00 # bysub3 - sort by subject using hash records use strict; my @msgs = (); while (<>) { push @msgs, { SUBJECT => /^Subject:/s*(?:Re:/s*)*(.*)/mi, NUMBER => scalar @msgs, # which msgno this is TEXT => '', } if /^From/m; $msgs[-1]{TEXT} .= $_; }
for my $msg (sort { $a->{SUBJECT} cmp $b->{SUBJECT} || $a->{NUMBER} <=> $b->{NUMBER} } @msgs ) { print $msg->{TEXT}; }
#----------------------------- # download the following standalone program #!/usr/bin/perl -00 # datesort - sort mbox by subject then date use strict; use Date::Manip; my @msgs = (); while (<>) { next unless /^From/m; my $date = ''; if (/^Date:/s*(.*)/m) { ($date = $1) =~ s//s+/(.*//; # library hates (MST) $date = ParseDate($date); } push @msgs, { SUBJECT => /^Subject:/s*(?:Re:/s*)*(.*)/mi, DATE => $date, NUMBER => scalar @msgs, TEXT => '', }; } continue { $msgs[-1]{TEXT} .= $_; }