echo "print 'Hello, world'" | perl -
*****
#!/bin/sh -- # -*- perl -*- -p
eval 'exec perl $0 -S ${1+"$@"}'
    if 0;
*****
#!/bin/sh
echo "I am a shell script"
*****
#!/usr/bin/perl -spi.bak    # same as -s -p -i.bak
*****
find . -name '*.bak' -print0 | perl -n0e unlink
*****
perl -ane 'print pop(@F), "\n";'
*****
while (<>) {
    @F = split(' ');
    print pop(@F), "\n";
}
*****
$ perl -p -i.bak -e "s/foo/bar/; ... "
*****
#!/usr/bin/perl -pi.bak
s/foo/bar/;
*****
#!/usr/bin/perl
while (<>) {
    if ($ARGV ne $oldargv) {
        rename($ARGV, $ARGV . '.bak');
        open(ARGVOUT, ">$ARGV");
        select(ARGVOUT);
        $oldargv = $ARGV;
    }
    s/foo/bar/;
}
continue {
    print;        # this prints to original filename
}
select(STDOUT);
*****
perl -lpe 'substr($_, 80) = ""'
*****
gnufind / -print0 | perl -ln0e 'print "found $_" if -p'
*****
use module split(/,/, q{foo, bar})
*****
LINE:
while (<>) {
    ...                # your script goes here
}
*****
find . -mtime +7 -print | perl -nle 'unlink;'
*****
LINE:
while (<>) {
    ...                # your script goes here
} continue {
    print;
}
*****
#!/usr/bin/perl -s
if ($xyz) { print "true\n"; }
*****
#!/usr/bin/perl -s
if ($xyz eq 'abc') { print "true\n"; }
*****
#!/usr/bin/perl
eval "exec /usr/bin/perl -S $0 $*"
        if $running_under_some_shell;
*****
    eval '(exit $?0)' && eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
    & eval 'exec /usr/bin/perl -S $0 $argv:q'
                   if 0;
