#!/usr/local/bin/perl $count = 1; do { print ("$count\n"); $count++; } while ($count <= 10);
#!/usr/local/bin/perl for ($count = 1; $count <= 10; $count++) { print ("$count\n"); }
#!/usr/local/bin/perl for ($count = 1; $count <= 5; $count++) { $line = <STDIN>; last if ($line eq ""); print ($line); }
#!/usr/local/bin/perl for ($count = 1; $count <= 20; $count++) { next if ($count % 2 == 1); print ("$count\n"); }
#!/usr/local/bin/perl $linenum = 0; while ($line = <STDIN>) { $linenum += 1; $occurs = 0; $line =~ tr/A-Z/a-z/; @words = split(/\s+/, $line); foreach $word (@words) { $occurs += 1 if ($word eq "the"); } if ($occurs > 0) { print ("line $linenum: $occurs occurrences\n"); } }
#!/usr/local/bin/perl $count = 10; while ($count >= 1) { print ("$count\n"); } continue { $count-; }
sub add_two { local ($arg1, $arg2) = @_; $result = $arg1 + $arg2; }
sub count_t { local ($string) = @_; # There are a couple of tricks you can use to do this. # This one splits the string into words using "t" as # the split pattern. The number of occurrences of "t" # is one less than the number of words resulting from # the split. @dummy = split(/t/, $string); $retval = @dummy - 1; }
sub diff { local ($file1, $file2) = @_; # return false if we can't open a file return (0) unless open (FILE1, "$file1"); return (0) unless open (FILE2, "$file2"); while (1) { $line1 = <FILE1>; $line2 = <FILE2>; if ($line1 eq "") { $retval = ($line2 eq ""); last; } if ($line2 eq "" || $line1 ne $line2) { $retval = 0; last; } } # you should use close here, as this subroutine may # be called many times close (FILE1); close (FILE2); # ensure that the return value is the last evaluated # expression $retval; }
sub dieroll { $retval = int (rand(6)) + 1; }
# assume that the first call to printlist passes the argument # 0 as the value for $index sub printlist { local ($index, @list) = @_; if ($index + 1 < @list) { &printlist ($index+1, @list); } # the conditional handles the case of an empty list print ("$list[$index]\n") if (@list > 0); }
#!/usr/local/bin/perl while ($line = <STDIN>) { $line =~ s/^\s+|\s+$//g; ($subscript, $value) = split(/\s+/, $line); $array{$subscript} = $value; }
#!/usr/local/bin/perl $linenum = 0; while ($line = <STDIN>) { $linenum += 1; $line =~ s/^\s+|\s+$//g; @words = split(/\s+/, $line); if ($words[0] eq "index" && $index{$words[1]} eq "") { $index{$words[1]} = $linenum; } } foreach $item (sort keys (%index)) { print ("$item: $index{$item}\n"); }
#!/usr/local/bin/perl $linenum = 0; while ($line = <STDIN>) { $linenum += 1; $line =~ s/^\s+|\s+$//g; @words = split(/\s+/, $line); # This program uses a trick: for each word, the array # item $index{"word"} stores the number of occurrences # of that word. Each occurrence is stored in the # element $index{"word#n"}, where[]is a # positive integer. if ($words[0] eq "index") { if ($index{$words[1]} eq "") { $index{$words[1]} = 1; $occurrence = 1; } else { $index{$words[1]} += 1; $occurrence = $index{$words[1]}; } $index{$words[1]."#".$occurrence} = $linenum; } } # The loop that prints the index takes advantage of the fact # that, when the list is sorted, the elements that count # occurrences are always processed just before the # corresponding elements that store occurrences. For example: # $index{word} # $index{word#1} # $index{word#2} foreach $item (sort keys (%index)) { if ($item =~ /#/) { print ("\n$item:"); } else { print (" $index{$item}"); } } print ("\n");
#!/usr/local/bin/perl $student = 0; @subjects = ("English", "history", "mathematics", "science", "geography"); while ($line = <STDIN>) { $line =~ s/^\s+|\s+$//g; @words = split (/\s+/, $line); @students[$student++] = $words[0]; for ($count = 1; $count <= 5; $count++) { $marks{$words[0].$subjects[$count-1]} = $words[$count]; } } # now print the failing grades, one student per line foreach $student (sort (@students)) { $has_failed = 0; foreach $subject (sort (@subjects)) { if ($marks{$student.$subject} < 50) { if ($has_failed == 0) { $has_failed = 1; print ("$student failed:"); } print (" $subject"); } } if ($has_failed == 1) { print ("\n"); } }
#!/usr/local/bin/perl for ($count = 1; $count <= 9; $count += 3) { $num1 = 2 ** $count; $num2 = 2 ** ($count + 1); $num3 = 2 ** ($count + 2); write; } $num1 = 2 ** 10; $num2 = $num3 = ""; write; format STDOUT = ^>>> ^>>> ^>>> $num1 $num2 $num3 .
#!/usr/local/bin/perl for ($count = 1; $count <= 10; $count++) { printf ("%4d", 2 ** $count); if ($count % 3 == 0) { print ("\n"); } else { print (" "); } } print ("\n");
#!/usr/local/bin/perl @text = <STDIN>; $line = join("", @text); write; format STDOUT = ****************************************** ~~^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< $line ****************************************** .
#!/usr/local/bin/perl $total1 = $total2 = 0; while (1) { $num1 = <STDIN>; last if ($num1 eq ""); chop ($num1); $num2 = <STDIN>; last if ($num2 eq ""); chop ($num2); $~ = "LINE"; write; $total1 += $num1; $total2 += $num2; } $~ = "TOTAL"; write; $~ = "GRAND_TOTAL"; write; format LINE = @####.## @####.## $num1 $num2 . format TOTAL = column totals: @#####.## @#####.## $total1 $total2 . format GRAND_TOTAL = grand total: @#####.## $total1 + $total2 .
#!/usr/local/bin/perl opendir (MYDIR, "/u/jqpublic") || die ("Can't open directory"); while ($file = readdir (MYDIR)) { next if ($file =~ /^\.{1,2}$|^[^.]/); print ("$file\n"); } closedir (MYDIR);
#!/usr/local/bin/perl $filecount = 1; &print_dir ("/u/jqpublic"); sub print_dir { local ($dirname) = @_; local ($file, $subdir, $filevar); $filevar = "MYFILE" . $filecount++; opendir ($filevar, $dirname) || die ("Can't open directory"); # first pass: read and print file names print ("\ndirectory $dirname:\n"); while ($file = readdir ($filevar)) { next if ($file eq "." || $file eq ".."); next if (-d ($dirname . "/" . $file)); print ("$file\n"); } # second pass: recursively print subdirectories rewinddir ($filevar); while ($subdir = readdir ($filevar)) { next unless (-d ($dirname . "/" . $subdir)); next if ($subdir eq "." || $subdir eq ".."); &print_dir ($dirname . "/" . $subdir); } closedir ($filevar); }
#!/usr/local/bin/perl opendir (MYDIR, "/u/jqpublic") || die ("Can't open directory"); # the following is a trick: "." is alphabetically less than # anything we want to print, so it makes a handy # initial value $lastfile = "."; until (1) { rewinddir (MYDIR); $currfile = ""; while ($file = readdir (MYDIR)) { next if ($file =~ /^\./); if ($file gt $lastfile && ($currfile eq "" || $file lt $currfile)) { $currfile = $file; } } last if ($currfile eq ""); print ("$currfile\n"); $lastfile = $currfile; } closedir (MYDIR);
#!/usr/local/bin/perl @digits = ("zero", "one", "two", "three", "four", "five", "six", "seven", "eight", "nine"); &start_hot_keys; while (1) { $char = getc(STDIN); last if ($char eq "\033"); next if ($char =~ /[^0-9]/); print ("$digits[$char]\n"); } &end_hot_keys; sub start_hot_keys { system ("stty cbreak"); system ("stty -echo"); } sub end_hot_keys { system ("stty -cbreak"); system ("stty echo"); }
#!/usr/local/bin/perl $dir = "/u/dave/newperl/testdir"; opendir (MYDIR, $dir) || die ("Can't open directory"); chdir ($dir); while ($file = readdir (MYDIR)) { next if (-d $file); next if ($file eq "." || $file eq ".."); if ($file =~ /\.pl$/) { @stat = stat($file); chmod (($stat[2] | 0700), $file); } else { chmod (0400, $file); } } closedir (MYFILE);
#!/usr/local/bin/perl $child = fork(); if ($child == 0) { print ("This line goes first\n"); exit (0); } else { $child2 = fork(); if ($child2 == 0) { waitpid ($child, 0); print ("This line goes second\n"); exit (0); } else { waitpid ($child2, 0); print ("This line goes third\n"); } }
#!/usr/local/bin/perl open (OUTFILE, ">temp") || die ("Can't open output"); while ($line = <STDIN>) { print OUTFILE ($line); } close (OUTFILE); exec ("ch13.2a");
#!/usr/local/bin/perl for ($val = 1; $val <= 100; $val++) { print ("log of $val is ", log($val), "\n"); }
#!/usr/local/bin/perl for ($i = 1; $i <= 6; $i++) { &sum(10 ** $i); } sub sum { local($limit) = @_; local(@startval, @stopval); local($i, $count); $count = 0; @startval = times(); for ($i = 1; $i <= $limit; $i++) { $count += $i; } @stopval = times(); print ("sum $limit: ", $stopval[0]-$startval[0], "\n"); }
#!/usr/local/bin/perl $degrees = <STDIN>; chop ($degrees); $radians = $degrees * atan2(1,1) / 45; $sin = sin ($radians); $cos = cos ($radians); print ("sin of $degrees is ", $sin, "\n"); print ("cos of $degrees is ", $cos, "\n"); print ("tan of $degrees is ", $sin/$cos, "\n");
#!/usr/local/bin/perl @searchletters = ("a", "e", "i", "o", "u"); $inputline = <STDIN>; foreach $letter (@searchletters) { printf("searching for $letter...\n"); $location = 0; while (1) { $location = index ($inputline, $letter, $location); last if ($location == -1); print("\tfound at location $location\n"); $location += 1; } }
#!/usr/local/bin/perl @searchletters = ("a", "e", "i", "o", "u"); $inputline = <STDIN>; foreach $letter (@searchletters) { printf("searching for $letter...\n"); $location = length ($inputline); while (1) { $location = rindex ($inputline, $letter, $location); last if ($location == -1); print("\tfound at location $location\n"); $location -= 1; } }
#!/usr/local/bin/perl @searchletters = ("a", "e", "i", "o", "u"); $inputline = <STDIN>; $len = length ($inputline); foreach $letter (@searchletters) { print ("searching for $letter...\n"); $currpos = 0; while ($currpos < $len) { $substring = substr ($inputline, $currpos, 1); if ($letter eq $substring) { print("\tfound at location $currpos\n"); } $currpos++; } }
#!/usr/local/bin/perl $_ = <STDIN>; # reads to $_ by default print ("number of a's found: ", tr/a/a/, "\n"); print ("number of e's found: ", tr/e/e/, "\n"); print ("number of i's found: ", tr/i/i/, "\n"); print ("number of o's found: ", tr/o/o/, "\n"); print ("number of u's found: ", tr/u/u/, "\n");
#!/usr/local/bin/perl $number = <STDIN>; if ($number =~ /\.|[eE]/) { printf ("in exponential form: %e\n", $number); printf ("in fixed-point form: %f\n", $number); } else { printf ("in decimal form: %d\n", $number); printf ("in octal form: 0%o\n", $number); printf ("in hexadecimal form: 0x%x\n", $number); }
#!/usr/local/bin/perl $string1 = <STDIN>; chop ($string1); $len1 = length ($string1); $string2 = <STDIN>; chop ($string2); $len2 = length ($string2); if ($len1 % 8 != 0) { $string1 = "0" x (8 - $len1 % 8) . $string1; $len1 += 8 - $len1 % 8; } if ($len2 % 8 != 0) { $string2 = "0" x (8 - $len2 % 8) . $string2; $len2 += 8 - $len2 % 8; } if ($len1 > $len2) { $string2 = "0" x ($len1 - $len2) . $string2; } else { $string1 = "0" x ($len2 - $len1) . $string1; $len1 += ($len2 - $len1); } $bytes1 = pack ("b*", $string1); $bytes2 = pack ("b*", $string2); $carry = 0; $count = $len1 - 1; while ($count >= 0) { $bit1 = vec ($bytes1, $count, 1); $bit2 = vec ($bytes2, $count, 1); $result = ($bit1 + $bit2 + $carry) & 1; $carry = ($bit1 + $bit2 + $carry) >> 1; vec ($bytes1, $count, 1) = $result; $count-; } $resultstring = unpack ("b*", $bytes1); $resultstring = $carry . $resultstring if ($carry > 0); print ("$resultstring\n");
#!/usr/local/bin/perl $string1 = <STDIN>; chop ($string1); $len1 = length ($string1); $string2 = <STDIN>; chop ($string2); $len2 = length ($string2); if ($len1 % 8 != 0) { $string1 = "0" x (8 - $len1 % 8) . $string1; $len1 += 8 - $len1 % 8; } if ($len2 % 8 != 0) { $string2 = "0" x (8 - $len2 % 8) . $string2; $len2 += 8 - $len2 % 8; } if ($len1 > $len2) { $string2 = "0" x ($len1 - $len2) . $string2; } else { $string1 = "0" x ($len2 - $len1) . $string1; $len1 += ($len2 - $len1); } $bytes1 = pack ("h*", $string1); $bytes2 = pack ("h*", $string2); $carry = 0; $count = $len1 - 1; while ($count >= 0) { $nybble1 = vec ($bytes1, $count, 4); $nybble2 = vec ($bytes2, $count, 4); $result = ($nybble1 + $nybble2 + $carry) & 15; $carry = ($nybble1 + $nybble2 + $carry) >> 4; vec ($bytes1, $count, 4) = $result; $count-; } $resultstring = unpack ("h*", $bytes1); $resultstring = $carry . $resultstring if ($carry > 0); print ("$resultstring\n");
#!/usr/local/bin/perl $value = <STDIN>; $value *= 100; $value = int ($value + 0.5); $value = sprintf ("%.2f", $value / 100); print ("$value\n");
#!/usr/local/bin/perl $passwd = crypt ("bluejays", "ez"); $try = 1; while (1) { print ("Enter the secret password:\n"); system ("stty -echo"); $guess = <STDIN>; system ("stty echo"); if (crypt ($guess, substr ($passwd, 0, 2)) eq $passwd) { print ("Correct!\n"); last; } if ($try == 3) { die ("Sorry! Goodbye!\n"); } print ("Try again - "); $try++; }
#!/usr/local/bin/perl # This program uses a very dumb sorting algorithm. @list = (41, 26, 11, 9, 8); # sample list to sort for ($outer = 0; $outer < @list; $outer++) { for ($inner = 0; $inner < @list; $inner++) { if ($list[$inner] > $list[$inner+1]) { $x = splice (@list, $inner, 1); splice (@list, $inner+1, 0, $x); } } }
#!/usr/local/bin/perl # assume %oldarray is assigned here while (($subscript, $value) = each (%oldarray)) { if (defined ($newarray{$value})) { print STDERR ("$value already defined\n"); } else { $newarray{$value} = $subscript; } }
#!/usr/local/bin/perl while ($line = <STDIN>) { @words = split (/\s+/, $line); @shortwords = grep (/^.{1,5}$/, @words); print ("@shortwords\n"); }
#!/usr/local/bin/perl $line = <STDIN>; $line =~ s/^\s+//; while (1) { last if ($line eq ""); ($word, $line) = split (/\s+/, $line, 2); print ("$word\n"); }
#!/usr/local/bin/perl while (($gname, $password, $groupid, $userids) = getgrent()) { $garray{$gname} = $userids; } foreach $gname (sort keys (%garray)) { print ("Group $gname:\n"); @userids = split (/\s+/, $garray{$gname}); foreach $userid (sort (@userids)) { print ("\t$userid\n"); } }
#!/usr/local/bin/perl while (($name, $d1, $d2, $d3, $d4, $d5, $d6, $homedir) = getpwent()) { $dirlist{$name} = $homedir; } foreach $name (sort keys (%dirlist)) { printf ("userid %-15s has home directory %s\n", $name, $dirlist{$name}); }
#!/usr/local/bin/perl while (@retval = getpwent()) { $retval[8] = "<null>" if ($retval[8] eq ""); $shellarray{$retval[8]} += 1; } foreach $shell (sort count keys (%shellarray)) { printf ("%-25s %5d %s\n", $shell, $shellarray{$shell}, ($shellarray{$shell} == 1 ? "occurrence" : "occurrences")); } sub count { $shellarray{$b} <=> $shellarray{$a}; }
#!/usr/local/bin/perl $otherid = fork(); if ($otherid == 0) { # child process $otherid = getppid(); } $| = 1; # eliminate print buffers print ("The process id of the other process is $otherid.\n");
#!/usr/local/bin/perl $port = 2000; while (getservbyport($port, "tcp")) { $port++; } ($d1, $d2, $prototype) = getprotobyname ("tcp"); # in the following, replace "silver" with the name # of your machine ($d1, $d2, $d3, $d4, $rawaddr) = gethostbyname ("silver"); $serveraddr = pack ("Sna4x8", 2, $port, $rawaddr); socket (SSOCKET, 2, 1, $prototype) || die ("No socket"); bind (SSOCKET, $serveraddr) || die ("Can't bind"); listen (SSOCKET, 5) || die ("Can't listen"); while (1) { ($clientaddr = accept (SOCKET, SSOCKET)) || die ("Can't accept"); if (fork() == 0) { select (SOCKET); $| = 1; open (MYFILE, "/u/jqpublic/testfile"); while ($line = <MYFILE>) { print SOCKET ($line); } close (MYFILE); close (SOCKET); exit (0); } }
$ perl -ne "print if (/\bthe\b/);" file1 file2 ...
$ perl -nae 'print ("$F[1]\n");' file1 file2 ...
#!/usr/local/bin/perl -s print ("Hello\n") if ($H == 1); print ("Goodbye\n") if ($G == 1);
$ perl -i -pe "tr/a-z/A-Z/;" file1 file2 ...
#!/usr/local/bin/perl -i while ($line = <>) { while ($line =~ / +/g) { $line = $' . " " . $'; } print ($line); }
#!/usr/local/bin/perl $SIG{"INT"} = stopnum; $num = 1; while (1) { print ("$num\n"); $num++; } sub stopnum { print ("\nInterrupted.\n"); exit (0); }
#!/usr/local/bin/perl $total = 0; while ($line = <DATA>) { @nums = split (/\s+/, $line); foreach $num (@nums) { $total += $num; } } print ("The total is $total.\n"); __END__ 4 17 26 11 9 5
$p1 = @a; $p2 = %a; $p3 = sub { return @_ ; }; printf "\n Array reference = $p1"; printf "\n Hash reference = $p2"; printf "\n Subroutine reference = $p3";
&$list[$index]();
package Zeller; require Exporter; @EXPORT = (Zeller); sub Zeller { my ($month,$day,$year) = @_; <<< Insert code from sample here>>> } 1;
use Zeller; $z = Zeller(7,21,1962); print "\n Day of the week = $z";
$count = scalar (@_); if ($count != 3) { $dt = 'date +\%D'; ($month,$day,$year) = split($_,'/'); else { my ($month,$day,$year) = @_; } $z = Zeller($month,$day,$year);
#!/usr/bin/perl print 'find . -depth -print ';
if (scalar(@_) == 0) { print "\n ================================= \n"; print " Making a black cup of coffee. "; print "\n ================================= \n"; return; }
#!/usr/local/bin/perl @filelist = <*>; foreach $file (sort (@filelist)) { print ("$file\n"); }
#!/usr/local/bin/perl unshift (@INC, "/u/jqpublic/perlfiles"); require ("sum.pl"); @numlist = <STDIN>; chop (@numlist); $total = &sum (@numlist); print ("The total is $total.\n");
#!/usr/local/bin/perl package pack1; $var = <STDIN>; chop ($var); package pack2; $var = <STDIN>; chop ($var); package main; $total = $pack1'var + $pack2'var; print ("The total is $total.\n");