========================================================================= = = = THERE ARE NO WAY OF ANY GUARANTIES THAT I WROTE DOWN = = THIS FILE WITHOUT ANY TYPO ERRORS IN IT, YOU MUST TEST = = YOUR CODE AT YOUR OWN UNIX/LINUX TEST MACHINE ETCETERA! = = AND OF COURSE I TOOK ALL FROM A BOOK - DUDE! I'M NOT A = = SAVANT OF ANY KIND. DUMB PC'S ARE GOOD AT/TO REMEMBER. = = HERE YOU HAVE MOST OF PERLS BEHAVIOR AND SOME EXAMPLES. = = = = INTERNET WAS MADE OFF/FOR SCIENTIST = = NOT FOR (c)'S OF ANY KIND - SO PLEASENT = = DREAMS OF PERL TO YOU FROM ME. = = = = = = SOME OF THIS FILES WAY OF DOING THE PERL = = MIGHT BE OBSOLETE - PLEASE DO A CHECK AT: = = = = HTTP://PERLDOC.PERL.ORG = = = ========================================================================= 12:50 2006-10-01 0600 mode... Is your scriptfile a true UNIX file? If not use: Linux prompt # tr -d '\r' filename.pl Or # Best way of doing it - takes all *.pl in your working directory. Linux prompt # perl -pi -e "tr /\r/ \n/;" *.pl Linux prompt # chmod a+x filname.pl or chmod -v 0700 *.pl etc... Linux prompt # chmod o-r filename.cgi etc... Linux prompt # which perl Linux prompt # perl -e "print 'Perl installed!'" Linux prompt # which perl Linux prompt # whereis perl Linux prompt # ls -l `which perl` Magical first row in your perl script! #!/usr/bin/perl -w (note: or to where you have your Perl) perl -'x' syntax: -c :: check syntax (to do before you run the script live!) -e :: used for running one program row from a command window -w :: turn on Perls error tolk (should always be set) VARIABLES $value = 999; Assign integer 999 to variable $value Examples how to se/use/print variable print($value) Returns 999 printf($value) Returns 999 SCALAR 'scalaris' = numbers or strings Examples are: 376 integer number 37.6 english decimalpoint 3.76E-10 exponent 0x07dd hex 0376 octal 2_123_456 an easy way of reading the number Note: if a number starts with a 0 zero, it interprets as an octal. 'strings' "My perl secrets first string" or 'My perl secrets first string' if use of '' string is 'fixed' it prevents substitution. 'scalaris' can be used for TRUE or FALSE FALSE <=> 0 or "" (an empty string) TRUE <=> all other values Example: $returnme = ($test >= 5); If $test >= 5 then $returnme becomes TRUE. Special characters are: \n Line feed \r Return \t Tab \" Doubble quotation character \' Single quotation character \\ Backslash printf("backslash \\"); Returns string 'backslash \' printf("value ".$value); Returns string 'value 999' printf("value $value"); Returns string 'value 999' Use of "{$i}$plusme" is ok print <Server says

Server says: $result

