Perl Programming | ||
---|---|---|
Welcome to Perl Programming |
||
IAP 2003 Richard J. Barbalace rjbarbal Alex Rolfe arolfe Student Information Processing Board W20-557 |
||
Contents |
||
|
||
Introduction |
||
|
||
What is Perl? |
||
|
||
What is perl? |
||
% perl -ne 'print' filename % perl -ne 'print if /match/' filename % perl -pi -e 's/19100/2000/g' files % perldoc perlrun |
||
History |
||
|
||
What does Perl look like? |
||
($_=q|cevag"znkvzhz:";@_=(2..<>);juvyr($a=fuvsg@_){cevag"$a ";@_=terc{$_%$a}@_;}|)=~tr|a-z|n-za-m|;eval"$_";
|
||
What does Perl look like? |
||
use Lingua::Romana::Perligata; adnota Illud Cribrum Eratothenis maximum tum val inquementum tum biguttam tum stadium egresso scribe. vestibulo perlegementum da meo maximo. maximum tum novumversum egresso scribe. da II tum maximum conscribementa meis listis. dum damentum nexto listis decapitamentum fac sic lista sic hoc tum nextum recidementum cis vannementa da listis. next tum biguttam tum stadium tum nextum tum novumversum scribe egresso. cis.
|
||
What does Perl look like? |
||
# Accept a number from the user print "maximum:"; $maximum = <STDIN>; # Make an array of numbers @numbers = (2..$maximum); # Iterate through that array while ($prime = shift @numbers) { # Print the next prime print "$prime\n"; # Remove multiples of that prime @numbers = grep {$_ % $prime} @numbers; } |
||
Motto |
||
|
||
Syntax |
||
|
||
Overview |
||
% perl my_program % chmod u+x my_program % my_program |
||
Interpreter |
||
#!/usr/athena/bin/perl # Use /usr/bin/perl on most Unix systems |
||
Pragmata |
||
#!/usr/athena/bin/perl use strict; use warnings; |
||
General |
||
#!/usr/athena/bin/perl # The Perl version of "Hello, world." use strict; use warnings; print "Just another Perl hacker.\n"; |
||
Data Types |
||
|
||
Scalars |
||
|
||
Scalars |
||
|
||
Scalars |
||
$apple_variety = "Golden Delicious"; $apple_color = "yellow"; |
||
Scalars |
||
use strict; my $apple_variety; # Value undefined $apple_variety = "Red Delicious"; # Defined $apple_vareity = "Granny Smith"; # Error my $apple_color = "red"; # Declare and define |
||
Scalars |
||
my $quantity = 6; # Declare & define $quantity = "half dozen"; # Now a string $quantity = 0.5 * 12; # Numeric again |
||
Arrays |
||
|
||
Arrays |
||
my @fibonacci = (1, 1, 2, 3, 5, 8, 11); # Numbers my @fruits = ("apples", "bananas", "cherries"); # Strings my @grade_synonyms = (100, "A++", "Perfect"); # Both |
||
Arrays |
||
my @fruits = ("apples", "bananas", "cherries"); print "Fruit flies like $fruits[1].\n"; print "Life is like a bowl of $fruits[$#fruits].\n"; print "We need more $fruits[-3] to make the pie.\n"; $fruits[0] = "oranges"; # Replace apples with oranges Output: Fruit flies like bananas. Life is like a bowl of cherries. We need more apples to make the pie. |
||
Arrays |
||
@prime_numbers = (2, 3, 5, 7, 11, 13); # Comma-separated @composite_numbers = (4, 6, 8..10, 12, 14..16); # Numeric ranges @fruits = ("apples", "bananas", "cherries"); @fruits = qw(apples bananas cherries); # Same as above @veggies = qw(radishes spinach); @grocery_list = (@fruits, @veggies, "milk"); print "@grocery_list\n"; Output: apples bananas cherries radishes spinach milk |
||
Arrays |
||
my @fruits; # Undefined @fruits = qw(apples bananas cherries); # Assigned @fruits = (@fruits, "dates"); # Lengthen @fruits = (); # Empty unshift @fruits, "acorn"; # Add an item to the front my $nut = shift @fruits; # Remove from the front print "Well, a squirrel would think an $nut was a fruit.\n"; push @fruits, "mango"; # Add an item to the end my $food = pop @fruits; # Remove from the end print "My, that was a yummy $food!\n"; Well, a squirrel would think an acorn was a fruit. My, that was a yummy mango! |
||
Arrays |
||
my @fruits = qw(apples bananas cherries oranges); my @yummy = @fruits[1,3]; print "My favorite fruits are: @yummy\n"; my @berries = @fruits[2]; push @berries, "cranberries"; print "These fruits are berries: @berries\n"; Output: My favorite fruits are: bananas oranges These fruits are berries: cherries cranberries |
||
Arrays |
||
my @fruits = qw(apple orange grape cranberry); foreach my $fruit (@fruits) { print "We have $fruit juice in the refrigerator.\n"; } Output: We have apple juice in the refrigerator. We have orange juice in the refrigerator. We have grape juice in the refrigerator. We have cranberry juice in the refrigerator. |
||
Hashes |
||
|
||
Hashes |
||
my %wheels = (unicycle => 1, bike => 2, tricycle => 3, car => 4, semi => 18); |
||
Hashes |
||
print "A bicycle has $wheels{bike} wheels.\n"; $wheels{bike} = 4; # Adds training wheels print "A bicycle with training wheels has $wheels{bike} wheels.\n"; Output: A bicycle has 2 wheels. A bicycle with training wheels has 4 wheels. |
||
Hashes |
||
my %dessert = ("pie", "apple", "cake", "carrot", "sorbet", "orange"); %dessert = (pie => "apple", cake => "carrot", sorbet => "orange"); # Same, but easier to read my %ice_cream = (bowl => "chocolate", float => "root beer"); my %choices = (%dessert, %ice_cream); print "I would like $choices{sorbet} sorbet.\n"; Output: I would like orange sorbet. |
||
Hashes |
||
my %wheels = (unicycle => 1, bike => 2, tricycle => 3); $wheels{car} = 4; # Creates a new key/value pair $wheels{van} = 4; # Creates another new key/value pair delete $wheels{unicycle}; |
||
Hashes |
||
my %sounds = (cow => "moooo", duck => "quack", horse => "whinny", sheep => "baa", hen => "cluck", pig => "oink"); my @barnyard_sounds = @sounds{"horse", "hen", "pig"}; print "I heard the following in the barnyard: @barnyard_sounds\n"; Output: I heard the following in the barnyard: whinny cluck oink |
||
Hashes |
||
my @animals = keys %sounds; my @noises = values %sounds; while (my ($animal, $noise) = each %sounds) { print "Old MacDonald had a $animal."; print " With a $noise! $noise! here...\n"; } Output: Old MacDonald had a sheep. With a baa! baa! here... Old MacDonald had a cow. With a moooo! moooo! here... Old MacDonald had a hen. With a cluck! cluck! here... Old MacDonald had a pig. With a oink! oink! here... Old MacDonald had a duck. With a quack! quack! here... Old MacDonald had a horse. With a whinny! whinny! here... |
||
Context |
||
|
||
Numeric Context |
||
my $number; my $string; # Zero in numeric context $number = $string + 17; print "Number is $number.\n"; $string = "5.2"; # 5.2 in numeric context $number = $string + 17; print "Number is $number.\n"; $string = "five"; # Zero in numeric context $number = $string + 17; print "Number is $number.\n"; Number is 17. Number is 22.2. Number is 17. |
||
String Context |
||
|
||
String Context |
||
my $string; my $number; # Empty string in string context $string = $number . 17; # Concatenate print "String is '$string'\n"; $number = 5.2; # "5.2" in string context $string = $number . 17; print "String is '$string'\n"; $number = 5.2; $string = sprintf("%.2f", $number); # Formatting print "String is '$string'\n"; String is '17' String is '5.217' String is '5.20' |
||
Boolean Context |
||
my $string; if ($string) { print "A: Hello, $string.\n"; } $string = "world"; if ($string) { print "B: Hello, $string.\n"; } B: Hello, world. |
||
List Context |
||
$last_item = qw(goldfish cat dog); # $last_item = "dog"; @pets = qw(goldfish cat dog); # entire list $count = @pets; # $count = 3; @new_pets = @pets; # entire array %pets = (goldfish => "glub", cat => "meow", dog => "woof"); $boolean = %pets; # true @mix = %pets; # ("goldfish", ..., "woof") %new_pets = %pets; # entire hash |
||
Operators |
||
|
||
Numeric Operators |
||
my $i = 17; $i = ($i + 3) * 2; # Parentheses for order of operation $i++; # $i = $i + 1; $i *= 3; # $i = $i * 3; print "$i\n"; 123 |
||
String Operators |
||
$bark = "Woof!"; $bark .= " "; # Append a space $bark x= 5; # Repeat 5 times print "The dog barked: $bark\n"; The dog barked: Woof! Woof! Woof! Woof! Woof! |
||
Quoting Operators |
||
my $cat = "meow"; my $sound = "$cat"; # $sound = "meow" my $variable = '$cat'; # $variable = "\$cat" print "$variable says $sound\n"; $sound = qq{"meow"}; # If you want to quote quotes $sound = qq("meow"); # Same print "$variable says $sound\n"; $contents = `cat $sound`; # contents of file "meow" $cat says meow $cat says "meow" |
||
Boolean Operators |
||
my ($x, $y) = (12, 100); my $smaller = $x < $y ? $x : $y; print "The smaller number is $smaller.\n"; The smaller number is 12. |
||
Boolean Operators |
||
my ($a, $b) = ("apple", "orange"); print "1: apples are oranges\n" if ($a eq $b); # False print "2: apples are oranges\n" if ($a == $b); # True! my ($x, $y) = (12, 100); print "3: $x is more than $y\n" if ($x gt $y); # True! print "4: $x is more than $y\n" if ($x > $y); # False 2: apples are oranges 3: 12 is more than 100 |
||
List Operators |
||
|
||
List Operators |
||
my @animals = qw(dog cat fish parrot hamster); my @sorted = reverse sort @animals; print "I have the following pets: @sorted\n"; my $word = "backwards"; my $mirror = reverse $word; print qq("$word" reversed is "$mirror"\n); %by_address = reverse %by_name; # Beware of lost duplicate values I have the following pets: parrot hamster fish dog cat "backwards" reversed is "sdrawkcab" |
||
List Operators |
||
my @animals = qw(dog cat fish parrot hamster); my $string = join(" and a ", @animals); print "I have a $string.\n"; my $sentence = "The quick brown fox..."; my @words = split(" ", $sentence); I have a dog and a cat and a fish and a parrot and a hamster. |
||
List Operators |
||
my @juices = qw(apple cranapple orange grape apple-cider); my @apple = grep(/apple/, @juices); print "These juices contain apple: @apple\n"; my @primes = (2, 3, 5, 7, 11, 13, 17, 19); my @small = grep {$_ < 10} @primes; # $_ is each element of @primes print "The primes smaller than 10 are: @small\n"; These juices contain apple: apple cranapple apple-cider The primes smaller than 10 are: 2 3 5 7 |
||
List Operators |
||
my @primes = (2, 3, 5, 7, 11, 13, 17, 19); my @doubles = map {$_ * 2} @primes; print "The doubles of the primes are: @doubles\n"; my @small = map {$_ < 10 ? $_ : ()} @primes; # grep {$_ < 10} @primes print "The primes smaller than 10 are: @small\n"; The doubles of the primes are: 4 6 10 14 22 26 34 38 The primes smaller than 10 are: 2 3 5 7 |
||
Flow Control |
||
|
||
Conditional Statements |
||
my ($a, $b) = (0, 1); if (!$a && !$b) {print "Neither\n";} # Conventional if (not $a and not $b) {print "Neither\n";} # Same, but in English if (not ($a or $b)) {print "Neither\n";} # Same, but parentheses unless ($a or $b) {print "Neither\n";} # Same, but clearest |
||
Loop Statements |
||
while ($hungry) { $hungry = eat($banana); } do { $answer = get_answer(); $correct = check($answer); } until ($correct); |
||
Loop Statements |
||
for (my $i = 10; $i >= 0; $i--) { print "$i...\n"; # Countdown } foreach my $i (reverse 0..10) { print "$i...\n"; # Same } %hash = (dog => "lazy", fox => "quick"); foreach my $key (keys %hash) { print "The $key is $hash{$key}.\n"; # Print out hash pairs } The fox is quick. The dog is lazy. |
||
Modifiers |
||
$a = $default unless defined $a; $b = $default unless defined $b; $c = $default unless defined $c; $balance += $deposit if $deposit; $balance -= $withdrawal if $withdrawal and $withdrawal <= $balance; |
||
Subroutines |
||
|
||
Declaring Subroutines |
||
sub ten { return wantarray() ? (1 .. 10) : 10; } @ten = ten(); # (1, 2, 3, 4, 5, 6, 7, 8, 9, 10) $ten = ten(); # 10 ($ten) = ten(); # (1) ($one, $two) = ten(); # (1, 2) |
||
Handling Arguments |
||
sub add_one { # Like pass by value my ($n) = @_; # Copy first argument return ($n + 1); # Return 1 more than argument } sub plus_plus { # Like pass by reference $_[0] = $_[0] + 1; # Modify first argument } my ($a, $b) = (10, 0); add_one($a); # Return value is lost, nothing changes $b = add_one($a); # $a is 10, $b is 11 plus_plus($a); # Return value lost, but a now is 11 $b = plus_plus($a); # $a and $b are 12 |
||
Calling Subroutines |
||
print factorial(5) . "\n"; # Parentheses required sub factorial { my ($n) = @_; return $n if $n <= 2; $n * factorial($n - 1); } print factorial 5 . "\n"; # Parentheses not required print &factorial(5) . "\n"; # Neither () nor & required |
||
Subroutines - Example |
||
sub fibonacci { my ($n) = @_; die "Number must be positive" if $n <= 0; return 1 if $n <= 2; return (fibonacci($n-1) + fibonacci($n-2)); } foreach my $i (1..5) { my $fib = fibonacci($i); print "fibonacci($i) is $fib\n"; } fibonacci(1) is 1 fibonacci(2) is 1 fibonacci(3) is 2 fibonacci(4) is 3 fibonacci(5) is 5 |
||
References |
||
|
||
Referencing Data |
||
my @fruit = qw(apple banana cherry); my $fruitref = \@fruit; |
||
Dereferencing Data |
||
my @fruit = qw(apple banana cherry); my $fruitref = \@fruit; print "I have these fruits: @$fruitref.\n"; print "I want a $fruitref->[1].\n"; I have these fruits: apple banana cherry. I want a banana. |
||
Anonymous Data |
||
my $fruits = ["apple", "bananas", "cherries"]; my $wheels = {unicycle => 1, bike => 2, tricycle => 3, car => 4, semi => 18}; print "A car has $wheels->{car} wheels.\n"; A car has 4 wheels. |
||
Hierarchical Data |
||
my $fruits = ["apple", "bananas", "cherries"]; my $veggies = ["spinach", "turnips"]; my $grains = ["rice", "corn"]; my @shopping_list = ($fruits, $veggies, $grains); print "I should remember to get $shopping_list[2]->[1].\n"; print "I should remember to get $shopping_list[0][2].\n"; I should remember to get corn. I should remember to get cherries. |
||
Files |
||
|
||
File Access |
||
open INPUT, "< datafile" or die "Can't open input file: $!"; open OUTPUT, "> outfile " or die "Can't open output file: $!"; open LOG, ">> logfile " or die "Can't open log file: $!"; open RWFILE, "+< myfile " or die "Can't open file: $!"; close INPUT; |
||
Standard Files |
||
print STDOUT "Hello, world.\n"; # STDOUT not needed open STDERR, ">> logfile" or die "Can't redirect errors to log: $!"; print STDERR "Oh no, here's an error message.\n"; warn "Oh no, here's another error message.\n"; close STDERR; |
||
Reading from Files |
||
print "What type of pet do you have? "; my $pet = <STDIN>; # Read a line from STDIN chomp $pet; # Remove newline print "Enter your pet's name: "; my $name = <>; # STDIN is optional chomp $name; print "Your pet $pet is named $name.\n"; What type of pet do you have? parrot Enter your pet's name: Polly Your pet parrot is named Polly. |
||
Reading from Files |
||
open CUSTOMERS, "< mailing_list" or die "Can't open input file: $!"; while (my $line = <CUSTOMERS>) { my @fields = split(":", $line); # Fields separated by colons print "$fields[1] $fields[0]\n"; # Display selected fields print "$fields[3], $fields[4]\n"; print "$fields[5], $fields[6] $fields[7]\n"; } print while <>; # cat print STDOUT $_ while ($_ = <STDIN>); # same, but more verbose Last name:First name:Age:Address:Apartment:City:State:ZIP Smith:Al:18:123 Apple St.:Apt. #1:Cambridge:MA:02139 Al Smith 123 Apple St., Apt. #1 Cambridge, MA 02139 |
||
Writing to Files |
||
open CUSTOMERS, "< mailing_list" or die "Can't open input file: $!"; open LABELS, "> labels" or die "Can't open output file: $!"; while (my $line = <CUSTOMERS>) { my @fields = split(":", $line); print LABELS "$fields[1] $fields[0]\n"; print LABELS "$fields[3], $fields[4]\n"; print LABELS "$fields[5], $fields[6] $fields[7]\n"; } |
||
Pipes |
||
# Use another process as input open INPUT, "ps aux |" or die "Can't open input command: $!"; # Print labels to printer instead of to a file open LABELS, "| lpr" or die "Can't open lpr command: $!"; |
||
File Checks |
||
my $filename = "pie_recipe"; if (-r $filename) { open INPUT, "> $filename" or die "Can't open $filename: $!"; } else { print "The file $filename is not readable.\n"; } |
||
Regular Expressions |
||
|
||
Regular Expressions |
||
my $string = "Did the fox jump over the dogs?"; print "1: $string\n" if $string =~ /dog/; # matches print "2: $string\n" if $string !~ /z/; # matches print "3: $string\n" if $string =~ /^[Yy]/; print "4: $string\n" if $string =~ /\?$/; # matches print "5: $string\n" if $string =~ /^[a-zA-Z]*$/; print "6: $string\n" if $string =~ /^\d*$/; |
||
Regular Expressions |
||
my $string = "Did the fox jump over the dogs?"; print "1: $string\n" if $string =~ /dog/; # matches print "2: $string\n" if $string =~ m/dog/; # matches print "3: $string\n" if $string =~ m(dog); # matches print "4: $string\n" if $string =~ m|dog|; # matches |
||
Regular Expressions |
||
my $string = "Did the fox jump over the dogs?"; print "1: $string\n" if $string =~ m/[bdl]og/; # bog, dog, log print "2: $string\n" if $string =~ m/dog[^s]/; # no match print "3: $string\n" if $string =~ m/\s\w\w\wp\s/; # matches |
||
Regular Expressions |
||
my $string = "Did the fox jump over the dogs?"; print "1: $string\n" if $string =~ m/^[Yy]/; # no match print "2: $string\n" if $string =~ m/\?$/; # match print "3: $string\n" if $string =~ m/the\b/; # match |
||
Regular Expressions |
||
my $string = "Did the fox jump over the dogs?"; print "1: $string\n" if $string =~ m/z*/; # matches print "2: $string\n" if $string =~ m/z+/; # no match print "3: $string\n" if $string =~ m/\b\w{4}\b/; # matches "jump" |
||
Regular Expressions |
||
my $string = "Did the fox jump over the dogs?"; print "1: $string\n" if $string =~ m/(fox){2}/; # "foxfox" print "2: $string\n" if $string =~ m/(the\s).*\1/; # matches |
||
Regular Expressions |
||
my $string = "Did the fox jump over the dogs?"; $string =~ s/dog/cat/; # substitute "cat" for "dog" $string =~ s(fox)(kangaroo); # substitute "kangaroo" for "fox" print "$string\n"; $string =~ tr/a-z/n-za-m/; # Rot13 print "$string\n"; Did the kangaroo jump over the cats? Dvq gur xnatnebb whzc bire gur pngf? |
||
Regular Expressions |
||
my $breakfast = 'Lox Lox Lox lox and bagels'; $breakfast =~ s/Lox //g; print "$string\n"; my $paragraph = "First line\nSecond Line\nThird Line\n"; my ($first,$second) = ($paragraph =~ /(^.*$)(^.*$)/); print "$first $second\n"; lox and bagels |
||
CPAN |
||
athena% perl -MCPAN -e shell cpan> install Module |
||
Modules |
||
use CGI qw(:standard); print header, start_html('A Simple Example'), h1('A Simple Example'), p("Hello, World"), end_html; |
||
Object Oriented Programming |
||
|
||
Object Terminology |
||
|
||
Three Rules |
||
package MyCar; # Constructor method sub new { my $self = { wheels => 4, speed => 0, gas => 10}; bless $self, "MyClass"; } |
||
Methods Types |
||
# Accessor Methods sub wheels { my $self = shift; return $self->{wheels}; } sub speed { my $self = shift; return $self->{speed}; } sub gas { my $self = shift; return $self->{gas}; } # Mutator Methods sub accelerate { my $self = shift; $self->{speed} += 1; $self->{gas} -= 0.1; } sub brake { my $self = shift; $self->{speed} -= 1; } |
||
Arrow Operator |
||
# Create a new MyCar object using a class method (constructor) my $car = MyCar->new(); # Access data from the new object using an object method (accessor) print "The car has " . $car->gas() . " gallons of gasoline.\n"; # Modify data for (1..10) {$car->accelerate();} print "The car has " . $car->gas() . " gallons of gasoline.\n"; The car has 10 gallons of gasoline. The car has 9 gallons of gasoline. |
||
Shapes Example |
||
|
||
CGI |
||
|
||
CGI.pm |
||
use CGI qw(:standard); print header(), start_html('A Simple Example'), h1('A Simple Example'), p("Hello, World"), end_html(); Content-Type: text/html; charset=ISO-8859-1 <?xml version="1.0" encoding="utf-8"?> <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML Basic 1.0//EN" "http://www.w3.org/TR/xhtml-basic/xhtml-basic10.dtd"> <html xmlns="http://www.w3.org/1999/xhtml" lang="en-US"> <head><title>A Simple Example</title> </head> <body><h1>A Simple Example</h1><p>Hello, World</p></body> </html> |
||
CGI vs. HTML |
||
<!-- Old invalid HTML --> <HTML> <HEAD> <TITLE>A Simple Example</TITLE> </HEAD> <BODY> <H1>A Simple Example</H1> <P> Hello, World </BODY> </HTML> |
||
CGI Security |
||
#!/usr/athena/bin/perl # A REALLY BAD IDEA! print "Finger whom? "; $user = <>; $output = `finger $user`; print "$output\n"; Finger whom? rjbarbal Finger whom? ; rm -rf / |
||
Taint |
||
#!/usr/athena/bin/perl -T use strict; use warnings; # Prompt and get user input print "Finger whom? "; my $user = <>; # Untaint user input if ($user =~ /^(\w*)$/) { $user = $1; } else { die "Illegal username"; } # Make path safe $ENV{'PATH'} = '/bin:/usr/bin:/usr/athena/bin/'; # Command is now safe my $output = `finger $user`; print "$output\n"; |
||
CGI Example |
||
#!/usr/athena/bin/perl -T use strict; use warnings; use CGI qw( :standard ); # Make path safe $ENV{'PATH'} = '/bin:/usr/bin:/usr/athena/bin/'; print header(), start_html('A Simple Example'), h1('A Simple Example'), start_form(), "Finger whom? ", textfield('user'), submit(), end_form(), hr(); # Get user input my $user = param('name'); if ($name) { # Untaint user input if ($user =~ /^(\w*)$/) { $user = $1; } else { print p("Illegal username. Please try again."); } # Command is now safe my $output = `finger $user`; print pre("$output\n"), hr(); } print end_html(); |
||
Learning More |
||
|
||
Books |
||
|
||
Documentation |
||
|
||
Documentation |
||
|
||
Documentation |
||
|
||
Web Sites |
||
|
||
Mailing Lists & Newsgroups |
||
|