======================ArrayTemplates============================================ print "started
\n";
($x,
$y, $z) =
(1, 2, "hello", 4);
# assigns
$x=1, $y=2, $z="hello", 4 is discarded print
"$x, $y, $z
\n";
# 1, 2,
hello
@pets
=
qw(Cat
Dog);
# assigns an Array print
"@
pets\n";
# Cat Dog @array
= (1, 2, "hello", "there");
# assigns an Array print
"@array
\n";
# 1
2 hello there $len
=
@array;
# $len is
now
4 print
"array_Length= $len
\n";
#
array_Length=
4
$len
=
scalar(@array);
# $len is
now
4 print
"array_Length= $len
\n";
#
array_Length=
4
$lastindex = $#array;
#
$lastindex
=
3 print
"lastindex = $lastindex \n";
# lastindex
=
3
$array[5]
= "the
end";
#
grow array
6 print
"@array
\n";
# 1 2 hello
there the end
$len
=
@array;
#
$len is
now
6 print
"array_Length= $len
\n";
#
array_Length=
6
$str2print
= join(":", ("a", "b", "c"))
;
print
"$str2print
\n";
# a:b:c
$lenn
=
length($str2print);
print
"$lenn
\n";
#5
@A1
=
split(/:/,'a:b:c'); print
"@A1
\n";
# a b c @numbers
= (1..10);
# assigns
an Array print
"@numbers
\n";
# 1 2 3 4 5 6 7 8
9 10 @numbers_e
= (1..10)[1,3,5,7,9];
# only
works with this name @numbers_o
= (1..10)[0,2,4,6,8,10];
# Copy
without elements in [] @numbers_oo
= @numbers[0,2,4,6,8,10]; print
"@numbers_e\n";
# 2 4
6 8 10 print
"@numbers_o\n";
# 1 3 5 7
9 print
"@numbers_oo\n";
# 1 3 5 7 9
$numbers[0]++
;
#
Increment an element print
"@numbers
\n";
# 2 2 3 4 5 6 7 8 9 10 @letters
= ("c", "l", "q", "t");
# assigns an Array print
"@letters\n";
# c l q t @letters
= (@letters,"z")
;
#
append an array print
"@letters\n";
# c l q t z push(
@letters,"z");
print
"@letters\n";
# c l q t z
?bug? push(
@letters,"w");
print
"@letters\n";
# c l q t z w
$last
=
@letters[-1]; print
"last element =
$last\n";
# last element =
w
$lastelem =
pop(@letters);
print
"$lastelem & @letters\n";
# w & c l q t z unshift(
@letters,"a"); print
"@letters\n";
# a c l q t z ($first)
= @letters; print
"first element = $first\n";
# first
element = a
$firstelem = shift(@letters);
print
"$firstelem &
@letters\n";
# a & c l q t z
@animals
=
("zebra","dog","lion","dolphin");
@ordered
= sort(
@animals ); print
">>>@ordered
<<<\n";
# >>>dog dolphin
lion zebra <<<
@rordered = reverse(
@animals ); print
">>>@rordered
<<<\n";
# >>>dolphin lion dog
zebra <<< ($anim1)
=
@animals
;
# first element print
"$anim1\n";
# zebra @ordered
=
( )
;
# clear array print
">>>@ordered
<<<\n";
# >>> <<< print
"finished \n";
======================StringTemplates============================================ substr(
"Once upon
a time", 3, 4);
# returns "e up" substr(
"Once upon a
time", 7);
# returns "on a time" substr(
"Once upon a
time", -6, 5);
# returns "a tim" print
"started
\n";
$str2print = substr("Once upon
a time", 3, 4);
# e up
$str2print2 = substr("Once
upon a
time", 7);
# on a time
$str1
=
"Once upon a time";
$str2print = uc($str1);
# ONCE UPON A TIME
$str2print
= lc($str1);
# once upon a time
$str2print = ucfirst($str1);
# Once
upon a time
$str2print
= lcfirst($str1);
# once
upon a time
$mystring =
"Hello, PERL!";
# Hello, PERL! substr(
$mystring, 7, 11) =
"World";
# Hello, World printchr(65),"\n";
# A printord('A'),"\n";
# 65 printhex('0D'),"\n";
# 13
$Dec2Hex
= sprintf("%x",13); print
"$Dec2Hex
\n";
# d
$str2print
= join(":", ("a", "b", "c"))
;
print
"$str2print
\n";
# a:b:c
@A1
=
split(/:/,'a:b:c'); print
"@A1
\n";
# a b
c
@B1
=
(a..z);
$str2print = join("",@B1)
;
# abcdefghijklmnopqrstuvwxyz
$str2print
=~ tr/a-m/A-M/;
# ABCDEFGHIJKLMnopqrstuvwxyz
$str2print
=~ tr/D-Z/d-z/;
# AB defghijklmnopqrstuvwxyz
$str2print =
$str2print .
"0123456789";
# ABCdefghijklmnopqrstuvwxy 0123456789
$str2print
=
$str2print ."A"x3;
# ABCdefghijklmnopqrstuvwxyz0123456789AAA
$str2print .=
"B";
# ABCdefghijklmnopqrstuvwxyz0123456789AAAB
$result
=
rindex('perlmeme.org','m');
# 6
$result =
rindex('perlmeme.org','L');
# -1
$result
=
index('perlmem.org','mem');
#
4
$offset
=
2;
$result =
rindex('perlmeme.org','e',$offset);
# 1 print
"finished \n"; print hex
'0xAf';
# 175 print
"\n"; print hex
'aF';
# 175 print
"\n";
$order_total_amt = 10.3;
$order_total= sprintf("%-20s %5.2f",
"Your total is:",$order_total_amt); print
"$order_total
\n";
# Your total is:
10.30
$order_total= sprintf("%-30s %5.2e",
"Your total is:",$order_total_amt); print
"$order_total
\n";
# Your total
is:
1.03e+01
$order_total= sprintf("%-1s %5.2g",
"Your total is:",$order_total_amt); print
"$order_total
\n";
# Your total is: 10
$order_total= sprintf("%+20s %5.4d",
"Your total is:",$order_total_amt); print
"$order_total
\n";
# Your total is: 0010
$order_total= sprintf("%-19s %-19s %-19s",
"Your total is:",$order_total_amt,"XXX"); print
"$order_total
\n";
# Your total is:
10.3
XXX
#
cd
/Users/donsauer/Documents/KEY/IDEA2IC/PlayWithPerl
#
perl
StringTemplates.pl rindex(
STR,SUBSTR,POSITION) - returns last occurrence of SUBSTR in
STR
index(
STR,SUBSTR,POSITION) returns e first occurrence else -1 is
returned.
======================JOIN_SPLIT============================== print
"enter var:
";
# enter var: now chop(
$var = <STDIN>);
# <filehand> = read one
line filehand print
"enter var2:
";
# enter var2: two $last=chop(
$var2 = <STDIN>);
# $var2 can be text or number print
"var is $var, var2 is $var2
\n";
# var is now, var2 is two $lv
=
length($var);
# print
"var length is $lv, last is
<cr>$last
\n"; # var length is 3, last is
<cr> $both
=
join('&',$var,$var );
# joined by '/, print
"joined by & is $both
\n";
# joined by & is now&two ($real1,$real2) = split(/&/,$both);
# print
"split by & is$real1
\n";
# split by & is now print
"split by & is $real2
\n";
# split by & is two
======================MATH===========================================
$a
= 9 ** 10;
# Nine to the power of
10 $a =
5
%
2;
# Remainder of 5 divided by 2 ++$a;
#
Increment $a and then return it $a++;
#
Return $a and then
increment it --$a;
#
Decrement $a and then
return it $a--;
# Return $a and then decrement it $a
=
$b .
$c;
# Concatenate $b and $c $a
=
$b x $c;
# $b
repeated $c
times $a =
$b;
#
Assign
$b to $a $a +=
$b;
# Add $b to $a $a -=
$b; #
Subtract $b from $a $a .=
$b; #
Append $b onto $a ==
equality
!= inequality
< less than
> greater than
<= less than or equal
>= greater than or equal eqequality
String comparison ne
inequality
String comparison lt
less than
String comparison gt
greater than
String comparison le
less than or equal
String comparison ge
greater than or equal
String comparison &&and Boolean
logic ||or !not
atan2(EXPR) arctangent of X/Y in the range pi to -
pi
cos(EXPR) cosine
hex(EXPR) decimal value of
EXPR interpreted as hex string int(EXPR)
the integer portion of EXPR
length(EXPR) length in characters of the value of
EXPR
log(EXPR) logarithm of EXPR
oct(EXPR) the decimal value of EXPR
interpreted as an octal string
ord(EXPR) numeric ASCII value of the first
character of EXPR sin(EXPR)
returns the sine of EXPR."
sqrt(EXPR) square root of expression
======================PADDING============================ print
"Now ", time(),
" seconds since 1970.\n"; # The time is now
1191812029 seconds since
1970.
$text
=
"Left pad a string"; $pad_len
= 30;
$padded =
sprintf("%${pad_len}s \n", $text); print
$padded
;
#
Left pad a string
$num = 33;
$padded =
sprintf("%0${pad_len}d",
$num); print
$padded
,"\n";
# 000000000000000000000000000033
$text
=
"Right pad a string";
$padded = sprintf("%-${pad_len}s",
$text); print
$padded
,"####\n";
# Right pad a
string
#### $text
=
"Right pack and tunct to 30 a string";
$padded = pack("A$pad_len",$text); print
$padded
,"####\n";
# Right pack and tunct to 30 a s####
$text
=
"Right pad a string";
$pad_char = "#";
$padded = $pad_char x ($pad_len - length(
$text ) ). $text ;
$text
=
"Right pad a string2"; print
$padded
,"\n";
# ############Right
pad a string
$pad_len
= 30;
$pad_char =
"@"; substr(
$text,0,0) =
$pad_lenx($pad_len -length($text)
);
$text .= $pad_char x ($pad_len - length(
$text ) ); print
$text
,"#\n";
# @@@@@@@@@@@@Right
pad a string#
$line =
"MakeUpperCase";
$line = uc($line); print
$line
,"\n";
# MAKEUPPERCASE
$line
=
"make first letter UpperCase";
$line =~
s/(\w+)/\u\L$1/g; print
$line
,"\n";
# Make First Letter Uppercase
$string
=
" Strip Leading edges";
$string =~
s/^\s+//;
$string =~
s/\s+$//; print
$string
,"\n";
# Strip Leading edges
======================File_Read_Write=========================
$line =
<STDIN>;
## read one line from the STDIN file handle chomp(
$line);
## remove the trailing "\n" if present
$line2 =
<FILE2>;
## read one line from the FILE2 file handle
while
($line =
<STDIN>)
## read every line of a file
{ ##
do something with $line
} open(
F1,
"filename");
## open "filename" for reading as file handle F1 open(
F2,
">filename");
## open "filename" for writing as file handle F2 open(
F3, ">>appendtome")
## open
"appendtome" for appending
close(
F1);
## close a file handle open(
F4, "ls -l
|");
## open a pipe to read from an ls process open(
F5, "| mail $addr"); ## open a pipe
to
write to a mail process open(
FILE, $fname)|| die "ouch\n"; @a =
<FILE>;
## read the whole file in as an array of lines
======================DataTypes================================
%m.nx
m and n are optional sizes whose interpretation depends on the type of
field, and x is one of:
c
Character
ld
Long decimal number
u
Unsigned decimal number
lu
Long unsigned decimal
number
lx
Long hexadecimal number
o
Octal number
lo
Long octal number ======================MATCH_REPLACE================================= $dataVariable=~/template/ ; $dataVariable
represents piece of data are matching against; =~
true if str matches pat
!~
true if str not matches /
are used to enclose the
regular expression syntax. $dataVariable=~/.+\@.+/ ; .+
means "any character one or more times". \@
@ symbol needs to be escaped with a backslash (\) to
ensure does not
misinterpret
to match a slash you would have to use \/ $dataVariable=~/^\w+\@\w+(\.org|\.net)$/i ; ^
represents start of data {an anchor symbol}
because
it matches a boundary $
anchor symbol represents end of the data. \w
symbol includes all characters from a-z and
AZ and
0-9 i
ignore case match case-insensitively. x
ignore whitespace
if
($dataVariable=~/^\w+\@\w+(\.org|\.net)$/i ){ ...statements if
true... }
($string=~ /pattern/) ##
true if the pattern is found somewhere in the string
("binky"
=~ /ink/) ==> TRUE
("binky" =~ /onk/) ==> FALSE
next ifm/^\s*$/;
# will
skip blank lines. $pet=~ s/\bcat\b/feline/ig
;//search-end-replace any "cat" with
"feline". s/
performing a substitution \b
surround "cat"obliging
Perl to find a space or other symbol around it g
Without the g modifier, substitution would only replace first
occurrence of "cat" $search =~ s/[^\w|]/,/g
; //"black cat,dog*mouse/frog" => "black
cat,dog,mouse,frog" ^\w not
containing a word class character or a space [^\w|]square
brackets) tells Perl toexclude AZ, AZ, 0-9
characters
listed inside class. $userinput=~
s/\n//g ;
# replaces newline
(\n) with null; $string=~
s/<([^>]|\n)*>//g ;
# Strip HTML tags
from a string $string=~ s/^\s+//
;
#Strip leading spaces from
a string $string=~ s/\s*$//
;
#will
trim trailing spaces $string=~ s/(\w)/$1:/g
;
# "ab" -> "a:b:"
$`
add before match $'
add after match $&
matched [^pat]
chars not in pattern
.
Match any character [abc] Match a or b or c \w Match "word" character
(alphanumeric plus "_") [a-z] Match any char from a thru z \W Match non-word
character \s Match whitespace
character \SMatch non-whitespace
character \dMatch digit character \D Match non-digit
character
\t Match tab \nMatch newline \rMatch return
\f Match
formfeed
\a Match alarm (bell,
beep, etc)
\e Match escape
\021 Match octal char
( in this case 21 octal)
\xf0 Match hex
char ( in this case f0 hexidecimal)
* Match 0 or
more times
+ Match 1 or
more times
? Match 1 or
0 times
{n} Match
exactly n times
{n,} Match at
least n times
{n,m} Match at least n
but not more than m times
? match 0 or
1 occurrences of the pattern to
its left
* match
0 or more occurrences of
the pattern to its left
+ match 1 or more occurrences of the pattern
to its left
| match-- (vertical bar) logical or --
matches the pattern either on its left or right
( ) match parenthesis -- group sequences of patterns
^ matches the start
of the string
$ matches the end
of the string
abc matches a or b or c
a-z matches any char from a thru z
^pat matches chars not in pattern
c*
matches zero or more c's
c*? matches lazy * (as few as possible)
c+
matches one or more c's
c+? matches lazy +
c? matches zero or one c
c?? matches lazy ?
c{3,7}matches between 3 and 7 c's
c{3,} matches 3 or more c's
c{3} matches exactly 3 c's
c{3,7}?lazy
======================Stripping_Spaces=================================
#!/usr/bin/perl
sub
trim($); # Declare the
subroutines sub
ltrim($);
sub
rtrim($);
my $string =
" \t Hello world! "; # Create a test string
print
trim($string)."\n"; #
Here is how to output the trimmed text "Hello world!" print
ltrim($string)."\n";
print
rtrim($string)."\n";
sub
trim($) # Perl trim
function to remove whitespace from the start and end of the string { my $string =
shift;
$string =~ s/^\s+//;
$string =~ s/\s+$//;
return $string;
}
sub
ltrim($) # Left trim
function to remove leading whitespace { my $string =
shift;
$string =~ s/^\s+//;
return
$string;
}
sub
rtrim($) # Right trim
function to remove trailing whitespace { my $string =
shift;
$string =~ s/\s+$//;
return
$string;
}
This should work, if not replace \s with [ \t\n] and try again
s/\s*$//
======================Special Chars=================================== 'text'
literal text except \' and \\ "text"
special chars executed q/text/
use / for ' qq/text/
use / for " \n
newline \r
return \t
tab \f
formfeed \007
octal \xff
hex \cC
control C \"
" \\
\ \l
lowercase next \u
uppercase next \L
lowercase all \U
uppercase all \E
end all
======================Dictionary===================================
$dict{"bart"} = "I didn't do
it";
## %dict contains key/value pairs (("bart" => "I didn't
do it"),
$dict{"homer"} = "D'Oh";
$dict{"lisa"} =
"";
## %dict contains
key/value pairs("homer" => "D'oh"), ("lisa" => ""))
$string = $dict{"bart"};
## Lookup the key "bart"
to get ## the value "I didn't do it"
$string
=
$dict{"marge"}; ##
Returns undef -- there is no entry for "marge"
$dict{"homer"} = "Mmmm, scalars";
##
change the value for the key ## "homer" to "Mmmm, scalars"
@array
=
%dict;
## @array = ("homer","D'oh","lisa","","bart","I didn't do it");
## (keys %dict) looks like ("homer", "lisa, "bart")
## or use (sort (keys %dict))
%dict
= (
"bart" => "I didn't do it",
"homer" => "D'Oh",
"lisa" =>
"",);
#can use
=> instead of comma
======================Control=============================
while
(expr)
{ stmt;
stmt;
}
for
(init_expr; test_expr; increment_expr)
{ stmt;
stmt;
}
for
($i=0; $i<100; $i++)
## typical for loop to count 0..99 { stmt;
stmt;
}
foreach
$var (@array)
{ stmt; ## use $var in
here
stmt;
}
==================================ReadPrintFile.pl=================================================
if
($#ARGV
< 0)
{
print
"usage: perl ReadPrintFile.pl {drop file path in here } \n";
exit;
} $Path
=
$ARGV[0];
print
"The file being read = $Path \n";
open(INFILE,
$Path)
|| die "cannot open $Path " ;
@ArrayOfLines
=
<INFILE>
; foreach
$Eachline
(@ArrayOfLines)
{ $Thisline
=
$Eachline;
$Thisline
=~ s/^\s+//
;
# Strip leading spaces from a string
#
$Thisline
=~ s/\s*$//
;
# Strip trailing spaces from a string
$Thisline
=~ s/\s+/
/
;
# trade multi white space for one
$Thisline
=~ s/\s{2,}/
/
;
# trade 2 white spaces for one
print
"$Thisline";
}
close(INFILE)
;
===================================ReadPrintFileWords.pl==========================================================================
if
($#ARGV < 0)
{
print
"usage: perl ReadPrintFile.pl {drop file path in here } \n";
exit;
} $Path
=
$ARGV[0];
print
"The file being read = $Path \n";
open(INFILE,
$Path)
|| die "cannot open $Path " ;
@ArrayOfLines
=
<INFILE>
;
foreach
$Eachline
(@ArrayOfLines)
{ $Thisline
=
$Eachline;
$Thisline
=~ s/^\s+//
;
# Strip leading spaces from a string
$Thisline
=~ s/\s*$//
;
# Strip trailing spaces and \n from a string
$Thisline
=~ s/\s+/ /
;
# trade multi white space for one
$Thisline
=~ s/\s{2,}/ /
;
# trade 2 white spaces for one
@words
=
split(/
/,$Thisline);
# split by 1 white space
print
"First = $words[0] Second = $words[1] Third = $words[2] \n" ;
}
close(INFILE)
;
#
cd
/Users/donsauer/Documents/KEY/KEY0/IDEA2IC/PlayWithPerl/
#
perl
ReadPrintFileWords.pl textDataFile
#don-sauers-macbook-pro:PlayWithPerl donsauer$ perl
ReadPrintFileWords.pl textDataFile
#The file being read = textDataFile
#First = 711 Second = -84 Third = -43
#First = 712 Second = -84 Third = -37
==================================PrintChanges.pl==========================================================================
sub
trim($); #
Declare the subroutines
if
($#ARGV
< 0)
{
print
"usage: perl ReadPrintFile.pl {drop file path in here } \n";
exit;
} $Path
=
$ARGV[0];
print
"The file being read = $Path \n";
$lastValX
=
0;
$lastValY
=
0;
open(INFILE,
$Path)
|| die "cannot open $Path " ;
@ArrayOfLines
=
<INFILE>
; foreach
$Eachline
(@ArrayOfLines)
{ $Thisline
=
trim($Eachline);
@words
=
split(/
/,$Thisline);
# split by 1 white space if
( $words[1] !=
$lastValX &&
$words[2] != $lastValY )
{
print
"$words[0] $words[1] $words[2] \n" ;
} $lastValX
=
$words[1];
$lastValY
=
$words[2];
}
close(INFILE)
;
sub
trim($)
# trim white spaces
{ my $string
=
shift;
$string
=~ s/^\s+//
;
# Strip leading spaces from a string
$string
=~ s/\s*$//
;
# Strip trailing spaces and \n from a string
$string
=~ s/\s+/ /
;
# trade multi white space for one
$string
=~ s/\s{2,}/ /
;
# trade 2 white spaces for one
return
$string;
}
#
cd
/Users/donsauer/Documents/KEY/KEY0/IDEA2IC/PlayWithPerl/
#
perl
PrintChanges.pl textDataFile
sub
trim($)
# trim white spaces
{ my $string
=
shift;
$string
=~ s/^\s+//
;
# Strip leading spaces from a string
$string
=~ s/\s*$//
;
# Strip trailing spaces and \n from a string
$string
=~ s/\s+/ /
;
# trade multi white space for one
$string
=~ s/\s{2,}/ /
;
# trade 2 white spaces for one
return
$string;
}
#
cd
/Users/donsauer/Documents/KEY/KEY0/IDEA2IC/PlayWithPerl/
#
perl
SubroutineTest.pl textDataFile
@letters = ("c",
"l", "q",
"t");
print
"@letters\n";
# c l q t
@letters =
(@letters,"z") ;
print
"@letters\n";
# c l q t z
push(
@letters,"z");
print
"@letters\n";
# c l q t z
push(
@letters,"w");
print
"@letters\n";
# c l q t z w
$last
=
@letters[-1];
print
"last element =
$last\n"; # last
element = w
$lastelem =
pop(@letters);
print
"$lastelem &
@letters\n"; #w & c
l q t z
unshift(
@letters,"a");
print
"@letters\n";
# a c l q t z
($first) =
@letters;
print
"first element = $first\n"; # first
element =
a
$firstelem =
shift(@letters);
print
"$firstelem &
@letters\n"; # a & c l q
t z
#
cd
/Users/donsauer/Documents/KEY/KEY0/IDEA2IC/PlayWithPerl/
#
perl
ArrayTemplates.pl
====================================dec2hex.pl==========================================================================
print "The time is now
" , time()," seconds since
1970.\n"; # The time is now 1205547990 seconds
since 1970.
$hex =
sprintf("%X" ,
3735928559);
print "Dec->Hex
sprintf ",
$hex,"\n";
# Dec->Hex sprintf DEADBEEF
$hex =
unpack("H*" ,
pack("N", 3735928559));
print "Dec->Hex
unpack ",
$hex,"\n";
# Dec->Hex unpack deadbeef
$int = 0xDEADBEEF;
$dec =
sprintf("%d" , $int);
print "Hex->Dec
sprintf ",
$dec,"\n";
# Hex->Dec sprintf -559038737
$int = hex("DEADBEEF");
$dec =
sprintf("%d" , $int);
print "Hex->Dec
hex ",
$dec,"\n";
# Hex->Dec hex -559038737
$int = unpack("N", pack("H8", substr("0"
x 8 . "DEADBEEF", -8)));
$dec =
sprintf("%d" ,
$int);
print "Hex->Dec
unpack ",
$dec,"\n";
# Hex->Dec unpack -559038737
$number = 0b10110110;
print "written in Binary ",
$number,"\n";
# written in Binary 182
$decimal =
ord(pack('B8' , '10110110'));
print "pack and
ord ",
$decimal,"\n";
# pack and ord 182
$int =
unpack("N"
, pack("B32",
substr( "0" x 32
.
"11110101011011011111011101111", -32)));
$dec =
sprintf("%d" , $int);
print "pack and
unpack ",
$dec,"\n";
# pack and unpack 514703087
$bin =
unpack("B*" ,
pack("N", 3735928559));
print "dec to
bin ",
$bin,"\n";
# dec to bin 11011110101011011011111011101111
# cd
/Users/donsauer/Documents/KEY/KEY0/IDEA2IC/PlayWithPerl/
# perl dec2hex.pl
#
cd
/Users/donsauer/Documents/KEY/KEY0/IDEA2IC/PlayWithPerl/
#
perl
FileHexDump2.pl hello.pl
# don-sauers-macbook-pro:PlayWithPerl donsauer$ perl FileHexDump2.pl
hello.pl
# hello.pl
# perl FileHexDump is being run
# 23212f7573722f62696e2f7065726c0a
# 23232323232323232323232323232323
# 232323232323232323232323230a2323
# 204e616d653a20202020202020207361
# 6d706c65732f68656c6c6f2f68656c6c
===================================hello.pl==========================================================================
#!/usr/bin/perl
#############################################################################
## Name:
samples/hello/hello.pl
## Purpose: Hello wxPerl sample
## Author: Mattia Barbon
## Modified by:
## Created: 02/11/2000
## RCS-ID: $Id: hello.pl,v 1.3 2004/10/19
20:28:14 mbarbon Exp $
## Copyright: (c) 2000 Mattia Barbon
## Licence: This program is free software; you
can redistribute it and/or
##
modify it under the same terms as Perl itself
#############################################################################
use strict;
use Wx;
# every program must have a Wx::App-derive class
package MyApp;
use vars qw(@ISA);
@ISA = qw(Wx::App);
# this is called automatically on object creation
sub OnInit {
my( $this ) = shift;
# create a new frame
my( $frame ) = MyFrame->new();
# set as top frame
$this->SetTopWindow( $frame );
# show it
$frame->Show( 1 );
}
package MyFrame;
use vars qw(@ISA);
@ISA = qw(Wx::Frame);
use Wx::Event qw(EVT_PAINT);
# this imports some constants
use Wx qw(wxDECORATIVE wxNORMAL wxBOLD);
use Wx qw(wxDefaultPosition);
use Wx qw(wxWHITE);
sub new {
# new frame with no parent, id -1, title 'Hello, world!'
# default position and size 350, 100
my( $this ) = shift->SUPER::new( undef, -1, 'Hello, world!',
wxDefaultPosition , [350, 100] );
# create a new font object and store it
$this->{FONT} = Wx::Font->new( 40, wxDECORATIVE, wxNORMAL,
wxBOLD, 0 );
# set background colour
$this->SetBackgroundColour( wxWHITE );
$this->SetIcon( Wx::GetWxPerlIcon() );
# declare that all paint events will be handled with the OnPaint
method
EVT_PAINT( $this, \&OnPaint );
return $this;
}
sub OnPaint {
my( $this, $event ) = @_;
# create a device context (DC) used for drawing
my( $dc ) = Wx::PaintDC->new( $this );
# select the font
$dc->SetFont( $this->font );
# darw a friendly message
$dc->DrawText( 'Hello, world!', 10, 10 );
}
sub font {
$_[0]->{FONT};
}
package main;
# create an instance of the Wx::App-derived class
my( $app ) = MyApp->new();
# start processing events
$app->MainLoop();
# Local variables: #
# mode: cperl #
# End: #
#
cd
/Users/donsauer/Documents/KEY/KEY0/IDEA2IC/PlayWithPerl/
#
perl hello.pl
===================================paddingStrings.pl==========================================================================
print "The time is now ", time(), " seconds since
1970.\n"; # The
time is now 1191812029 seconds since 1970.
$text = "Left pad a string";
$pad_len =30;
$padded = sprintf("%${pad_len}s \n", $text);
print $padded
;
#
Left pad a string
$num = 33;
$padded = sprintf("%0${pad_len}d", $num);
print $padded
,"\n";
# 000000000000000000000000000033
$text = "Right pad a string";
$padded = sprintf("%-${pad_len}s", $text);
print $padded
,"####\n";
# Right pad a
string
####
$pad_len =30;
$text = "Right pack and tunct to 30 a string";
$padded = pack("A$pad_len",$text);
print $padded
,"####\n";
# Right pack and tunct to 30 a s####
$text = "Right pad a string";
$pad_char = "#";
$padded = $pad_char x ( $pad_len - length( $text ) ) . $text ;
$text = "Right pad a string2";
print $padded
,"\n";
# ############Right pad a string
$pad_len =30;
$pad_char = "@";
substr( $text, 0, 0 ) = $pad_char x ( $pad_len - length( $text )
);
$text .= $pad_char x ( $pad_len - length( $text ) );
print $text
,"#\n";
# @@@@@@@@@@@@Right pad a string#
$line = "MakeUpperCase";
$line = uc($line);
print $line
,"\n";
# MAKEUPPERCASE
$line = "make first letter UpperCase";
$line =~ s/(\w+)/\u\L$1/g;
print $line
,"\n";
# Make First Letter Uppercase
$string = " Strip Leading edges";
$string =~ s/^\s+//;
$string =~ s/\s+$//;
print $string
,"\n";
# Strip Leading edges
# cd
/Users/donsauer/Documents/KEY/KEY0/IDEA2IC/PlayWithPerl/
# perl paddingStrings.pl
===================================ReOrderFiles.pl==========================================================================
print
"perl FileRead is being run \n " ;
$reOderListfilename
=
'ReOrderList' ;
$outfilename
=
'BeenReordered.txt' ;
open(
INFILE1, " $reOderListfilename") || die "cannot
open $filename" ;
open(
OUTFILE,
">$outfilename")
|| die "cannot create $outfilename" ;
@ArrayOfList2Reorder
=
<INFILE1> ;
$List2ReorderLength
=
length(@ArrayOfList2Reorder) ;
#
while
(<STDIN>) { if (/$String2Find1/i ) { print; } }
#
cd
/Users/donsauer/Documents/KEY/KEY0/IDEA2IC/PlayWithPerl/
#
perl
StringSubstitute.pl ===================================StringTemplates.pl==========================================================================
#!/usr/bin/perl
use warnings;
print
"started
\n";
$str2print = substr("Once
upon a time", 3,
4);
print
"$str2print
\n";
# e up
$str2print2 = substr("Once upon a
time",
7);
print
"$str2print2
\n";
# on a time
$str1
=
"Once upon a time";
$str2print = uc($str1);
print
" $str2print
\n";
# ONCE UPON A TIME
$str2print = lc($str1);
print
"$str2print
\n";
# once upon a time
$str2print = ucfirst($str1);
print
"$str2print
\n";
# Once upon a time
$str2print = lcfirst($str1);
print
"$str2print
\n";
# once upon a time
$mystring = "Hello,
PERL!";
print
$mystring."\n";
# Hello, PERL!
substr(
$mystring, 7, 11) =
"World";
print
"$mystring\n";
# Hello, World
print
chr(65),"\n";
# A
print
ord('A'),"\n";
# 65
print
ord('\n'),"\n";
# 92
print
hex('0D'),"\n";
# 13
$Dec2Hex =
sprintf("%x",13);
print
"$Dec2Hex
\n";
# d
$str2print = join(":", ("a",
"b", "c"))
;
print
"$str2print
\n";
# a:b:c
$lenn
=
length($str2print);
print
"$lenn
\n";
#5
@A1
=
split(/:/,'a:b:c');
print
"@A1
\n";
# a b
c
@B1
=
(a..z);
$str2print = join("",@B1)
;
print
"$str2print
\n";
# abcdefghijklmnopqrstuvwxyz
$order_total_amt = 10.3;
$order_total= sprintf("%-20s
%5.2f","Your total is:",$order_total_amt);
print
"$order_total
\n";
# Your total is: 10.30
$order_total= sprintf("%-30s
%5.2e","Your total is:",$order_total_amt);
print
"$order_total
\n";
# Your total is: 1.03e+01
$order_total= sprintf("%-1s
%5.2g","Your total is:",$order_total_amt);
print
"$order_total
\n";
# Your total is: 10
$order_total= sprintf("%+20s
%5.4d","Your total is:",$order_total_amt);
print
"$order_total
\n";
# Your total is: 0010
$order_total= sprintf("%-19s %-19s
%-19s","Your total is:",$order_total_amt,"XXX");
print
"$order_total
\n";
# Your total is:
10.3
XXX0
print
"012345678901234567890123456789012345678901234567890123456789
\n";
print
"000000000011111111112222222222333333333344444444445555555555
\n";
print
"finished \n";
#
cd
/Users/donsauer/Documents/KEY/KEY0/IDEA2IC/PlayWithPerl/
#
perl
StringTemplates.pl
$ARGV[1]
=~
y/A-Z/a-z/;
\h'|3i' # canonicalize to lower case
$cnt
= tr/*/*/;
\h'|3i' # count the stars in $_
$cnt =
tr/0-9//;
\h'|3i' # count the digits in $_
tr/a-zA-Z//s;
\h'|3i' # bookkeeper -> bokeper
($HOST = $host) =~ tr/a-z/A-Z/;
y/a-zA-Z/ /cs;
\h'|3i' # change non-alphas to single space
tr/\200-\377/\0-\177/; \h'|3i' # delete 8th bit
"piiig" =~
m/iiig/ ==> TRUE #### The
pattern may be anywhere inside the string "piiig" =~ m/iii/ ==>
TRUE #### The pattern
may be anywhere inside the string "piiig" =~ m/iiii/ ==>
FALSE #### All of the pattern must
match "piiig" =~ m/...ig/ ==>
TRUE #### . = any char but \n "piiig" =~ m/p.i../ ==>
TRUE #### . = any char but \n "piiig" =~ m/p.i.../ ==>
FALSE #### The last . in the pattern is not
matched "p123g" =~ m/p\d\d\dg/ ==>
TRUE #### \d = digit [0-9] "p123g" =~ m/p\d\d\d\d/ ==> FALSE "p123g" =~ m/\w\w\w\w\w/ ==> TRUE
#### \w = letter or digit "piiig" =~ m/pi+g/ ==>
TRUE #### i+ = one or more i's "piiig" =~ m/i+/ ==>
TRUE #### matches
iii "piiig" =~ m/p+i+g+/ ==> TRUE "piiig" =~ m/p+g+/ ==> FALSE "piiig" =~ m/pi*g/ ==>
TRUE #### i* = zero or more
i's "piiig" =~ m/p*i*g*/ ==> TRUE "piiig" =~ m/pi*X*g/ ==>
TRUE #### X* can match zero X's "piiig" =~ m/^pi+g$/ ==>
TRUE #### ^ = start, $ = end "piiig" =~ m/^i+g$/ ==>
FALSE #### i is not at the start "piiig" =~ m/^pi+$/ ==>
FALSE #### i is not at the end "piiig" =~ m/^p.+g$/ ==> TRUE "piiig" =~ m/^p.+$/ ==> TRUE "piiig" =~ m/^.+$/ ==> TRUE "piiig" =~ m/^g.+$/ ==>
FALSE #### g is not at the start "piiig" =~ m/g.+/ ==>
FALSE #### Needs at least one
char after the g "piiig" =~ m/g.*/ ==>
TRUE #### Needs at
least zero chars after the g "cat" =~ m/^(cat|hat)$/ ==> TRUE #### | =
left or right expression "hat"
=~ m/^(cat|hat)$/ ==> TRUE
"cathatcatcat" =~ m/^(cat|hat)+$/ ==> TRUE
"cathatcatcat" =~ m/^(c|a|t|h)+$/ ==> TRUE
"cathatcatcat" =~ m/^(c|a|t)+$/ ==> FALSE
"cathatcatcat" =~ m/(c|a|t)+/ ==> TRUE #### Matches and stops
at first 'cat'; does not get to 'catcat' on the right
"12121x2121x2" =~ m/^(1x?2)+$/ ==> TRUE #### ? = optional
"aaaxbbbabaxbb" =~ m/^(a+x?b+)+$/ ==> TRUE
"aaaxxbbb" =~ m/^(a+x?b+)+$/ ==> FALSE
"Easy does it" =~ m/^\w+\s+\w+\s+\w+$/ ==> TRUE #### Three
words separated by spaces
"bill.gates@microsoft.com" =~ m/\w+@\w+/ ==> TRUE#### Just matches
"gates@microsoft" -- \w does not match the "."
"bill.gates@microsoft.com" =~ m/^(\w|\.)+@(\w|\.)+$/ ==> TRUE ####
Add the .'s to get the whole thing
"Klaatu, barada,nikto" =~ m/^\w+(,\s*\w+)*$/ ==> TRUE #### words
separated by commas and possibly spaces
sub bintodec {
unpack("N", pack("B32", substr("0" x 32 . shift, -32))); }
$foo =
pack("cccc",65,66,67,68);
# foo eq "ABCD"
$foo =
pack("c4",65,66,67,68);
# same thing
$foo =
pack("ccxxcc",65,66,67,68);
# foo eq "AB\0\0CD"
$foo =
pack("s2",1,2);
# "\1\0\2\0" on little-endian # "\0\1\0\2" on big-endian
$foo =
pack("a4","abcd","x","y","z");
# "abcd"
$foo =
pack("aaaa","abcd","x","y","z");
# "axyz"
$foo =
pack("a14","abcdefg");
# "abcdefg\0\0\0\0\0\0\0"
$foo = pack("i9pl",
gmtime);
# a real struct tm (on my system anyway)
@articles = sort
@files;
# sort lexically
@articles = sort {$a cmp $b}
@files;
# same thing, but with explicit sort routine
@articles = sort {$b cmp $a}
@files;
# same thing in reversed order
@articles = sort {$a <=> $b}
@files;
# sort numerically ascending
@articles = sort {$b <=> $a}
@files;
# sort numerically descending
Scalars
$var
-» scalar = number, string, or reference
undef
-» acts like 0 or "", initial value
defined($var)
-» true if not undef
false is 0, "0", "", or undef
not, and, or, xor
Numbers
123, 0xff, 0377, 1.23e-3
numbers stored as float
use
integer;
-» numbers stored as int
+, -, *, /, ++, -, =+, =-, =*, =/
** (exponential), **=
% (modulus), %=
==, !=, <, >, <=, >=, <=>
$num <=>
$num
-» -1, 0, or 1
abs, int, sin, cos, atan2, sqrt, exp, log
int(3.7)
-» 3
atan2(y,
x)
-» arctan(y/x)
time
-» seconds since Jan 1, 1970
($sec, $min, $hr, $day, $min, $yr, $wk, $jul, $dls) = localtime(time);
rand
-» random float in {0, 1}
srand
123
-» seed random with 123
Strings
"text$var"
-» contents of var
"text${var}text"
-» if alpha after var
eq, ne, lt, gt, le, ge
2 < 12, but 2 gt 12
"a" ne "b", but "a" == "b"
$text cmp
$text
-» -1, 0, or 1 chomp($var)
-» removes last newline
quotemeta($str)
-» no meta chars
String/Number Conversion
"12"
-» 12
"
12ab"
-» 12
"ab"
-» 0
undef
-» 0
12
-» "12"
undef
-» ""
splice(array, index, length, array2) -- removes section index and
length, and replaces with array2.
splice(@array, $i, 1). //delete the element at index $i from an array,
use
References
$rs =
\$s
-» ref to scalar
$ra =
\@a
-» ref to array
$rh =
\$h
-» ref to hash
$ra =
\"a"
-» ref to const
$$rs
-» deref ref to scalar
@$ra
-» deref ref to array
%$rh
-» deref ref to hash
$ra->[2]
-» $$ra[2]
$rh->{key}
-» $$rh{key}
$ra =
[]
-» allocate new array
$rh =
{}
-» allocate new hash
$rc =
\&func;
-» ref to subroutine
$rc =
sub{body};
-» ref to code block
&$rc(a,
b)
-» call func ref
ref($var)
-» 'SCALAR', 'ARRAY', 'HASH', 'REF', 'GLOB', 'CODE', or undef
Arrays
@arr
-» array of scalars
$arr[i]
-» i'th item in array, 0-based
(1, $two,
3)
-» literal array
@arr = (
)
-» clear arr
$len =
@arr
-» length of arr
($a) =
@arr
-» first element
@arr =
2
-» @arr = (2)
@arr1 =
@arr2
-» copies array
(1..3)
-» (1, 2, 3)
qw(Cat
Dog)
-» ("Cat", "Dog")
($a, $b) = (1,
2)
-» $a = 1; $b = 2
($a,
@arr)=(1,2)
-» $a=1; @arr=(2)
@arr[-1]
-» last element of array
@arr[-2]
-» second to last element
push(@arr,
1)
-» pushes on end
$a =
pop(@arr)
-» pops from end
unshift(@arr,
1)
-» pushes on front
$a =
shift(@arr)
-» pops from front
join(":", ("a", "b",
"c"))
-» "a:b:c"
split(":",
"a:b:c")
-» ("a", "b", "c")
splice(@arr, $start,
$len)
-» substr
reverse(@arr)
-» reverse order copy
sort(@arr)
-» copy sorted as text
sort {$a <=> $b}
@arr
-» as nums
@arr[0][0] =
3
-» access 2 dim array
@arr = ([0, 1], [10,
11])
-» init 2 dim
Hashes
%hash
-» hash of scalars by strings
$hash{key} =
val
-» set val at key
$hash{key}
-» value at key or undef
%hash = (key => val, key => val)
%hash=(a, b, c,
d)
-» (a => b, c => d)
@arr =
%hash
-» list of pairs
%hash1 =
%hash2
-» copies hash
keys(%hash)
-» list of keys
values(%hash)
-» list of values
while(($key, $value) = each(%hash))
delete
$hash{key}
-» remove entry
$hash{@keys}
-» array of pairs
Regular Expressions
Matching
str =~
m/pat/
-» true if str matches pat
str !~
m/pat/
-» true if str not matches
$`
-» before match
$&
-» matched
$'
-» after match
m/pat/i
-» ignore case
m/pat/x
-» ignore whitespace
$str =~
m/pat/g
-» array of matches
m/$var/
-» contents of var
Substitution
$str =~
s/pat/new/
-» replaces whatever matches pat with to new
ex: "ab" =~
s/(\w)/$1:/g
-» "a:b:"
s/pat/new/g
-» all occurrences
s/pat/new/i
-» ignores case
can use match vars in replacement
Simple Patterns
.
-» any char except \n
\d
-» a digit
\w
-» alphanumeric or _
\s
-» whitespace
\D
-» not a digit
\W
-» not alphanumeric or _
\S
-» not whitespace
[abc]
-» a or b or c
[a-z]
-» any char from a thru z
[^pat]
-» chars not in pattern
/blue|red|green/
-» choices
/\Q$var\E/
-» disable special chars
\Qpat\E
-» disable special chars
Repeating Patterns
c*
-» zero or more c's
c*?
-» lazy * (as few as possible)
c+
-» one or more c's
c+?
-» lazy +
c?
-» zero or one c
c??
-» lazy ?
c{3,7}
-» between 3 and 7 c's
c{3,}
-» 3 or more c's
c{3}
-» exactly 3 c's
c{3,7}?
-» lazy
Extraction Patterns
(pat)
-» sets $1, $2, ...
(?:pat)
-» group without assigning
Anchor Patterns
m/a/
-» 'a' anywhere in string
m/^a/
-» 'a' at start of string
m/a$/
-» 'a' at end of string
\b
-» word boundary
\B
-» not word boundary
(?!a)
-» must not match a
(?=a)
-» match but not consumed
Files
File I/O
$var
=
-» line from console
@array
=
-» array of lines
open(X,
"file");
-» open for input
open(X,
">file");
-» open for output
open(X,
">>file");
-» open to append
close(X);
-» close file
$!
-» text of last system error
$var
=
-» read line from handle
$_
-» current line
getc
X
-» read one char
$/ =
"x"
-» set read delimiter
print
"text";
-» write to console
print X
"text";
-» write to handle
print
@array;
-» print contents
printf(format, var1,
...)
-» like C++
ex: %s, %d, %10.2f, %016x, %e
sprintf(format, var1,
...)
-» as string
File Attributes
-f
"file"
-» true if file exists
-d
"dir"
-» true if directory exists
-w
"file"
-» true if file is writable
-M
"file"
-» modification age in days
-s
"file"
-» file size
File Management
chdir
"dir"
-» change current dir
@files = glob("*.cpp
*.hpp")
-» file list
@files = <"*.cpp
*.hpp">
-» like glob
opendir(X,
"dir")
-» files in dir
closedir(X)
readdir(X)
-» next file (with . and ..)
unlink("file")
-» delete file
unlink(<*.tmp>)
-» delete matching
rename("old",
"new")
-» rename file
mkdir("dir")
-» create dir
rmdir("dir")
-» delete empty dir
chmod(0666,
"file")
-» set read/write
chmod(0444,
"file")
-» set read only
Databases
db is hash saved to disk
dbmopen(%hash, "file",
0666)
-» open
dbmclose(%hash)
-» close
General
Flow Control
{ stmt1; stmt2; ...
}
-» block
if (test1) {a} elsif (test2) {b} else {c}
unless (test) {a} else {b}
while (test) {block}
until (test) {block}
do {block} while (test)
do {block} until (test)
for (init;test; incr) {block}
foreach $item (list) {block}
last;
-» exit loop or block
redo;
-» repeats loop or block
next;
-» continues enclosed loop
LABEL:
-» labels loop or block
last
LABEL;
-» exit to label
next
LABEL;
-» continues at label
redo
LABEL;
-» repeats at label
expr if test;
expr unless test;
expr while test;
expr until test;
expr1 and expr2;
expr1 or expr2;
not expr
expr1 ? expr2 : expr3;
die
"msg\n";
-» prints and aborts
warn
"msg\n";
-» prints and continues
grep {test}
@arr
-» subset
ex: grep {$_ > 2} (1, 2, 3,
4)
-» (3, 4)
grep test,
@arr
-» subset
ex: grep m/a/, ('cat',
'dog')
-» ('cat')
map {block}
@arr
-» apply block to arr
ex: map {$_ * 2} (1, 2,
3)
-» (2, 4, 6)
map expr,
@arr
-» apply expr to arr
ex: map
m/(\w)/,('a1','b2')
-» ('a','b')
Functions
sub func
{body}
-» defune func
sub func(arg1,
...);
-» declare func
return
val;
-» returns val
return (1, 2,
3);
-» returns array
func(arg1, arg2,
...);
-» call function
@_
-» arguments to function
my ($var1, $var2) =
@_;
-» get args
Process Management
%ENV
-» environment variables
$ENV{"var"}
-» get var
$ENV{"var"} =
"value"
-» set var
system("cmd")
-» execute DOS command - returns 0 if worked
system("cmd","arg1","arg2")
-» fast
@results =
`cmd`
-» run DOS cmd, returns console text as array
open(X,
"cmd|")
-» cmd started in own thread - output of cmd accessed via X
open(X, "cmd1 | cmd2
|")
-» output of cmd1 piped to cmd2 and its output piped to X
open(X,
"|cmd")
-» cmd started in own thread - input sent to cmd via X
close(X)
-» waits for cmd to end
Environment Settings
assoc .pl=Perl
ftype Perl=D:\perl\bin\perl.exe %1 %*
set PATHEXT=%PATHEXT%;.PL
Miscellaneous
#
-» comment to end of line
variable names made of a-z, A-Z, and _
use
strict;
-» must declare vars
my
$var;
-» declare scalar var
my $var =
123;
-» initialized
my
@var;
-» declare array var
my
%var;
-» declare hash var
local
$var;
-» local to func
@ARGV
-» command line arguments
$ENV{envVar}
-» value of envir var
eval($code)
-» run Perl code
if error, puts error in $@
perl -p -i.bak -e "s/aa/bb/g"
file
-» applies Perl code to file
Home
Perl Cheatsheet 2/25/05 8:19 PM
http://home.alltel.net/lty/perl.html Page 6 of 6
%ENV
contains the environment variables of the
context that launched the Perl program.
@ARGV
and %ENV make the most sense in a Unix environment.
%ENV
-» environment variables
$ENV{"var"}
-» get var
$ENV{"var"} =
"value"
-» set var
system("cmd")
-» execute DOS command - returns 0 if worked
system("cmd","arg1","arg2")
-» fast
@results =
`cmd`
-» run DOS cmd, returns console text as array
open(X,
"cmd|")
-» cmd started in own thread - output of cmd accessed via X
open(X, "cmd1 | cmd2
|")
-» output of cmd1 piped to cmd2 and its output piped to X
open(X,
"|cmd")
-» cmd started in own thread - input sent to cmd via X
close(X)
-» waits for cmd to end
Environment
Settings
assoc
.pl=Perl
ftype
Perl=D:\perl\bin\perl.exe %1 %*
set
PATHEXT=%PATHEXT%;.PL
#
-» comment to end of line
use
strict;
-» must declare vars
my
$var;
-» declare scalar var
my $var =
123;
-» initialized
my
@var;
-» declare array var
my
%var;
-» declare hash var
local
$var;
-» local to func
@ARGV
-» command line arguments
$ENV{envVar}
-» value of envir var
eval($code)
-» run Perl code
if error, puts error in $@
perl -p -i.bak -e "s/aa/bb/g"
file
-» applies Perl code to file