HTML_END ARRAY @myarray = ('ole','dole','doff'); $returnme = $myarray[1]; $returnme is now the string 'dole' Note of use of $ in $myarray[1] for collect a value from the array @myarray = ('new','value','here'); $returnme = $myarray[1]; $returnme is now the string 'value' Note, something like this is also possible in Perl: @myarray = (5,4,3); ($one, $two, @therest) = (5,4,3,@myarray); The right side is first evaluated then these values will be assigned to the left side. TABLE A table exist under same condition as an Array but the 'index' don't have to be an integer, it can be any SCALAR. Say we have: $lastname{'Urban'} = 'Nisseson'; $lastname{'Jocke'} = 'Knutson'; print ($lastname{'Jocke'}); Prints out Knutson ($table{$value}) = (2,4,6); is ok but $table{$value} is 2 Assigning TABLES Preferred way of doing it: %lastname = ( 'Urban' => 'Nisseson', 'Jocke' => 'Knuttson' ); Or this way; %lastname = ( 'Urban','Nisseson', 'Jocke','Knuttson' ); This can also be done: @lastname = %lastname; @lastname are now; ('Urban','Nisseson','Jocke','Knutson') This works: printf("@lastname"); printf("%lastname"); $telephone{'Urban','Nisseson'} = '46 000 000 00'; $telephone{'Jocke','Knutson'} = '46 000 000 01'; Special variables: use English; if use of long type $ARG $_ $OUTPUT_FIELD_SEPARATOR $OFS $, $OUTPUT_RECORD_SEPARATOR $\ = "\n"; gives automatic \n $ORS $\ $LIST_SEPARATOR $" $SUBSCRIPT_SEPARATOR $SUBSEP $; $CHILD_ERROR $? $OS_ERROR $ERRNO $! Comment: $PROCESS_ID $PID $$ May be used in secure .cgi .pl $REAL_USER_ID $UID $< May be used in secure .cgi .pl $EFFECTIVE_USER_ID $EUID $> May be used in secure .cgi .pl $REAL_GROUP_ID $GID $( May be used in secure .cgi .pl $EFFECTIVE_GROUP_ID $EGID $) May be used in secure .cgi .pl $PROGRAM_NAME $0 $PERL_VERSION $] $OSNAME $^O @ARGV %ENV i.e. $ENV{'REMOTE_HOST'} contain Remote Machine Name Some MATH: (*) has higher priority than (+) etc... Every thing that lookes like a function call interpretes as if it is! ASSOCIATE This is a right way associate: $b = $c = 1; CONTROL STRUCTURES if (expression) { # Do this 1 } elsif { # Do this 2 } elsif { # Do that 1 } do {statement}; In a do statement the value from the last statement is returned. Can be controlled by/with control structures i.e. $run_a_car = do { if ($i_am_old < 18) { return("no"); } else { return("yes"); } }; do { printf("You may drive your car") unless $i_am_old < 18; } do "test.pl" means execute all rows in Perl script test.pl Examples of EVAL block of code: eval("\"$y\""); is a variable substitution in two steps Say we have a variable $page that contains a HTML script with a $title variable in it. with a $mytext variable in it. $title = "Personal"; $mytext = "I like to have fun"; print(eval("\"$page\"")); Also this is ok: eval <<_EVAL_; print $y; _EVAL_ LOOPS while (expression) { statements } until (expression) { statements } do {statements} while (expression); for (start_expression; truth_expression; increment_expression) {statements} foreach $element (@array) { statements } foreach $element (@array) { $element = 0; # Makes all element = 0 } I.e. looping 3 times can be done with this: for (1,2,3) { print("x"); } LOOP CONTROL next; last; redo; (redo (expression) may cause infinitive loops!) foreach $i (1,2,3,4,5) { printf ($i); next if ($i <= 4); printf "*"; } Returns: 1234*5* foreach $i (1,2,3,4,5) { printf ($i); last if ($i <= 4); } Returns: 123 This block generates random numbers from 0 to 100 and if $rand is more than 33 it ends. { $rand = rand(100); redo if ($rand < 33); } OTHER CONTROL STRUCTURES die("Error etc..."); Execution stop warn("Warning etc..."); Execution continue goto marker BTW goto is not a good way of programming. $n = 0; LOOP: $n++; printf $n; goto LOOP if ($n < 10); SYSTEM CALL exec unix-command or system unix-command exec('who','-u'); (list all logged in) exec('cat myfile.txt'); (list file myfile.txt) $content = `cat $filename`; # note use of backtricks or $content = <<`LASTROW`; cat $header echo "

" cat $body echo "