*****
sub catch_zap {
    my $signame = shift;
    $shucks++;
    die "Somebody sent me a SIG$signame!";
} 
$SIG{INT} = 'catch_zap';  # could fail outside of package main
$SIG{INT} = \&catch_zap;  # best strategy
*****
use Config;
defined $Config{sig_name} or die "No sigs?";
$i = 0;     # Config prepends fake 0 signal called "ZERO".
foreach $name (split(' ', $Config{sig_name})) {
    $signo{$name} = $i;
    $signame[$i] = $name;
    $i++;
}   
*****
print "signal #17 = $signame[17]\n";
if ($signo{ALRM}) { 
    print "SIGALRM is $signo{ALRM}\n";
}   
*****
sub precious {
    local $SIG{INT} = 'IGNORE';
    &more_functions;
} 
sub more_functions {
    # interrupts still ignored, for now...
} 
*****
{
    local $SIG{HUP} = 'IGNORE';
    kill HUP => -$$;   # snazzy form of: kill('HUP', -$$)
}
*****
unless (kill 0 => $kid_pid) {
    warn "something wicked happened to $kid_pid";
} 
*****
$SIG{INT} = sub { die "\nOutta here!\n" };
*****
sub REAPER { 
    $SIG{CHLD} = \&REAPER;  # loathe sysV
    $waitedpid = wait;
}
$SIG{CHLD} = \&REAPER;
# now do something that forks...
*****
use POSIX "wait_h";
sub REAPER { 
    $SIG{CHLD} = \&REAPER;  # loathe sysV, dream of real POSIX
    my $child;
    while ($child = waitpid(-1, WNOHANG)) {
        $Kid_Status{$child} = $?;
    } 
}
$SIG{CHLD} = \&REAPER;
# do something that forks...
*****
use Config;
print "Hurray!\n" if $Config{d_sigaction};
*****
egrep 'S[AV]_(RESTART|INTERRUPT)' /usr/include/*/signal.h
*****
eval { 
    local $SIG{ALRM} = sub { die "alarm clock restart" };
    alarm 10;       # schedule alarm in 10 seconds 
    flock(FH, 2);   # a "write" lock that may block
    alarm 0;        # cancel the alarm
};
if ($@ and $@ !~ /alarm clock restart/) { die }
*****
open SPOOLER, "| cat -v | lpr -h 2>/dev/null"
                or die "can't fork: $!";
local $SIG{PIPE} = sub { die "spooler pipe broke" };
print SPOOLER "stuff\n";
close SPOOLER or die "bad spool: $! $?";
*****
open STATUS, "netstat -an 2>&1 |"
                or die "can't fork: $!";
while (<STATUS>) {
    next if /^(tcp|udp)/;
    print;
} 
close SPOOLER or die "bad netstat: $! $?";
*****
print grep { !/^(tcp|udp)/ } `netstat -an 2>&1`;
die "bad netstat" if $?;
*****
open(PROG_FOR_READING_AND_WRITING, "| some program |")  # WRONG!
*****
Can't do bidirectional pipe at myprog line 3.
*****
use FileHandle;
use IPC::Open2;
$pid = open2( \*Reader, \*Writer, "cat -u -n" );
Writer->autoflush();     # This is default, actually.
print Writer "stuff\n";
$got = <Reader>;
*****
require 'Comm.pl';
$ph = open_proc('cat -n');
for (1..10) {
    print $ph "a line\n";
    print "got back ", scalar <$ph>;
}
*****
#!/usr/bin/perl -w
require 5.003;
use strict;
use sigtrap;
use Socket;
*****
for ( $waitedpid = 0; 
      ($paddr = accept(Client,Server)) || $waitedpid; 
      $waitedpid = 0, close Client) 
{
    next if $waitedpid;   # alternately, check for $! == EINTR
    # the rest is the same...
*****
unless ( -S '/dev/log' ) {
    die "something's wicked with the print system";
} 
*****
$arg = shift;               # $arg is tainted
$hid = $arg, 'bar';         # $hid is also tainted
$line = <>;                 # Tainted
$path = $ENV{PATH};         # Tainted, but see below
$mine = 'abc';              # Not tainted
$shout = `echo abc`;        # Tainted
$shout = `echo $shout`;     # Insecure

system "echo $arg";         # Insecure (uses sh)
system "/bin/echo", $arg;   # OK (doesn't use sh)
system "echo $mine";        # Insecure until PATH set
system "echo $hid";         # Insecure two ways

$path = $ENV{PATH};         # $path tainted

$ENV{PATH} = '/bin:/usr/bin'; 
$ENV{IFS} = '' if $ENV{IFS} ne '';

$path = $ENV{PATH};         # $path now NOT tainted
system "echo $mine";        # OK, is secure now!
system "echo $hid";         # Insecure via $hid still

open(OOF, "< $arg");        # OK (read-only file)
open(OOF, "> $arg");        # Insecure (trying to write)

open(OOF, "echo $arg|");    # Insecure via $arg, but...
open(OOF,"-|")
    or exec 'echo', $arg;   # Considered OK

$shout = `echo $arg`;       # Insecure via $arg

unlink $mine, $arg;         # Insecure via $arg
umask $arg;                 # Insecure via $arg

exec "echo $arg";           # Single arg to exec or system is insecure
exec "echo", $arg;          # Considered OK (doesn't use the shell)
exec "sh", '-c', $arg;      # Considered OK, but isn't really
*****
sub is_tainted {
    not eval { 
        join('',@_), kill 0; 
        1;  
    };
}
*****
if ($addr =~ /^([-\@\w.]+)$/) {     
    $addr = $1;                     # $addr now untainted
}
else {
    die "Bad data in $addr";        # log this somewhere
}
*****
use English;  
die unless defined $pid = open(KID, "-|");
if ($pid) {           # parent
    while (<KID>) {
        # do something
    }
    close KID;
}
else {
    $EUID = $UID;
    $EGID = $GID;    # XXX: initgroups() not called
    $ENV{PATH} = "/bin:/usr/bin";
    exec 'myprog', 'arg1', 'arg2';
    die "can't exec myprog: $!";
}
*****
#define REAL_FILE "/path/to/script"
main(ac, av) 
    char **av;
{
    execv(REAL_FILE, av);
} 
*****
print &q(<<"EOT");
:       #!$bin/perl
:       eval 'exec $bin/perl -S \$0 \${1+"\$@"}'
:               if \$running_under_some_shell;
:       
EOT
*****
print <<"END";
stuff
blah blah blah ${ \( EXPR ) } blah blah blah
blah blah blah @{[ LIST ]} blah blah blah
nonsense
END
*****
a2p -7 -nlogin.password.uid.gid.gcos.shell.home
*****
#!/usr/bin/perl
use MyDecryptFilter;
@*x$]`0uN&k^Zx02jZ^X{.?s!(f;9Q/^A^@~~8H]|,%@^P:q-=
...
*****
#!/usr/bin/perl
use Filter::exec "a2p";
1,30{print $1}
*****
perl -MO=C foo.pl >foo.c
*****