" cat $fotnot LASTROW $content is now all files separatd with a line. OPERATORS IN PERL (listed in priority order) (operators in same group have the same priority) Oper. Assoc. Type. Description. {} Variable Reach a field in TABLE [] Variable Reach a field in ARRAY -------------------------------------------------------------------- ++ Math Increse -- Math Decrease -------------------------------------------------------------------- ** Right Math I.e 2^2=4 use 2**2 + Right Math + - Right Math - ! Right Logical Logical negation ~ Right Logical Bit complement -------------------------------------------------------------------- * Left Math * / Left Math / % Left Math Rest x Left String Repetition x Left Array Repetition -------------------------------------------------------------------- + Left Math + - Left Math - . Left String Concat strings -------------------------------------------------------------------- << Left Math Shift bits to left (*2) >> Left Math Shift bits to right (/2) -------------------------------------------------------------------- > Math Greater than < Math Smaller than >= Math Greater or equal to <= Math Smaller or equal to gt String String greater than lt String String smaller than ge String String greater or equal to le String String smaller or equal to ------------------------------------------------------------------- == Math Equivalent to != Math Not equivalent to <=> Math Numerical comparision eq String String equal to ne String String not equal to cmp String String comparision ------------------------------------------------------------------- & Left Logical Bitwise AND-operator ------------------------------------------------------------------- | Left Logical Bitwise OR-operator ^ Left Logical Bitwise XOR-operator ------------------------------------------------------------------- && Left Logical Logical AND-operator ------------------------------------------------------------------- || Left Logical Logical OR-operator ------------------------------------------------------------------- .. Array Numeric sequences-operator ------------------------------------------------------------------- ?: Right Logical Condition-operator ------------------------------------------------------------------- = Right Math Assign a value = Right String Assign a value = Right Array Assign a value ------------------------------------------------------------------- ' Left Array Build list => Left Array Synonym of ' ------------------------------------------------------------------- not Left Logical Logical NOT-operator low priority ------------------------------------------------------------------- and Left Logical Logical AND-operator low priority ------------------------------------------------------------------- or Left Logical Logical OR-operator low priority xor Left Logical Logical XOR-operator low priority ------------------------------------------------------------------- About strings to be told: \$abc matches $abc ab\*c matches ab*c b* matches "", b, bb, bbb... b\** matches b, b*, b**, b*** Ur(ban)* matches Ur, Urban, Urbanban Ur(ban) matches Urban Ur\(ban\) matches Ur(ban) * match 0 times more + match 1 times or more ? match 0 or 1 times {n} match exact n times {n,} match at least n times {n,m} match at lest n times and highest to m times a(bc){2,3} matches abcbc and abcbcbc Character . matches all characters except 'CrLf' To find all TAGS in an HTML-file use <.*?> [ab]* matches "", a, b, aa, ab, ba, bb, ... [a-z] matches lover case a to z ASCII characters [a-zA-Z] matches lover and HIGHER [0-9] matches 0 to 9 [0-9,]* matches strings containing numerics and comma To match SWedish characters, use [a-zåäö] or use of [a-zA-ZåäöÅÄÖ] [*+()] matches *, +, (, ) [^ ] matches matches all to next space [\^] matches ^ [^^]* matches matches all to next ^ "[^"]*" matches all citated strings <[^>]*> matches HTML markups donald|duck matches donald and duck \t matches tab \n matches new line \r matches return \056 matches octal, value of 56 \x1b matches hex, value of 1b \w matches characters that counts as a part of a word \W matches characters that \w don't match \s matches empty spaces (tab, spaces, new row, etc...) \S matches characters that \s don't match \d matches digits (0 - 9) \D matches all that is not digits To match an entirely word use \w+ \d$x\d matches the content of variable x surrounded with two digits ^ matches start of a row $ matches end of a row \b matches a wordborder \B matches all that is not a 'wordborder' \A matches start of the string \Z matches end of the string \G matches where the last match ended MATCH OPERATOR IN PERL $text =~ operator/search/replace_with/modifier; $text !~ operator/search/replace_with/modifier; Characters =~ and !~ are used to bring together a certain text to the operator. m(match) s(substitute) tr(translate) # Search for Urban in string $string $string =~ m/Urban/; # Search for words that ends with 'om' in string $string $string =~ m/om$/; # Search for dubblets $string =~ m/\b.*-[^ ]*\b/; # Search for matches where strings are parts in other strings $string =~ m/^(.*) \1/; printf "Welcome Urban Nisseson" if $name =~ /Urban/; printf "You are not welcome" if $name !~ /Urban/; MORE OPERATORS IN PERL $x =~ s/Donald/Duck/; # Duck replaces Donald $x =~ s/<.*?>//; # Erase a HTML marker $x =~ s/å/å/; # Substitute Swedish character å with å Replace date format 99-06-06 with 990606: $x =~ s/(\d\d)-(\d\d)-(\d\d)/$1$2$3/; Translate large characters to small: $x =~ tr/A-ZÅÄÖ/a-zåäö/; Count all numerics in string $x $sum = ($x =~ tr/0-9//); Count all matches of say H in string $x $sum = ($x =~ tr/H//); Last modifiers can be run with modifiers for s and m: /i (case insensitive) To see if ÅÄÖ works in your Perl-interpreter use: perl -e 'printf ("Å" =~ /å/i ? "YES\n" : "NO\n")' /g (global match) # Count all HTML markers in a HTML-file $sum++ while $htmlfile =~ /<.*?>/g; # Erase all HTML markers in a HTML-file $htmlfile =~ s/<.*?>//g; /m (multiple rows) /s (signle row) above when string contains \n /o (once) /x (extended) /e (expression) Modifiers for tr /c (complement) /d (delete) delete characters that don't match /s (squash) replace characters OTHER STRING OPERATORS Operator Correspond to Description gt > greater than ge >= greater than or equal lt < less than le <= less than or equal eq == equal ne != not equal cmp <=> compare NOTE OF THIS BEHAVIOR: THIS IS 'IMPORTANTE'! "Urban" == "Nisseson" is TRUE both have the numeric value 0 ! "Urban" eq "Nisseson" is FALSE strings are not identical 10 < 3 is TRUE 10 are numerical less than 3 10 lt 3 is FALSE 10 comes before 3 "0010" == 10 is TRUE Strings represent the same value "0010" eq 10 is FALSE Strings are not identical Set $x to 80 - characters $x = '-'; $x x = 80; New line feed in the end of $x $x .= "\n"; OTHER STRING FUNCTIONS chop $variable chomp $variable chop @array chomp $array chop deletes the CrLf of an input string. chomp deletes the CrLf only if this exist in the end of input string. chomp is the prefered function. chr expression $char = chr(65); $char is now A. ord expression $ascii = ord("A"); $ascii is now 65. crypt password, salt About argv salt: the two first characters must be from [a-zA-z0-9./] and is used to modify the crypt algoritm in 4096 different ways. index original_string, search_string [,position] Normal search rindex original_string, search_string [,position] Reverse search lc string (lower case) uc string (upper case) lcfirst string (lower case on the first character) ucfirst string (upper case on the first character) length string Returns counted characters in string pos $string Returns where the last m//g search ended in $string You may assign as in pos $string = 0; This means you search from the beginning again. print @array Prints all element in array printf format_pattern, @array sprint format_pattern, @array format_pattern: %c insert one character %s insert one string %d insert one digit/number (integer) %g %G insert one decimal number (large G means use of E as in Exponent) %f insert one decimal number as in fixpointnotation (9.000) %e %E insert one decimal number Exponent use (0.14E2) %o insert a numbers oktal value %x %X insert a numbers hex value (x/X means abcdef or ABCDEF...) %% insert character % Example of sprintf "%d-%d-%d", 2006-09-22; Should return: 2006-09-22 printf used for output to screen. reverse string Returns the string in a backwards manner To return/get a string from a string: substr string, index [,length] Erase content of variables: undef $variable undef @array undef %table STRING MATCHING MORE Hex to decimal use s/0x([0-9a-f]+)/hex($1)/eig; Simple translation use s/([$portugal]+)/$portugal_se{$1} || $1/gie; Symbolic Char Function Substitution and decoding ----------------------------------------------------------------- '' q{} Quote a string No "" qq{} Quote a string Yes `` qx{} System command Yes qw{} List of words No // m{} Search Yes s{}{} Replace Yes tr{}{} Translate No ----------------------------------------------------------------- MORE ARRAY LISTS OPERATORS (2,3)x 2 returns array of (2,3,2,3) (1..5) returns array of (1,2,3,4,5) ('A'..'Z','Å','Ä','Ö') returns array of all Swedish characters + W for (1..20) do a loop 20 times reverse (0..10) reverse loop from 10 down to 0 PS. Large loops: for ($i=1;$i<=200_000;$i++) x , y x => y Look more for comma operators. ARRAY LIST FUNCTIONS delete $arrayelement Delete the element in array each %myarray Returns the array in a listing form i.e. ($index, $value) Loop through a whole array with while use while (($index,$value) = each %myarray) { ... } while (1) { ($index,$value) = each %myarray; # ($index2,$value2) = each %myarray; } Warn do not alter the array in the while-each loop! glob string @perl_files_in_folder = glob("*.pl"); foreach $perl_file (@perl_files_in_folder) { ... } grep {sentences} array grep expression array Examples of filtering use of grep may be: @myarray = grep { $_ > 100 } @myarray; Return values over 100 !! join separator, array Function join arrange all elements in array to one signle string. keys %myarray Function keys returns a list over the index-word in the array example: foreach %key (keys %myarray) { ... } PS. More effective is to use the while-each loop, than above! map {block} array map expression, array Function map evaluate the block or expression for each element in the array. Example of use of map: @myarray = map { $_ + 100 } @myarray; Means add 10 to each element. Or more nasty; duplicate each element in array that are larger than 100: @myarray = map $_ > 100 ? ($_, $_) : $_, @myarray; or @myarray = map {if ($_ > 100) {($_, $_)} else {$_}} @myarray; As you see the $_ acts as an alias for the element in the loop. Set all elements in the array to 0 do: map {$_ = 0} (@myarray); pop array deletes the last element in array and return that value. push array, element_array Add element_array to the end of myarray reverse array It says what it does! shift array Deletes the first element in array and returns that value. sort array Returns a sorted version of the array sort {block} array @myarray = sort {$a <=> $b} @myarray; It says what it does. $rand = map {$_ => rand} @myarray; sort {$rand{$a} <=> $rand{$b}} @myarray; @myarray = sort {rand() <=> rand()} @myarray; It might work or not! splice @array, index splice @array, index, length splice @array, index, lenght, replacement Above splice can be used to get splices from array. @myarray = 1..10; splice(@myarray, 3, 4, -1, -2); Returns (3,4,5,6) and @myarray is now (0,1,2,-1,-2,7,8,9,10) split /pattern/, string split /pattern/, string, max Example of use of split: split /;/, "a;b;c;d;e;f"; Returns the array (a,b,c,d,e,f) If max (integer) are used: that means; max splitted fields the string shall be splitted into. unshift @array, element_array Add elements to the beginning of the @array and returns sum of elements in @array so: @myarray = (1,2,3,4,5); unshift @myarray, -1,-2,-3; Returns the @myarray of a value of: (-1,-2,-3,1,2,3,4,5) values %array Works as the function keys, but gives a list of values insted of a list of the index: Same as: map {$myarray{$_}} (keys %myarray); PRE-PREPARED SUB ROUTINES #!/usr/bin/perl -w sub must_do_this; # PRE-PREPARED SUBROUTINE must_do_this; sub must_do_this { printf("HELLO WORLD\n"); } exit 0; OR USE OF MORE COMPLEXITY #!/usr/bin/perl -w sub print_my_list; # PRE-PREPARED SUBROUTINE print_my_list 5,4,3,2,1; print_my_list 6,7,8,9,10; sub print_my_list { $listoutput = join ", ", @_; printf "($listoutput)\n"; } IF USE OF & FOR A FUNCTION CALL ARGUMENTS MUST BE INCLUDED IN PARENTESES EVEN IF PRE-PREPARED FUNCTION, AND THE OLD METHOD OF @_ ARE USED. ------------------------------------------------------------------------- IN PERL; VARIABLES ARE ALL GLOBALS IF NOT DECLARED OTHERWISE! ------------------------------------------------------------------------- TO BE MORE SPECIFIC strict IN PROGRAMMING USE: use strict; Differences between local and my in Perl. Example look at this: #!/usr/bin/perl -w sub sub1a; sub sub1b; sub sub2; printf sub1a; printf sub1b; sub sub1a { local($a) = 1; sub2; $a; } sub sub1b { my($a) = 1; sub2; $a; } sub sub2 { $a = 2; } The differences between local and my are also that my only can work in the block it's been declared in and are used in. FUNCTIONS AS AN ARGUMENT CAN BE DONE sort subroutine array; I.e: sub numeric_ascending {$a <=> $b} @myarray = sort numeric_ascending @myarray; ========================================================================= FILE STREAM MANAGEMENT IN PERL. ========================================================================= -character filename -character filehandle Means a HANDLE to the file_name in mention This table are a summarize of UNIX characteristics of a file: -r Gives our effective user-ID the rights to read from the file -w Gives our effective user-ID the rights to write to the file -x Gives our effective user-ID the rights to run the file as a program -o Is our effective user-ID the owner of the file -R Gives our effective user-ID the rights to read the file -W Gives our effective user-ID the rights to write to the file -X Gives our effective user-ID the rights to run the file as a program -O Is our effective user-ID the owner of the file -e Exist the file? -z Is the file of size 0? -s What size have the file? -f Is the file an ordinary file? -d Is the file a map/catalog/directory? 11:17 2006-09-30 -l Is the file a symbolic link? -p Is the file a name given pipe? -S Is the file a socket? -b Is the file a specific block file? -c Is the file a specific character file? -t Is there a terminal joined to the file? -u Is the set UID bit set for the file? -g Is the set GID bit set for the file? -k Is the sticky bit set for the file? -T Is the file a TEXT-file? -B Is the file BINARY? -M When was it last modified? -A When was it last used? -C When was the file I-NOD altered? EXAMPLES OF FILE HANDLE open FILEHANDLE, path Open a file for reading: (Think like this; from right to left) open FILE, "<$filename"; open FILE, "$filename"; Open file for print to, content WILL be erased! open FILE, ">$filename"; Open file for both reading and printing, content NOT erased! open FILE, "+<$filename"; Open file for both reading and printing, content WILL be erased! open FILE, "+>$filename"; Open file for append to. open FILE, ">>$filename"; Each UNIX program has its three special file_handles they are STDIN (standard input) STDOUT (standard output) STDERR (standard error) System command sort may be used for sorting rows. open SORTME, "|sort"; or PIPE to a another file, as in: open SORTME, "|sort > sorted_file"; This tells the system to send STDOUT from the program to sort to the file sorted_file. open MYLISTOFFILES, "ls -l|"; may be done Almoust the same as: $mylistoffiles = `ls -l`; open returns TRUE if the opening of the file succeeded, otherwise FALSE Don't forget to close the file_handle with: close FILEHANDLE; ------------------------------------------------------------------------- binmode FILEHANDLE Tells us to read and write to the file in the binary mode, say on files as GIF, JPEG, ZIP ... ------------------------------------------------------------------------- THE OPERATOR <> - operator are used to READ info from the STREAM or the FILE; ROW by ROW; and under these conditions the operator RETURN TRUE all the way and RETURNS the value FALSE when it REACH EOF (or end of stream). Note: Soetimes these conditions may alter - so be careful! $INPUT_LINE_NUMBER ($NR, $.) Is a special variable containing the last read row number from the <>-operation Say we have a TXT-file named myfile.txt and it contains normal characters and sometimes numbers 13, 2, 7 etc... We can do: #!/usr/bin/perl -w $sum = 0; open TEST, ") { if ($row =~ /([0-9]+) / /) { # Mabye wrong here. $sum += $1; } } close TEST; printf "The sum are $sum.\n"; exit 0; read file_handle, $variable, length read file_handle, $variable, lenght, offset Sometimes the <> - operator does not return FALSE then we have to examine the value of the variable $ENV{'CONTENT_LENGTH'}. It sets how many characters to be read in. read can be used to read in a from the beginning set value of characters. If use of offset the filepointer sets to start there and reads from this point to the end of the stream. seek file_handle, sum_bytes, from_where Example of usage of seek: from_where can be 0,1 or 2 ($start,$present,$end) = (0,1,2); seek FILE, 0, $start; tell file_handle Returns filepointer position from the beginning truncate file_handle, length truncate filename, length Totally erase some parts of the file_handle or of the file. DIALOG WITH USER AND STREAMS / FILES Use the for read in what the user input and chop or chomp the last CrLf from user input. printf("Hello.\n\n"); { printf("Enter something, please... "); $input = ; chop($input); } printf("You entered: $input Thank you!\n"); ------------------------------------------------------------------------- ALTERING IN FILES / STREAMS ------------------------------------------------------------------------- open (FILE, "<$ARGV[0]") or die("Error opening file: $!); @file = ; close FILE; open (FILE, ">$ARGV[0]") or die("Error opening file: $!); foreach $row (@file) { print FILE "\t$row"; # Adds a tab before each row i file. } close FILE; PIPES # Read in the arguments ($map, $expression) = @ARGV; # Open a pipe to ls -R open(LS, "ls -R $map |") or die("Error: $!"); # Read in all rows and print them out if a match exist while ($file = ) { print $file if $file =~ /$expression/; } close LS; Above list all files in the working diectory and under it and then prints all out if the match exist. ------------------------------------------------------------------------- CATALOGS MAPS DIRECTORYS ------------------------------------------------------------------------- $sum = 0; # Get, in order, the arguments ... while ($file = pop @ARGV) { if (-d $file) { # If it's a directory opendir DIRECTORY, $file or die("Cannot open $file: $!\n"); # Read all files @directoryarray = readdir DIRECTORY; closedir DIRECTORY; # Sort away filename as . and .., else <-> bad happens! @directoryarray = grep ($_ !~ /^\.\.?$/ @directoryarray); 10:40 2006-09-30 # Construct a complete path to the file. @directoryarray = map "$file/$_", @directoryarray; # Append the array to the ARGV-array push @ARGV, @directoryarray; } elseif (-f $file) { # It's an ordinary file $sum += -s $file; } } printf("Total bytes of files are: $sum .\n"); BUFFERING IN PERL Example of a true buffering with a sleep() function: perl -e '$|=1; printf "Now\n"; sleep(5); printf "5 sec later\n";' Normaly $| affects only output to/via STDOUT, we have to use: select file_handle; Example of select FILEHANDLE select FILEHANDLE; print "Have a nice day\n"; # This prints to the file with FILEHANDLE as its file_handle. The file that are chosen, with the select-function will be affected of what you set the variable $| to! SIMULTANEOUS AND STREAM / FILE To lock a file/stream use of: flock file_handle, lock_type lock_type can be integers 1 - 15 Defined lock_type $LOCK_SH = 1; Split lock $LOCK_EX = 2; Exclusive lock $LOCK_NB = 4; Do not block $LOCK_UN = 8; Release block A working way of going around lock problem use: open LOCK, (-e "lock" ? "<" : ">")."lock"; flock LOCK, $LOCK_EX; ... # do open FILE etc... ... # do close FILE etc.. ... # as much as we will ... close LOCK; OTHER FUNCTIONS IN PERL rand [max] $mydimeturn = int(rand 6)+1; If max excludes rand between 0 - 1 srand [expression] Use srand; first in your script to do a more rand randomized operation. time Returns sum of seconds from 1970-01-01 localtime localtime mytime Returns an array of (second, minute, hour, day in month, month number, year, weekday, day on/in year, timezone). # examples of Swedish date formats etc... @weekdays = ("mån","tis","ons","tor","fre","lör","sön"); @months = ("januari","februari","mars","april","maj","juni", "juli","augusti","september","oktober","november","december"); @time = localtime; $time[5] += 1900; # Add 1900 or add 2000 printf "$time[2].$time[1], $weekdays[$time[6]]". "dagen den $time[3]:e $months[$time[4]] ". "$time[5]\n"; gmtime [mytime] Returns Greenwich Mean Time instead of local time. timelocal sec, min, hour, date, month, year Returns corresponding time-value! Note: timelocal is/may not be in the standard library for Perl, use this: sub timelocal; require "timelocal.pl"; At the top of your Perl script/program. sleep(mytime); The program sleeps in mytime seconds. ------------------------------------------------------------------------- EXAMPLE OF A WORDLIST ARRANGEMENT ------------------------------------------------------------------------- #!/usr/bin/perl -w open(WORDLIST,") { chop($word); $wordlist{$word} = 1; } close(WORDLIST); while ($file = shift @ARGV) { # Takes argument: the wordlist file ! open(FILE, "<$file") or die ("Cant open: $!"); while ($row = ) { while ($row =~ /([a-zA-ZÅÄÖåäö]+)/g) { print "$file: row $.: $1\n" unless $wordlist{lc($1)}; } } close(FILE); } ------------------------------------------------------------------------- EXAMPLES OF FORMAT PATTERNS format NAME = format_rows . format MYFORMAT = ------------------------------------- Name: @<<<<<<<<<< | ^|||||||||| $name, $others Address: @<<<<<<<<<< | ^|||||||||| $address, $others ------------------------------------- . This post may be written out with: write MYFORMAT; TYPEGLOBALSS *name means all: $name @name %name *a = *b; SEND THE TYPEGLOBE TO THE FUNCTION EXAMPLE: sub test; $a = "hello"; @a = (1,2,3,4,5); %a = ("Carl" => "Nilsson", "Stina" => "Svensson"); test *STDOUT, *a; sub test { local (*OUTPUTFILE, *x) = @_; print OUTPUTFILE "Variable: $x\n"; $, = " "; print OUTPUTFILE "Array: (",@x,")\n"; print OUTPUTFILE "List: Carl = $x{'Carl'}, ". "Stina = $x{'Stina'}\n"; } TYPEGLOBS may be saved in regular SCALARS to be used later. Above may have ben written as $ouputfile = *OUTPUTFILE; $variables = *a; test $outputfile, $variables; FUNCTIONS AS ARGUMENTS IN PERL sub repeat; sub hello; repeat 10, *hello; sub repeat { local ($n, *myfunction) = @_; sub myfunction; for (1..$n) { myfunction } } sub hello { print "Hello\n"; } REFERENCES IN PERL \$r; # Referense to a scalar variable \@r; # Referense to an array \%r; # Referense to a table Say $r = "Hello"; $r_ref = \$r; Makes a referense to $r Objects inside {}, say: $x = 10; print "$x + 5 = ${\($x + 5)}\n"; $r_ref->[3]; $r_ref->{"e"}; Symbolic references $hello = "HELLO\n"; $x = "hello"; $$x; # We got the variable $hello IF USE OF use strict; THE ABOVE IS NOT APPLICABLE MODULES AND PACKETS IN PERL do "filename"; Do all rows in file filename. require "filename"; The same princip as the do + better error tolk require also returns TRUE if code in it execute well! A good practise is to end require FILES with 1; at the end to enshure it returns TRUE. Use of your own lib do: use lib '/your_path/your_directory/'; use modul list Interpretes by Perl as BEGIN {require modul; import modul list;} To create a package do: package package_name; To get the variable say $x in packet WHAT, do $WHAT::x The function import in Perl are used for import names from a packet to the main program: import packet_name list; Import all the names in packet do: import packet_name; Example: import WHAT '$x'; $x = "nada"; Set $WHAT::x to 'nada' TO FIND ALL MODULES IN SYSTEM do: Linux prompt # find `perl -e 'print "@INC"'` -name '*.pm' -print ======================================================================== OBJECT ORIENTED PROGRAMMING IN PERL (Long time no see of C++ OOP ;-) ) ======================================================================== package classname; bless reference, classname; ------------------------------------------------------------------------ #!/usr/bin/perl -w # Define a packagename: package CAR_MODEL; # This is the object and its code: sub new { $new_car = {"Model" => "Ford", "Weight" => "1100 kg"}; bless $new_car, $_[0]; return $new_car; } # This is a method related to the above object: sub set_model { ($car, $new_model) = @_; $car->{"Model"} = $new_model; } # Make a new say 'orig' object: $orig=CAR_MODEL->new; # Note: CAR_MODEL->new(); works as well. # But then and if some variables are in the (..) # these will be used for produce the object. # Test if the object returns what you put in to it: printf($orig->{"Model"}."\n"); # Make a new object: $car=CAR_MODEL->new; # Use of implemented method sub set_model: $car->set_model("Nissan"); # And how to test that the above two rows actually works + the class # + the sub set_model also works, do: printf($car->{"Model"}."\n"); printf($car->{"Weight"}."\n"); exit; ------------------------------------------------------------------------ TO BIND/TIE TO A PACKET INSTALLED IN/ON YOUR UNIX MACHINE WITH PERL tie variable, package, list; Untie a packet use: untie variable; SCALARS TIESCALAR package_name, list TIESCALAR returns an object (that have ben bless'ed) of the same type as the package. FETCH object Returns the value user shall see at reading. STORE object, value Used for setting the new scalar value on object and it should return this value. DESTROY object It says what it does. May be used in sertain code. Binded/Tied LIST TIEARRAY class_name, list Acts as TIESCALAR FETCH object, index Fetch the object stored under/in the assigned index-value. STORE object, index, value Store a value under assigned index. Acts as in general as STORE for scalars. DESTROY object Destroy the object (for scalars too) TABLES TIEHASH class_name, list Acts as TIESCALAR and TIEARRAY FETCH object, index_word Returns the post for assigned given index word. Acts as previous FETCH. STORE object, index_word, value Stores a value under assigend index word Sames as previous STORE. DELETE object, index_word Is called when user deletes a post. CLEAR object Say %table = (); then this function is called. EXISTS object, index_word Returns TRUE if the index_word exists in the table, if not FALSE FIRSTKEY object Called when looping through posts in a database, i.e. using the each-function. NEXTKEY object, last_index_word If the last index word is the last in the database NEXTKEY should return undef to signal the end of the loop. DESTROY object Same as before. ------------------------------------------------------------------------- Example of BIND/TIE CLOCK ------------------------------------------------------------------------- #!/usr/bin/perl -w package myCLOCK; # 1; # Return 1 to indicate successful loading of package. # Use when your .PL file is in the @INC path sub TIESCALAR { bless {'start' => time }, $_[0]; } sub FETCH { time - $_[0]->{'start'}; } sub STORE { $_[0]->{'start'} = time - $_[1]; } # use myCLOCK; # You don't have to 'use myCLOCK;' it's declared # in this code. If you use this row your .PL file must # be in your/the @INC path !!! # No buffering $|=1; $latest_written = -1; # Tie/Bind to the myCLOCK tie $clock, myCLOCK; # Loop for say 10 seconds: while ($clock < 10) { if ($clock != $latest_written) { printf("$clock \n"); $latest_written++; } } ------------------------------------------------------------------------- WEBB PROGRAMMING IN PERL :: FOR A COMPLETE REFERENCE OF HTTP SEE THE RFC 2068 or perhaps newer at a searach engine ... ------------------------------------------------------------------------- Redirect user, do: print("Location: somepage.html\n\n"); OR print("Content-Type: text/html\n\n"); open(PAGE, ") { print($row); } close(PAGE); OR use | pipe to fix it open(PAGE, "somepage.cgi|"); print $row while $row = ; close(PAGE); ------------------------------------------------------------------------- HTML syntax myperlcode $row =~ s//eval $1/ge; while ($row =~ //) { if ($row =~ s/^(.+?)//) {print $1;} while ($row =~ // && $row !~ /<\/PERL>/) {$row .= ;} $row =~ s/(.*?)<\/PERL>//s; eval $1; } print($row); ========================================================================= PERL PARSER PARSER EXAMPLE. PLEASE NOTE THE SECURITY WARNING! ========================================================================= #!/usr/bin/perl -w print("Content-Type: text/html\nPragma: no-cache\n\n"); open(THEPAGE, ") { $row =~ s//eval $1/ge; while ($row =~ //) { if ($row =~ s/^(.+?)//) { print $1; } while ($row =~ // && $row =~ /<\/PERL>/) { $row .= ; } $row =~ s/(.*?<\/PERL>//s; eval $1; } $row =~ s/eval $1/ge; print $row; } close THEPAGE; ------------------------------------------------------------------------- !!! NOTE; ABOVE NOT TO BE USED FOR UNTRUSTED PERSONS ON YOUR SERVER !!! !!! IT CAN DO SECURITY MESS OR HARM IT. !!! ------------------------------------------------------------------------- HTML - CODING - EXAMPLE #!/usr/bin/perl -w $html_coded = "[åäöÅÄÖè]"; $html_coding = ( 'å' => 'å', 'ä' => 'ä', 'ö' => 'ö', 'Å' => 'Å', 'Ä' => 'Ä', 'Ö' => 'Ö', 'è' => 'é' ); while (<>) { s/($html_coded/$html_coding{$1}/g; print; } exit 0; ------------------------------------------------------------------------- 'COMMA' SEPARATED (DATABASES) TABLES ------------------------------------------------------------------------- Use a while loop throug the file $separator = ','; while ($row = ) { chop($row); $row =~ s/$separator/<\/td> /g; print " $row \n"; } OR: ($field1, $field2, $field3) = split("$separator", $row); print <<_TABLEPOST_; $field1 $field2 $field3 _TABLEPOST_ ========================================================================= WEB CAMERA EXAMPLE snapshoots ========================================================================= #!/usr/bin/perl -w # give the picture file a proper name $picturefile = time.".gif"; # remove the old picture files in folder `rm *.gif`; # capture a picture from your web cam `vidtomem -z 1/2 2>/dev/null`; # convert it to a GIF picture `togif out-00000.rgb $picturefile`; # erase/unlink the captured picture unlink 'out-00000.rgb'; print <<_END_; Content-Type: text/html Whats on my webcam now?

Whats on my webcam now?

_END_ PS. Use crontab in your unix-machine to update the picture more often. ------------------------------------------------------------------------- TEST YOUR table ENV - VARIABLES #!/usr/bin/perl -w print("Content-Type: text/plain\nPragma: no-cache\n\n"); while (($variable, $value) = each %ENV) { print("$variable = $value"); } ========================================================================= HOW TO ENTERPRETE A FORM ========================================================================= GET or POST method: $buffer = $ENV{'QUERY_STRING'} if $ENV{'REQUEST_METHOD'} eq 'GET'; read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}) if $ENV{'REQUEST_METHOD'} eq 'POST'; $buffer =~ tr/+/ /; # Means translate + to # Next step is to split the string into its different name/value etc... @pair = split /[&=]/, $buffer; foreach $pair (@pair) { $pair =~ s/%([0-9A-F]{2})/chr(hex($1))/egi; } PREARE FOR A TABLE for ($i=0;$i<$#pair;$i+=2) { if ($form{$pair[$i]}) { $form{$pair[$i]} .= "\n".$pair[$i+1]; } else { $form{$pair[$i]} = $pair[$i+1]; } } AND ALL TOGETHER NOW in an interprete_form: sub interprete_form { my ($buffer, @pair, $i); $buffer = ""; $buffer = $ENV{'QUERY_STRING'} if $ENV{'REQUEST_METHOD'} eq 'GET'; read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}) if $ENV{'REQUEST_METHOD'} eq 'POST'; $buffer =~ tr/+/ /; @pair = split /[&=]/, $buffer; foreach $pair (@pair) { $pair =~ s/%([0-9A-F]{2})/chr(hex($1))/egi; } for ($i=0;$i<$#pair;$i+=2) { if ($form{$pair[$i]}) { $form{$pair[$i]} .= "\n".$pair[$i+1]; } else { $form{$pair[$i]} = $pair[$i+1]; } } } OR: sub interprete_form { my ($buffer, $name, $value, @pair); if ($ENV{'REQUEST_METHOD'} eq 'GET') { $buffer = $ENV{'QUERY_STRING'}; } elsif ($ENV{'REQUEST_METHOD'} eq 'POST') { $buffer = ""; read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); } else { die("Content-Type: text/plain\n\n REQUEST_METHOD must be ". "GET or POST"); } # change + to space $buffer =~ tr/+/ /; # split name/value in pair @pair = split(/&/, $buffer); # loop through all pairs foreach $par (@pairs) { ($name, $value) = split(/=/,$par); # interprete some characters (special) $name =~ s/%([A-F0-9]{2})/chr(hex($1))/egi; $value =~ s/%([A-F0-9]{2})/chr(hex($1))/egi; # if it exists append with linefeed if ($form{$name}) { $form{$name} .= "\n$value"; } else { $form{$name} = $value; } } } SOME NOTES ON/FOR THE