#How to Use Perl to Search a PDF Doc
#!/usr/bin/perl
use CAM::PDF;
my $file = shift;
my $search = shift;
my $doc = CAM::PDF->new($file);
foreach my $p ((1 .. $doc->numPages())) {
#print "$p\n";
my $str = $doc->getPageText($p);
@lines = split(/\n/, $str);
}
my $i = 0;
foreach $line (@lines) {
++$i;
if($line =~ /$search/) {
print "\"$search\" found in line $i of page $p\n";
print "$line\n\n"
}
}
Friday, December 31, 2010
File::Find::Rule and Glob
use File::Find::Rule;
print "$_\n" for File::Find::Rule->file()->name('*.pdf')->in('e:/purand/');
#!/usr/bin/perl
use File::Glob ':glob'; # Override glob built-in.
print join("\n",glob("*.pdf"));
__END__
my $rule = File::Find::Rule->file()->name('*.pdf')->start('e:/purand/');
while (defined (my $pdf = $rule->match)) {
print "$pdf\n";
}
print "$_\n" for File::Find::Rule->file()->name('*.pdf')->in('e:/purand/');
#!/usr/bin/perl
use File::Glob ':glob'; # Override glob built-in.
print join("\n",glob("*.pdf"));
__END__
my $rule = File::Find::Rule->file()->name('*.pdf')->start('e:/purand/');
while (defined (my $pdf = $rule->match)) {
print "$pdf\n";
}
Add Two Arrays
@array1 = (1, 2, 3);
@array2 = (4, 5, 6, 7);
if(@array1 > @array2) {
$len = @array1;
}
else {
$len = @array2;
}
for($i = 0; $i < $len; $i++) {
push(@sum, ($array1[$i]+$array2[$i]));
}
print "@sum";
@array2 = (4, 5, 6, 7);
if(@array1 > @array2) {
$len = @array1;
}
else {
$len = @array2;
}
for($i = 0; $i < $len; $i++) {
push(@sum, ($array1[$i]+$array2[$i]));
}
print "@sum";
GREP examples
my @selected = map { /before(pattern)after/ ? $1 : () } @all;
next unless grep {$_ eq $fromdevice} @sitenamekeys);
@map_results1 = map { substr $_, -3 } grep { /^[Ff]/ } @map_results1;
@array = ( 'hai','hello','bar','foo' ) ;
print grep (/hai/ , @array );
hai
# writes all elements from @array containing 'hai' in them
print grep ("hai",@array ) ;
haihellobarfoo
# writes all elements, because "hai" evaluates to true
print map (/hai/ , @array );
1
# writes 1 for the only element from the @array, that contains 'hai'
print map ("hai",@array ) ;
haihaihaihai
# maps 'hai' to each element from @array
next unless grep {$_ eq $fromdevice} @sitenamekeys);
@map_results1 = map { substr $_, -3 } grep { /^[Ff]/ } @map_results1;
@array = ( 'hai','hello','bar','foo' ) ;
print grep (/hai/ , @array );
hai
# writes all elements from @array containing 'hai' in them
print grep ("hai",@array ) ;
haihellobarfoo
# writes all elements, because "hai" evaluates to true
print map (/hai/ , @array );
1
# writes 1 for the only element from the @array, that contains 'hai'
print map ("hai",@array ) ;
haihaihaihai
# maps 'hai' to each element from @array
Regex lookahead, lookbehind and atomic groups
Regex lookahead, lookbehind and atomic groups are (?!) - negative lookahead(?=) - positive lookahead(?<=) - positive lookbehind(?<!) - negative lookbehind
(?>) - atomic group
EX 1:
given the string foobarbarfoo
bar(?!bar) finds the second bar in the string.
bar(?=bar) finds the first bar in the string.
(?<=foo)bar finds the firs bar in the string
(?<!foo)bar finds the second bar in the string you can also combine them
(?<=foo)bar(?=bar) EX 2:
Check for 5 characters, then a space, then a non-space
(?=.{5}\s\S)
EX 3:^(?=.{3}$).*^ # The caret is an anchor which denotes "STARTS WITH" (?= # lookahead . # wildcard match; the . matches any non-new-line character {3} # quantifier; exactly 3 times $ # dollar sign; I'm not sure if it will act as an anchor but if it did it would mean "THE END" ) # end of lookbehind . # wildcard match; the . matches any non-new-line character * # quantifier; any number of times, including 0 times
EX 4:$a = "<no> 3232 </no> ";
$a =~ s#(?<=<no>).*?(?=</no>)# 000 #gi;
print "$a\n";EX 5:perl -pe 's/(.)(?=.*?\1)//g' FILE_NAME(.)(?=.*?\1).: to match any char.- first
(): remember the matched single char. (?=...): +ve lookahead.*?: to match anything in between\1: the remembered match.(.)(?=.*?\1): match and remember any char only if it appears again later in the string.s///: Perl way of doing the substitution.g: to do the substitution globally...that is don't stop after first substitution.s/(.)(?=.*?\1)//g: this will delete a char from the input string only if that char appears again later in the string.
Remove tag using lookahead assertion
use strict;
use warnings;
undef $/;
my $file = <DATA>;
while($file =~ s#<([^>]+)\s*([^>]+)?>((?!<.*?>).*?)<\/\1>##) {
print "$3\n";
}
__END__
use warnings;
undef $/;
my $file = <DATA>;
while($file =~ s#<([^>]+)\s*([^>]+)?>((?!<.*?>).*?)<\/\1>##) {
print "$3\n";
}
__END__
- (?=pattern)
- A zero-width positive lookahead assertion. For example,
/\w+(?=\t)/matches a word followed by a tab, without including the tab in$&. - (?!pattern)
- A zero-width negative lookahead assertion. For example
/foo(?!bar)/matches any occurrence of ``foo'' that isn't followed by ``bar''. Note however that lookahead and lookbehind are NOT the same thing. You cannot use this for lookbehind.
Modify Date Only Working
$file = "dateparse.pl";
#$file = $0;
if (-M $file > 1) { exit; }
print "Welcome\n";
#$file = $0;
if (-M $file > 1) { exit; }
print "Welcome\n";
Get nth Element
$line = "Explicit|00|11|Hello World|12 3 134||and|blah|blah|blah";
if ( my $seventh = ( split /\|/, $line)[6] ) {
print $seventh;
}
print "\n\n\n";
#to get sixth and seventh element
@seventh = ( split /\|/, $line)[6,7];
print "@seventh";
if ( my $seventh = ( split /\|/, $line)[6] ) {
print $seventh;
}
print "\n\n\n";
#to get sixth and seventh element
@seventh = ( split /\|/, $line)[6,7];
print "@seventh";
Format in Perl
$subject = "Test form";
$info = "Some miscellaneous information";
$info .= " about me.";
$phone = "555-5555";
write;
format STDOUT_TOP =
# This area can contain headers which can look like the
# info between the periods below.
Sample Format Style
.
format STDOUT =
Subject: @<<<<<<<<<
$subject $info
Telephone: @<<<<<<<<
$phone $info
~ ^<<<<<<<
$info
.
__END__
Sample Format Style
Subject: Test form
Telephone: 555-5555
Some
$info = "Some miscellaneous information";
$info .= " about me.";
$phone = "555-5555";
write;
format STDOUT_TOP =
# This area can contain headers which can look like the
# info between the periods below.
Sample Format Style
.
format STDOUT =
Subject: @<<<<<<<<<
$subject $info
Telephone: @<<<<<<<<
$phone $info
~ ^<<<<<<<
$info
.
__END__
Sample Format Style
Subject: Test form
Telephone: 555-5555
Some
Compare two arrays and create third array
my @first=(1..30);
my @second=qw(5 8.1 9.1 9.2 10 15 21.5 21.9 2.1);
my $i=1;
foreach $num (@first) {
push(@new, $num);
foreach $c (@second) {
if((!(grep /$c/, @first)) and ($c > $num) and ($c < $num+1)){
push(@new, $c);
}
=start
elsif($c == $num) {
#print "$num: match array\n";
}
=cut
}
$i++;
}
print $_, "\n" foreach (@new);
my @second=qw(5 8.1 9.1 9.2 10 15 21.5 21.9 2.1);
my $i=1;
foreach $num (@first) {
push(@new, $num);
foreach $c (@second) {
if((!(grep /$c/, @first)) and ($c > $num) and ($c < $num+1)){
push(@new, $c);
}
=start
elsif($c == $num) {
#print "$num: match array\n";
}
=cut
}
$i++;
}
print $_, "\n" foreach (@new);
Thursday, December 30, 2010
Split Multiple character
use strict;
use warnings;
#open my $infile, '<', 'filein.csv' or die "error opening infile $!";
open my $outfile, '>', 'fileout.csv' or die "error opening outfile $!";
#while (<$infile>) {
while (<DATA>) {
chomp;
my @fields = split /,|\|/, $_;
print $outfile join(',', @fields), "\n";
}
close $outfile;
#close $infile;
__DATA__
street 1,chennai
street 2|chennai
street 3|chennai
street 4,chennai
use warnings;
#open my $infile, '<', 'filein.csv' or die "error opening infile $!";
open my $outfile, '>', 'fileout.csv' or die "error opening outfile $!";
#while (<$infile>) {
while (<DATA>) {
chomp;
my @fields = split /,|\|/, $_;
print $outfile join(',', @fields), "\n";
}
close $outfile;
#close $infile;
__DATA__
street 1,chennai
street 2|chennai
street 3|chennai
street 4,chennai
Data Dumper
my $hashref= {a => 1, b => 2};
print Dumper($hashref);
use Data::Dumper;
my %hashvar = (a => 1, b => 2);
print Dumper(\%hashvar);
In the first case the variable is a hash so you must take its reference; in the second you have a reference to a hash and is therefore passed as-is to
Data::Dumperhttp://stackoverflow.com/questions/4562574/how-do-i-do-something-like-print-dumper-var-in-empedperl
Wednesday, December 29, 2010
Assign A to Z variable or array
foreach $o (A..Z) {
$$o="$o"; #assign A..Z variables
@$o="$o"; #assign A..Z arrays
print "$$o\n"; #print variables
print "@A\n"; #print array
}
__END__
$n=0;
@a=(A..Z);
$a=@a;
while($n < $a) {
$c = $a[$n];
$c="\$$c";
print "$c\n";
$n++;
}
$$o="$o"; #assign A..Z variables
@$o="$o"; #assign A..Z arrays
print "$$o\n"; #print variables
print "@A\n"; #print array
}
__END__
$n=0;
@a=(A..Z);
$a=@a;
while($n < $a) {
$c = $a[$n];
$c="\$$c";
print "$c\n";
$n++;
}
XML tag delete
#how to opening and close tag delete in the xml file
print "First steps\n";
$pos = tell DATA;
while(<DATA>){
s/<.*?>//g; #tags delete text only display
print;
}
print "Second steps\n";
seek DATA, $pos, 0;
while(<DATA>){
s/<.*>/\n/g #Entirely delete nothing to display
print;
}
__END__
<h1 type="0.25">Koike family</h1> <h2>Home Page</h2> <h3>By chaichanpapa</h3>
print "First steps\n";
$pos = tell DATA;
while(<DATA>){
s/<.*?>//g; #tags delete text only display
print;
}
print "Second steps\n";
seek DATA, $pos, 0;
while(<DATA>){
s/<.*>/\n/g #Entirely delete nothing to display
print;
}
__END__
<h1 type="0.25">Koike family</h1> <h2>Home Page</h2> <h3>By chaichanpapa</h3>
Character increment in perl
Method 1:
$char = "C";
$char = (ord($char)+1);
print chr $char;
Method 2:
for ( $i=26, $c='a' ; $i ; $i--, $c=chr(ord($c)+1) ) { printf("$c\n"); }
Method 3:
print ++($foo = 'A');
$char = "C";
$char = (ord($char)+1);
print chr $char;
Method 2:
for ( $i=26, $c='a' ; $i ; $i--, $c=chr(ord($c)+1) ) { printf("$c\n"); }
Method 3:
print ++($foo = 'A');
Remove Blank Lines
while(my $line = <DATA>) {
print $line if ($line=~/\S/);
}
__DATA__
<book>
<name>Perl Programming</name>
<author>XYZ</author>
<info>
<pages>150</pages>
<description>A Complete programmer guide</description>
<price>850</price>
</info>
</book>
print $line if ($line=~/\S/);
}
__DATA__
<book>
<name>Perl Programming</name>
<author>XYZ</author>
<info>
<pages>150</pages>
<description>A Complete programmer guide</description>
<price>850</price>
</info>
</book>
Using XML::XPath to get nodes and Strings
#Xpath.pl data1.xml "/inventory/category/item/name"
#Xpath.pl data1.xml "/inventory/category/item/name[@style='latin']"
#Xpath.pl data1.xml "//item[@id='222']/note"
#Xpath.pl data1.xml "//item[@id='222']/note/text( )"
#Xpath.pl data1.xml "/inventory/@date"
#Xpath.pl data1.xml "//*[@id='104']/parent::*/preceding-sibling::*/child::*[2]/name[not(@style='latin')]/node( )"
use XML::XPath;
use XML::XPath::XMLParser;
# create an object to parse the file and field XPath queries
my $xpath = XML::XPath->new( filename => shift @ARGV );
# apply the path from the command line and get back a list matches
my $nodeset = $xpath->find( shift @ARGV );
# print each node in the list
foreach my $node ( $nodeset->get_nodelist ) {
print XML::XPath::XMLParser::as_string( $node ) . "\n";
}
#Xpath.pl data1.xml "/inventory/category/item/name[@style='latin']"
#Xpath.pl data1.xml "//item[@id='222']/note"
#Xpath.pl data1.xml "//item[@id='222']/note/text( )"
#Xpath.pl data1.xml "/inventory/@date"
#Xpath.pl data1.xml "//*[@id='104']/parent::*/preceding-sibling::*/child::*[2]/name[not(@style='latin')]/node( )"
use XML::XPath;
use XML::XPath::XMLParser;
# create an object to parse the file and field XPath queries
my $xpath = XML::XPath->new( filename => shift @ARGV );
# apply the path from the command line and get back a list matches
my $nodeset = $xpath->find( shift @ARGV );
# print each node in the list
foreach my $node ( $nodeset->get_nodelist ) {
print XML::XPath::XMLParser::as_string( $node ) . "\n";
}
XML::Parser
use XML::Parser;
my $xmlfile = shift @ARGV; # the file to parse
# initialize parser object and parse the string
my $parser = XML::Parser->new(ErrorContext => 2);
eval { $parser->parsefile($xmlfile);};
# report any error that stopped parsing, or announce success
if($@) {
$@ =~ s/at((?:(?!\bat\b)).*?)$//i; # remove module line number
print STDERR "\nERROR in '$xmlfile':\n$@\n";
} else {
print STDERR "'$xmlfile' is well-formed\n";
}
my $xmlfile = shift @ARGV; # the file to parse
# initialize parser object and parse the string
my $parser = XML::Parser->new(ErrorContext => 2);
eval { $parser->parsefile($xmlfile);};
# report any error that stopped parsing, or announce success
if($@) {
$@ =~ s/at((?:(?!\bat\b)).*?)$//i; # remove module line number
print STDERR "\nERROR in '$xmlfile':\n$@\n";
} else {
print STDERR "'$xmlfile' is well-formed\n";
}
Alphanumeric sort in Perl
Method 1:
@input = (exon1, exon5, exon12, exon30, exon2);
my @sorted = sort { substr($a, 4) <=> substr($b, 4) } @input;
print "@sorted";
Method 2:
use strict;
use warnings;
use Data::Dumper;
my $fh = \*DATA;
my %lines;
while (my $line = <$fh>) {
chomp($line);
$lines{$_}++ for split /,/, $line;
}
my @sorted_array = sort keys %lines;
print Dumper \@sorted_array;
__DATA__
A2B12,A8B15
A3B27
A5B14,A8B15,A5B18
Executing external commands
There are many ways to execute external commands from Perl. The most commons are:
* system function
* exec function
* backticks (``) operator
* open function
All of these methods have different behaviour, so you should choose which one to use depending of your particular need. In brief, these are the recommendations:
method use if ...
system() you want to execute a command and don't want to capture its output
exec you don't want to return to the calling perl script
backticks you want to capture the output of the command
open you want to pipe the command (as input or output) to your script
More detailed explanations of each method follows:
# Using system()
system() executes the command specified. It doesn't capture the output of the command.
system() accepts as argument either a scalar or an array. If the argument is a scalar, system() uses a shell to execute the command ("/bin/sh -c command"); if the argument is an array it executes the command directly, considering the first element of the array as the command name and the remaining array elements as arguments to the command to be executed.
For that reason, it's highly recommended for efficiency and safety reasons (specially if you're running a cgi script) that you use an array to pass arguments to system()
Example:
#-- calling 'command' with arguments
system("command arg1 arg2 arg3");
#-- better way of calling the same command
system("command", "arg1", "arg2", "arg3");
The return value is set in $?; this value is the exit status of the command as returned by the 'wait' call; to get the real exit status of the command you have to shift right by 8 the value of $? ($? >> 8).
If the value of $? is -1, then the command failed to execute, in that case you may check the value of $! for the reason of the failure.
Example:
system("command", "arg1");
if ( $? == -1 )
{
print "command failed: $!\n";
}
else
{
printf "command exited with value %d", $? >> 8;
}
# Using exec()
The exec() function executes the command specified and never returns to the calling program, except in the case of failure because the specified command does not exist AND the exec argument is an array.
Like in system(), is recommended to pass the arguments of the functions as an array.
# Using backticks (``)
In this case the command to be executed is surrounded by backticks. The command is executed and the output of the command is returned to the calling script.
In scalar context it returns a single (possibly multiline) string, in list context it returns a list of lines or an empty list if the command failed.
The exit status of the executed command is stored in $? (see system() above for details).
Example:
#-- scalar context
$result = `command arg1 arg2`;
#-- the same command in list context
@result = `command arg2 arg2`;
Notice that the only output captured is STDOUT, to collect messages sent to STDERR you should redirect STDERR to STDOUT
Example:
#-- capture STDERR as well as STDOUT
$result = `command 2>&1`;
# Using open()
Use open() when you want to:
- capture the data of a command (syntax: open("command |"))
- feed an external command with data generated from the Perl script (syntax: open("| command"))
Examples:
#-- list the processes running on your system
open(PS,"ps -e -o pid,stime,args |") || die "Failed: $!\n";
while ( <PS> )
{
#-- do something here
}
#-- send an email to user@localhost
open(MAIL, "| /bin/mailx -s test user\@localhost ") || die "mailx failed: $!\n";
print MAIL "This is a test message";
* system function
* exec function
* backticks (``) operator
* open function
All of these methods have different behaviour, so you should choose which one to use depending of your particular need. In brief, these are the recommendations:
method use if ...
system() you want to execute a command and don't want to capture its output
exec you don't want to return to the calling perl script
backticks you want to capture the output of the command
open you want to pipe the command (as input or output) to your script
More detailed explanations of each method follows:
# Using system()
system() executes the command specified. It doesn't capture the output of the command.
system() accepts as argument either a scalar or an array. If the argument is a scalar, system() uses a shell to execute the command ("/bin/sh -c command"); if the argument is an array it executes the command directly, considering the first element of the array as the command name and the remaining array elements as arguments to the command to be executed.
For that reason, it's highly recommended for efficiency and safety reasons (specially if you're running a cgi script) that you use an array to pass arguments to system()
Example:
#-- calling 'command' with arguments
system("command arg1 arg2 arg3");
#-- better way of calling the same command
system("command", "arg1", "arg2", "arg3");
The return value is set in $?; this value is the exit status of the command as returned by the 'wait' call; to get the real exit status of the command you have to shift right by 8 the value of $? ($? >> 8).
If the value of $? is -1, then the command failed to execute, in that case you may check the value of $! for the reason of the failure.
Example:
system("command", "arg1");
if ( $? == -1 )
{
print "command failed: $!\n";
}
else
{
printf "command exited with value %d", $? >> 8;
}
# Using exec()
The exec() function executes the command specified and never returns to the calling program, except in the case of failure because the specified command does not exist AND the exec argument is an array.
Like in system(), is recommended to pass the arguments of the functions as an array.
# Using backticks (``)
In this case the command to be executed is surrounded by backticks. The command is executed and the output of the command is returned to the calling script.
In scalar context it returns a single (possibly multiline) string, in list context it returns a list of lines or an empty list if the command failed.
The exit status of the executed command is stored in $? (see system() above for details).
Example:
#-- scalar context
$result = `command arg1 arg2`;
#-- the same command in list context
@result = `command arg2 arg2`;
Notice that the only output captured is STDOUT, to collect messages sent to STDERR you should redirect STDERR to STDOUT
Example:
#-- capture STDERR as well as STDOUT
$result = `command 2>&1`;
# Using open()
Use open() when you want to:
- capture the data of a command (syntax: open("command |"))
- feed an external command with data generated from the Perl script (syntax: open("| command"))
Examples:
#-- list the processes running on your system
open(PS,"ps -e -o pid,stime,args |") || die "Failed: $!\n";
while ( <PS> )
{
#-- do something here
}
#-- send an email to user@localhost
open(MAIL, "| /bin/mailx -s test user\@localhost ") || die "mailx failed: $!\n";
print MAIL "This is a test message";
export a global variable between two different perl scripts
Method 1:
They will share global variables, yes. Are you seeing some problem with that?
Example:
first.pl:
#!/usr/bin/perl
use strict;
use warnings;
our (@a, @b);
@a = 1..3;
@b = "a".."c";
second.pl:
#!/usr/bin/perl
use strict;
use warnings;
require "first.pl";
our (@a,@b);
print @a;
print @b;
Giving:
$ perl second.pl
123abc
Method 2:
#!/usr/bin/perl
package My::Module; # saved as My/Module.pm
use strict;
use warnings;
use Exporter;
our @ISA = 'Exporter';
our @EXPORT = qw(@a @b);
our (@a, @b);
@a = 1..3;
@b = "a".."c";
and then to use the module:
#!/usr/bin/perl
use strict;
use warnings;
use My::Module; # imports / declares the two variables
print @a;
print @b;
That use line actually means:
BEGIN {
require "My/Module.pm";
My::Module->import();
}
The import method comes from Exporter. When it is called, it will export the variables in the @EXPORT array into the calling code.
SOURCE: STOCKOVERFLOW
They will share global variables, yes. Are you seeing some problem with that?
Example:
first.pl:
#!/usr/bin/perl
use strict;
use warnings;
our (@a, @b);
@a = 1..3;
@b = "a".."c";
second.pl:
#!/usr/bin/perl
use strict;
use warnings;
require "first.pl";
our (@a,@b);
print @a;
print @b;
Giving:
$ perl second.pl
123abc
Method 2:
#!/usr/bin/perl
package My::Module; # saved as My/Module.pm
use strict;
use warnings;
use Exporter;
our @ISA = 'Exporter';
our @EXPORT = qw(@a @b);
our (@a, @b);
@a = 1..3;
@b = "a".."c";
and then to use the module:
#!/usr/bin/perl
use strict;
use warnings;
use My::Module; # imports / declares the two variables
print @a;
print @b;
That use line actually means:
BEGIN {
require "My/Module.pm";
My::Module->import();
}
The import method comes from Exporter. When it is called, it will export the variables in the @EXPORT array into the calling code.
To get the index of an array element
my @array = qw(a b b c);
my %hash;
@hash{ @array } = 0..$#array;
print $hash{b}; # 1
my %hash;
@hash{ @array } = 0..$#array;
print $hash{b}; # 1
SOURCE: http://stackoverflow.com
Using the Perl split() function---Splitting into a hash
Introduction
The
split() function is used to split a string into smaller sections. You can split a string on a single character, a group of characers or a regular expression (a pattern). You can also specify how many pieces to split the string into. This is better explained in the examples below.
Example 1. Splitting on a character
A common use of
split() is when parsing data from a file or from another program. In this example, we will split the string on the comma ','. Note that you typically should not use split() to parse CSV (comma separated value) files in case there are commas in your data: use Text::CSV instead. #!/usr/bin/perl
use strict;
use warnings;
my $data = 'Becky Alcorn,25,female,Melbourne';
my @values = split(',', $data);
foreach my $val (@values) {
print "$val\n";
}
exit 0; This program produces the following output:
Becky Alcorn 25 female Melbourne
Example 2. Splitting on a string
In the same way you use a character to split, you can use a string. In this example, the data is separated by three tildas '~~~'.
#!/usr/bin/perl
use strict;
use warnings;
my $data = 'Bob the Builder~~~10:30am~~~1,6~~~ABC';
my @values = split('~~~', $data);
foreach my $val (@values) {
print "$val\n";
}
exit 0; This outputs:
Bob the Builder 10:30am 1,6 ABC
Example 3. Splitting on a pattern
In some cases, you may want to split the string on a pattern (regular expression) or a type of character. We'll assume here that you know a little about regular expressions. In this example we will split on any integer:
#!/usr/bin/perl
use strict;
use warnings;
my $data = 'Home1Work2Cafe3Work4Home';
# \d+ matches one or more integer numbers
my @values = split(/\d+/, $data);
foreach my $val (@values) {
print "$val\n";
}
exit 0; The output of this program is:
Home Work Cafe Work Home
Example 4. Splitting on an undefined value
If you split on an undefined value, the string will be split on every character:
#!/usr/bin/perl
use strict;
use warnings;
my $data = 'Becky Alcorn';
my @values = split(undef,$data);
foreach my $val (@values) {
print "$val\n";
}
exit 0; The results of this program are:
B e c k y A l c o r n
Example 5. Splitting on a space
If you use a space ' ' to split on, it will actually split on any kind of space including newlines and tabs (regular expression /\s+/) rather than just a space. In this example we print 'aa' either side of the values so we can see where the split took place:
#!/usr/bin/perl
use strict;
use warnings;
my $data = "Becky\n\nAlcorn";
my @values = split(' ',$data);
# Print 'aa' either side of the value, so we can see # where it split
foreach my $val (@values) {
print "aa${val}aa\n";
}
exit 0; This produces:
aaBeckyaa aaAlcornaa
As you can see, it has split on the newlines that were in our data. If you really want to split on a space, use regular expressions:
my @values = split(/ /,$data);
Example 6. Delimiter at the start of the string
If the delimiter is at the start of the string then the first element in the array of results will be empty. We'll print fixed text with each line so that you can see the blank one:
#!/usr/bin/perl
use strict;
use warnings;
my $data = ',test,data';
my @values = split(',',$data);
# We print "Val: " with each line so that you can # see the blank one
foreach my $val (@values) {
print "Val: $val\n";
}
exit 0; The output of this program is:
Val: Val: test Val: data
Example 7. Split and context
If you do not pass in a string to split, then
split() will use $_. If you do not pass an expression or string to split on, then split() will use ' ': #!/usr/bin/perl
use strict;
use warnings;
foreach ('Bob the Builder', 'Thomas the TankEngine', 'B1 and B2') {
my @values = split;
print "Split $_:\n";
foreach my $val (@values) {
print " $val\n";
}
}
exit 0; This produces:
Split Bob the Builder:
Bob
the
Builder
Split Thomas the TankEngine:
Thomas
the
TankEngine
Split B1 and B2:
B1
and
B2Example 8. Limiting the split
You can limit the number of sections the string will be split into. You can do this by passing in a positive integer as the third argument. In this example, we're splitting our data into 3 fields - even though there are 4 occurrances of the delimiter:
#!/usr/bin/perl
use strict;
use warnings;
my $data = 'Becky Alcorn,25,female,Melbourne';
my @values = split(',', $data, 3);
foreach my $val (@values) {
print "$val\n";
}
exit 0; This program produces:
Becky Alcorn 25 female,Melbourne
Example 9. Keeping the delimiter
Sometimes, when splitting on a pattern, you want the delimiter in the result of the split. You can do this by capturing the characters you want to keep inside parenthesis. Let's do our regular expression example again, but this time we'll keep the numbers in the result:
#!/usr/bin/perl use strict; use warnings; my $data = 'Home1Work2Cafe3Work4Home'; # \d+ matches one or more integer numbers # The parenthesis () mean we keep the
# digits we match
my @values = split(/(\d+)/, $data);
foreach my $val (@values) {
print "$val\n";
}
exit 0; The output is:
Home 1 Work 2 Cafe 3 Work 4 Home
Example 10. Splitting into a hash
If you know a bit about your data, you could split it directly into a hash instead of an array:
#!/usr/bin/perl
use strict;
use warnings;
my $data = 'FIRSTFIELD=1;SECONDFIELD=2;THIRDFIELD=3';
my %values = split(/[=;]/, $data);
foreach my $k (keys %values) {
print "$k: $values{$k}\n";
}
exit 0; The output of this program is:
FIRSTFIELD: 1 THIRDFIELD: 3 SECONDFIELD: 2
The problem is that if the data does not contain exactly what you think, for example
FIRSTFIELD=1;SECONDFIELD=2;THIRDFIELD= then you will get an 'Odd number of elements in hash assignment' warning. Here is the output of the same program but with this new data: Odd number of elements in hash assignment
at ./test.pl line 8. FIRSTFIELD: 1 Use of uninitialized value in concatenation (.)
or string at ./test.pl line 11. THIRDFIELD: SECONDFIELD: 2
SOURCE: http://perlmeme.org/howtos/perlfunc/split_function.html
Tuesday, December 28, 2010
HASH
Hashes
Introduction
%age = ( "Nat", 24,
"Jules", 25,
"Josh", 17 );
$age{"Nat"} = 24;
$age{"Jules"} = 25;
$age{"Josh"} = 17;
%food_color = (
"Apple" => "red",
"Banana" => "yellow",
"Lemon" => "yellow",
"Carrot" => "orange"
);
%food_color = (
Apple => "red",
Banana => "yellow",
Lemon => "yellow",
Carrot => "orange"
);
Adding an Element to a Hash
$HASH{$KEY} = $VALUE;
# %food_color defined per the introduction
$food_color{Raspberry} = "pink";
print "Known foods:\n";
foreach $food (keys %food_color) {
print "$food\n";
}
# Known foods:
# Banana
# Apple
# Raspberry
# Carrot
# Lemon
Testing for the Presence of a Key in a Hash
# does %HASH have a value for $KEY ?
if (exists($HASH{$KEY})) {
# it exists
} else {
# it doesn't
}
# %food_color per the introduction
foreach $name ("Banana", "Martini") {
if (exists $food_color{$name}) {
print "$name is a food.\n";
} else {
print "$name is a drink.\n";
}
}
# Banana is a food.
# Martini is a drink.
%age = ();
$age{"Toddler"} = 3;
$age{"Unborn"} = 0;
$age{"Phantasm"} = undef;
foreach $thing ("Toddler", "Unborn", "Phantasm", "Relic") {
print "$thing: ";
print "Exists " if exists $age{$thing};
print "Defined " if defined $age{$thing};
print "True " if $age{$thing};
print "\n";
}
# Toddler: Exists Defined True
# Unborn: Exists Defined
# Phantasm: Exists
# Relic:
%size = ();
while (<>) {
chomp;
next if $size{$_}; # WRONG attempt to skip
$size{$_} = -s $_;
}
next if exists $size{$_};
Deleting from a Hash
# remove $KEY and its value from %HASH
delete($HASH{$KEY});
# %food_color as per Introduction
sub print_foods {
my @foods = keys %food_color;
my $food;
print "Keys: @foods\n";
print "Values: ";
foreach $food (@foods) {
my $color = $food_color{$food};
if (defined $color) {
print "$color ";
} else {
print "(undef) ";
}
}
print "\n";
}
print "Initially:\n";
print_foods();
print "\nWith Banana undef\n";
undef $food_color{"Banana"};
print_foods();
print "\nWith Banana deleted\n";
delete $food_color{"Banana"};
print_foods();
# Initially:
# Keys: Banana Apple Carrot Lemon
# Values: yellow red orange yellow
# With Banana undef
# Keys: Banana Apple Carrot Lemon
# Values: (undef) red orange yellow
# With Banana deleted
# Keys: Apple Carrot Lemon
# Values: red orange yellow
delete @food_color{"Banana", "Apple", "Cabbage"};
Traversing a Hash
while(($key, $value) = each(%HASH)) {
# do something with $key and $value
}
foreach $key (keys %HASH) {
$value = $HASH{$key};
# do something with $key and $value
}
# %food_color per the introduction
while(($food, $color) = each(%food_color)) {
print "$food is $color.\n";
}
# Banana is yellow.
#
# Apple is red.
#
# Carrot is orange.
#
# Lemon is yellow.
foreach $food (keys %food_color) {
my $color = $food_color{$food};
print "$food is $color.\n";
}
# Banana is yellow.
#
# Apple is red.
#
# Carrot is orange.
#
# Lemon is yellow.
print
"$food
is
$food_color{$food}.\n"
foreach $food (sort keys %food_color) {
print "$food is $food_color{$food}.\n";
}
# Apple is red.
#
# Banana is yellow.
#
# Carrot is orange.
#
# Lemon is yellow.
while ( ($k,$v) = each %food_color ) {
print "Processing $k\n";
keys %food_color; # goes back to the start of %food_color
}
# download the following standalone program
#!/usr/bin/perl
# countfrom - count number of messages from each sender
$filename = $ARGV[0] || "-";
open(FILE, "<$filename") or die "Can't open $filename : $!";
while(<FILE>) {
if (/^From: (.*)/) { $from{$1}++ }
}
foreach $person (sort keys %from) {
print "$person: $from{$person}\n";
}
Printing a Hash
while ( ($k,$v) = each %hash ) {
print "$k => $v\n";
}
print map { "$_ => $hash{$_}\n" } keys %hash;
print "@{[ %hash ]}\n";
{
my @temp = %hash;
print "@temp";
}
foreach $k (sort keys %hash) {
print "$k => $hash{$k}\n";
}
Retrieving from a Hash in Insertion Order
use Tie::IxHash;
tie %HASH, "Tie::IxHash";
# manipulate %HASH
@keys = keys %HASH; # @keys is in insertion order
# initialize
use Tie::IxHash;
tie %food_color, "Tie::IxHash";
$food_color{Banana} = "Yellow";
$food_color{Apple} = "Green";
$food_color{Lemon} = "Yellow";
print "In insertion order, the foods are:\n";
foreach $food (keys %food_color) {
print " $food\n";
}
print "Still in insertion order, the foods' colors are:\n";
while (( $food, $color ) = each %food_color ) {
print "$food is colored $color.\n";
}
#In insertion order, the foods are:
#
# Banana
#
# Apple
#
# Lemon
#
#Still in insertion order, the foods' colors are:
#
#Banana is colored Yellow.
#
#Apple is colored Green.
#
#Lemon is colored Yellow.
Hashes with Multiple Values Per Key
%ttys = ();
open(WHO, "who|") or die "can't open who: $!";
while (<WHO>) {
($user, $tty) = split;
push( @{$ttys{$user}}, $tty );
}
foreach $user (sort keys %ttys) {
print "$user: @{$ttys{$user}}\n";
}
foreach $user (sort keys %ttys) {
print "$user: ", scalar( @{$ttys{$user}} ), " ttys.\n";
foreach $tty (sort @{$ttys{$user}}) {
@stat = stat("/dev/$tty");
$user = @stat ? ( getpwuid($stat[4]) )[0] : "(not available)";
print "\t$tty (owned by $user)\n";
}
}
sub multihash_delete {
my ($hash, $key, $value) = @_;
my $i;
return unless ref( $hash->{$key} );
for ($i = 0; $i < @{ $hash->{$key} }; $i++) {
if ($hash->{$key}->[$i] eq $value) {
splice( @{$hash->{$key}}, $i, 1);
last;
}
}
delete $hash->{$key} unless @{$hash->{$key}};
}
Inverting a Hash
# %LOOKUP maps keys to values
%REVERSE = reverse %LOOKUP;
%surname = ( "Mickey" => "Mantle", "Babe" => "Ruth" );
%first_name = reverse %surname;
print $first_name{"Mantle"}, "\n";
Mickey
("Mickey", "Mantle", "Babe", "Ruth")
("Ruth", "Babe", "Mantle", "Mickey")
("Ruth" => "Babe", "Mantle" => "Mickey")
# download the following standalone program
#!/usr/bin/perl -w
# foodfind - find match for food or color
$given = shift @ARGV or die "usage: foodfind food_or_color\n";
%color = (
"Apple" => "red",
"Banana" => "yellow",
"Lemon" => "yellow",
"Carrot" => "orange"
);
%food = reverse %color;
if (exists $color{$given}) {
print "$given is a food with color $color{$given}.\n";
}
if (exists $food{$given}) {
print "$food{$given} is a food with color $given.\n";
}
# %food_color as per the introduction
while (($food,$color) = each(%food_color)) {
push(@{$foods_with_color{$color}}, $food);
}
print "@{$foods_with_color{yellow}} were yellow foods.\n";
# Banana Lemon were yellow foods.
Sorting a Hash
# %HASH is the hash to sort
@keys = sort { criterion() } (keys %hash);
foreach $key (@keys) {
$value = $hash{$key};
# do something with $key, $value
}
foreach $food (sort keys %food_color) {
print "$food is $food_color{$food}.\n";
}
foreach $food (sort { $food_color{$a} cmp $food_color{$b} }
keys %food_color)
{
print "$food is $food_color{$food}.\n";
}
@foods = sort { length($food_color{$a}) <=> length($food_color{$b}) }
keys %food_color;
foreach $food (@foods) {
print "$food is $food_color{$food}.\n";
}
Merging Hashes
%merged = (%A, %B);
%merged = ();
while ( ($k,$v) = each(%A) ) {
$merged{$k} = $v;
}
while ( ($k,$v) = each(%B) ) {
$merged{$k} = $v;
}
# %food_color as per the introduction
%drink_color = ( Galliano => "yellow",
"Mai Tai" => "blue" );
%ingested_color = (%drink_color, %food_color);
# %food_color per the introduction, then
%drink_color = ( Galliano => "yellow",
"Mai Tai" => "blue" );
%substance_color = ();
while (($k, $v) = each %food_color) {
$substance_color{$k} = $v;
}
while (($k, $v) = each %drink_color) {
$substance_color{$k} = $v;
}
foreach $substanceref ( \%food_color, \%drink_color ) {
while (($k, $v) = each %$substanceref) {
$substance_color{$k} = $v;
}
}
foreach $substanceref ( \%food_color, \%drink_color ) {
while (($k, $v) = each %$substanceref) {
if (exists $substance_color{$k}) {
print "Warning: $k seen twice. Using the first definition.\n";
next;
}
$substance_color{$k} = $v;
}
}
@all_colors{keys %new_colors} = values %new_colors;
Finding Common or Different Keys in Two Hashes
my @common = ();
foreach (keys %hash1) {
push(@common, $_) if exists $hash2{$_};
}
# @common now contains common keys
my @this_not_that = ();
foreach (keys %hash1) {
push(@this_not_that, $_) unless exists $hash2{$_};
}
# %food_color per the introduction
# %citrus_color is a hash mapping citrus food name to its color.
%citrus_color = ( Lemon => "yellow",
Orange => "orange",
Lime => "green" );
# build up a list of non-citrus foods
@non_citrus = ();
foreach (keys %food_color) {
push (@non_citrus, $_) unless exists $citrus_color{$_};
}
Hashing References
use Tie::RefHash;
tie %hash, "Tie::RefHash";
# you may now use references as the keys to %hash
# Class::Somewhere=HASH(0x72048)
#
# ARRAY(0x72048)
use Tie::RefHash;
use IO::File;
tie %name, "Tie::RefHash";
foreach $filename ("/etc/termcap", "/vmunix", "/bin/cat") {
$fh = IO::File->new("< $filename") or next;
$name{$fh} = $filename;
}
print "open files: ", join(", ", values %name), "\n";
foreach $file (keys %name) {
seek($file, 0, 2); # seek to the end
printf("%s is %d bytes long.\n", $name{$file}, tell($file));
}
Presizing a Hash
# presize %hash to $num
keys(%hash) = $num;
# will have 512 users in %users
keys(%users) = 512;
keys(%users) = 1000;
Finding the Most Common Anything
%count = ();
foreach $element (@ARRAY) {
$count{$element}++;
}
Representing Relationships Between Data
%father = ( 'Cain' => 'Adam',
'Abel' => 'Adam',
'Seth' => 'Adam',
'Enoch' => 'Cain',
'Irad' => 'Enoch',
'Mehujael' => 'Irad',
'Methusael' => 'Mehujael',
'Lamech' => 'Methusael',
'Jabal' => 'Lamech',
'Jubal' => 'Lamech',
'Tubalcain' => 'Lamech',
'Enos' => 'Seth' );
while (<>) {
chomp;
do {
print "$_ "; # print the current name
$_ = $father{$_}; # set $_ to $_'s father
} while defined; # until we run out of fathers
print "\n";
}
while ( ($k,$v) = each %father ) {
push( @{ $children{$v} }, $k );
}
$" = ', '; # separate output with commas
while (<>) {
chomp;
if ($children{$_}) {
@children = @{$children{$_}};
} else {
@children = "nobody";
}
print "$_ begat @children.\n";
}
foreach $file (@files) {
local *F; # just in case we want a local FH
unless (open (F, "<$file")) {
warn "Couldn't read $file: $!; skipping.\n";
next;
}
while (<F>) {
next unless /^\s*#\s*include\s*<([^>]+)>/;
push(@{$includes{$1}}, $file);
}
close F;
}
@include_free = (); # list of files that don't include others
@uniq{map { @$_ } values %includes} = undef;
foreach $file (sort keys %uniq) {
push( @include_free , $file ) unless $includes{$file};
}
Program: dutree
#% du pcb
#19 pcb/fix
#
#20 pcb/rev/maybe/yes
#
#10 pcb/rev/maybe/not
#
#705 pcb/rev/maybe
#
#54 pcb/rev/web
#
#1371 pcb/rev
#
#3 pcb/pending/mine
#
#1016 pcb/pending
#
#2412 pcb
#2412 pcb
#
#
#|
# 1371 rev
#
#
#| |
# 705 maybe
#
#
#| | |
# 675 .
#
#
#| | |
# 20 yes
#
#
#| | |
# 10 not
#
#
#| |
# 612 .
#
#
#| |
# 54 web
#
#
#|
# 1016 pending
#
#
#| |
# 1013 .
#
#
#| |
# 3 mine
#
#
#|
# 19 fix
#
#
#|
# 6 .
#% dutree
#% dutree /usr
#% dutree -a
#% dutree -a /bin
# download the following standalone program
#!/usr/bin/perl -w
# dutree - print sorted indented rendition of du output
use strict;
my %Dirsize;
my %Kids;
getdots(my $topdir = input());
output($topdir);
# run du, read in input, save sizes and kids
# return last directory (file?) read
sub input {
my($size, $name, $parent);
@ARGV = ("du @ARGV |"); # prep the arguments
while (<>) { # magic open is our friend
($size, $name) = split;
$Dirsize{$name} = $size;
($parent = $name) =~ s#/[^/]+$##; # dirname
push @{ $Kids{$parent} }, $name unless eof;
}
return $name;
}
# figure out how much is taken up in each directory
# that isn't stored in subdirectories. add a new
# fake kid called "." containing that much.
sub getdots {
my $root = $_[0];
my($size, $cursize);
$size = $cursize = $Dirsize{$root};
if ($Kids{$root}) {
for my $kid (@{ $Kids{$root} }) {
$cursize -= $Dirsize{$kid};
getdots($kid);
}
}
if ($size != $cursize) {
my $dot = "$root/.";
$Dirsize{$dot} = $cursize;
push @{ $Kids{$root} }, $dot;
}
}
# recursively output everything,
# passing padding and number width in as well
# on recursive calls
sub output {
my($root, $prefix, $width) = (shift, shift || '', shift || 0);
my $path;
($path = $root) =~ s#.*/##; # basename
my $size = $Dirsize{$root};
my $line = sprintf("%${width}d %s", $size, $path);
print $prefix, $line, "\n";
for ($prefix .= $line) { # build up more output
s/\d /| /;
s/[^|]/ /g;
}
if ($Kids{$root}) { # not a bachelor node
my @Kids = @{ $Kids{$root} };
@Kids = sort { $Dirsize{$b} <=> $Dirsize{$a} } @Kids;
$Dirsize{$Kids[0]} =~ /(\d+)/;
my $width = length $1;
for my $kid (@Kids) { output($kid, $prefix, $width) }
}
}
# download the following standalone program
#!/usr/bin/perl
# dutree_orig: the old version pre-perl5 (early 90s)
@lines = `du @ARGV`;
chop(@lines);
&input($top = pop @lines);
&output($top);
exit;
sub input {
local($root, *kid, $him) = @_[0,0];
while (@lines && &childof($root, $lines[$#lines])) {
&input($him = pop(@lines));
push(@kid, $him);
i}
if (@kid) {
local($mysize) = ($root =~ /^(\d+)/);
for (@kid) { $mysize -= (/^(\d+)/)[0]; }
push(@kid, "$mysize .") if $size != $mysize;
}
@kid = &sizesort(*kid);
}
sub output {
local($root, *kid, $prefix) = @_[0,0,1];
local($size, $path) = split(' ', $root);
$path =~ s!.*/!!;
$line = sprintf("%${width}d %s", $size, $path);
print $prefix, $line, "\n";
$prefix .= $line;
$prefix =~ s/\d /| /;
$prefix =~ s/[^|]/ /g;
local($width) = $kid[0] =~ /(\d+)/ && length("$1");
for (@kid) { &output($_, $prefix); };
}
sub sizesort {
local(*list, @index) = shift;
sub bynum { $index[$b] <=> $index[$a]; }
for (@list) { push(@index, /(\d+)/); }
@list[sort bynum 0..$#list];
}
sub childof {
local(@pair) = @_;
for (@pair) { s/^\d+\s+//g; s/$/\//; }
index($pair[1], $pair[0]) >= 0;
}
SOURCE: http://pleac.sourceforge.net/pleac_perl/index.html
Introduction
%age = ( "Nat", 24,
"Jules", 25,
"Josh", 17 );
$age{"Nat"} = 24;
$age{"Jules"} = 25;
$age{"Josh"} = 17;
%food_color = (
"Apple" => "red",
"Banana" => "yellow",
"Lemon" => "yellow",
"Carrot" => "orange"
);
%food_color = (
Apple => "red",
Banana => "yellow",
Lemon => "yellow",
Carrot => "orange"
);
Adding an Element to a Hash
$HASH{$KEY} = $VALUE;
# %food_color defined per the introduction
$food_color{Raspberry} = "pink";
print "Known foods:\n";
foreach $food (keys %food_color) {
print "$food\n";
}
# Known foods:
# Banana
# Apple
# Raspberry
# Carrot
# Lemon
Testing for the Presence of a Key in a Hash
# does %HASH have a value for $KEY ?
if (exists($HASH{$KEY})) {
# it exists
} else {
# it doesn't
}
# %food_color per the introduction
foreach $name ("Banana", "Martini") {
if (exists $food_color{$name}) {
print "$name is a food.\n";
} else {
print "$name is a drink.\n";
}
}
# Banana is a food.
# Martini is a drink.
%age = ();
$age{"Toddler"} = 3;
$age{"Unborn"} = 0;
$age{"Phantasm"} = undef;
foreach $thing ("Toddler", "Unborn", "Phantasm", "Relic") {
print "$thing: ";
print "Exists " if exists $age{$thing};
print "Defined " if defined $age{$thing};
print "True " if $age{$thing};
print "\n";
}
# Toddler: Exists Defined True
# Unborn: Exists Defined
# Phantasm: Exists
# Relic:
%size = ();
while (<>) {
chomp;
next if $size{$_}; # WRONG attempt to skip
$size{$_} = -s $_;
}
next if exists $size{$_};
Deleting from a Hash
# remove $KEY and its value from %HASH
delete($HASH{$KEY});
# %food_color as per Introduction
sub print_foods {
my @foods = keys %food_color;
my $food;
print "Keys: @foods\n";
print "Values: ";
foreach $food (@foods) {
my $color = $food_color{$food};
if (defined $color) {
print "$color ";
} else {
print "(undef) ";
}
}
print "\n";
}
print "Initially:\n";
print_foods();
print "\nWith Banana undef\n";
undef $food_color{"Banana"};
print_foods();
print "\nWith Banana deleted\n";
delete $food_color{"Banana"};
print_foods();
# Initially:
# Keys: Banana Apple Carrot Lemon
# Values: yellow red orange yellow
# With Banana undef
# Keys: Banana Apple Carrot Lemon
# Values: (undef) red orange yellow
# With Banana deleted
# Keys: Apple Carrot Lemon
# Values: red orange yellow
delete @food_color{"Banana", "Apple", "Cabbage"};
Traversing a Hash
while(($key, $value) = each(%HASH)) {
# do something with $key and $value
}
foreach $key (keys %HASH) {
$value = $HASH{$key};
# do something with $key and $value
}
# %food_color per the introduction
while(($food, $color) = each(%food_color)) {
print "$food is $color.\n";
}
# Banana is yellow.
#
# Apple is red.
#
# Carrot is orange.
#
# Lemon is yellow.
foreach $food (keys %food_color) {
my $color = $food_color{$food};
print "$food is $color.\n";
}
# Banana is yellow.
#
# Apple is red.
#
# Carrot is orange.
#
# Lemon is yellow.
"$food
is
$food_color{$food}.\n"
foreach $food (sort keys %food_color) {
print "$food is $food_color{$food}.\n";
}
# Apple is red.
#
# Banana is yellow.
#
# Carrot is orange.
#
# Lemon is yellow.
while ( ($k,$v) = each %food_color ) {
print "Processing $k\n";
keys %food_color; # goes back to the start of %food_color
}
# download the following standalone program
#!/usr/bin/perl
# countfrom - count number of messages from each sender
$filename = $ARGV[0] || "-";
open(FILE, "<$filename") or die "Can't open $filename : $!";
while(<FILE>) {
if (/^From: (.*)/) { $from{$1}++ }
}
foreach $person (sort keys %from) {
print "$person: $from{$person}\n";
}
Printing a Hash
while ( ($k,$v) = each %hash ) {
print "$k => $v\n";
}
print map { "$_ => $hash{$_}\n" } keys %hash;
print "@{[ %hash ]}\n";
{
my @temp = %hash;
print "@temp";
}
foreach $k (sort keys %hash) {
print "$k => $hash{$k}\n";
}
Retrieving from a Hash in Insertion Order
use Tie::IxHash;
tie %HASH, "Tie::IxHash";
# manipulate %HASH
@keys = keys %HASH; # @keys is in insertion order
# initialize
use Tie::IxHash;
tie %food_color, "Tie::IxHash";
$food_color{Banana} = "Yellow";
$food_color{Apple} = "Green";
$food_color{Lemon} = "Yellow";
print "In insertion order, the foods are:\n";
foreach $food (keys %food_color) {
print " $food\n";
}
print "Still in insertion order, the foods' colors are:\n";
while (( $food, $color ) = each %food_color ) {
print "$food is colored $color.\n";
}
#In insertion order, the foods are:
#
# Banana
#
# Apple
#
# Lemon
#
#Still in insertion order, the foods' colors are:
#
#Banana is colored Yellow.
#
#Apple is colored Green.
#
#Lemon is colored Yellow.
Hashes with Multiple Values Per Key
%ttys = ();
open(WHO, "who|") or die "can't open who: $!";
while (<WHO>) {
($user, $tty) = split;
push( @{$ttys{$user}}, $tty );
}
foreach $user (sort keys %ttys) {
print "$user: @{$ttys{$user}}\n";
}
foreach $user (sort keys %ttys) {
print "$user: ", scalar( @{$ttys{$user}} ), " ttys.\n";
foreach $tty (sort @{$ttys{$user}}) {
@stat = stat("/dev/$tty");
$user = @stat ? ( getpwuid($stat[4]) )[0] : "(not available)";
print "\t$tty (owned by $user)\n";
}
}
sub multihash_delete {
my ($hash, $key, $value) = @_;
my $i;
return unless ref( $hash->{$key} );
for ($i = 0; $i < @{ $hash->{$key} }; $i++) {
if ($hash->{$key}->[$i] eq $value) {
splice( @{$hash->{$key}}, $i, 1);
last;
}
}
delete $hash->{$key} unless @{$hash->{$key}};
}
Inverting a Hash
# %LOOKUP maps keys to values
%REVERSE = reverse %LOOKUP;
%surname = ( "Mickey" => "Mantle", "Babe" => "Ruth" );
%first_name = reverse %surname;
print $first_name{"Mantle"}, "\n";
Mickey
("Mickey", "Mantle", "Babe", "Ruth")
("Ruth", "Babe", "Mantle", "Mickey")
("Ruth" => "Babe", "Mantle" => "Mickey")
# download the following standalone program
#!/usr/bin/perl -w
# foodfind - find match for food or color
$given = shift @ARGV or die "usage: foodfind food_or_color\n";
%color = (
"Apple" => "red",
"Banana" => "yellow",
"Lemon" => "yellow",
"Carrot" => "orange"
);
%food = reverse %color;
if (exists $color{$given}) {
print "$given is a food with color $color{$given}.\n";
}
if (exists $food{$given}) {
print "$food{$given} is a food with color $given.\n";
}
# %food_color as per the introduction
while (($food,$color) = each(%food_color)) {
push(@{$foods_with_color{$color}}, $food);
}
print "@{$foods_with_color{yellow}} were yellow foods.\n";
# Banana Lemon were yellow foods.
Sorting a Hash
# %HASH is the hash to sort
@keys = sort { criterion() } (keys %hash);
foreach $key (@keys) {
$value = $hash{$key};
# do something with $key, $value
}
foreach $food (sort keys %food_color) {
print "$food is $food_color{$food}.\n";
}
foreach $food (sort { $food_color{$a} cmp $food_color{$b} }
keys %food_color)
{
print "$food is $food_color{$food}.\n";
}
@foods = sort { length($food_color{$a}) <=> length($food_color{$b}) }
keys %food_color;
foreach $food (@foods) {
print "$food is $food_color{$food}.\n";
}
Merging Hashes
%merged = (%A, %B);
%merged = ();
while ( ($k,$v) = each(%A) ) {
$merged{$k} = $v;
}
while ( ($k,$v) = each(%B) ) {
$merged{$k} = $v;
}
# %food_color as per the introduction
%drink_color = ( Galliano => "yellow",
"Mai Tai" => "blue" );
%ingested_color = (%drink_color, %food_color);
# %food_color per the introduction, then
%drink_color = ( Galliano => "yellow",
"Mai Tai" => "blue" );
%substance_color = ();
while (($k, $v) = each %food_color) {
$substance_color{$k} = $v;
}
while (($k, $v) = each %drink_color) {
$substance_color{$k} = $v;
}
foreach $substanceref ( \%food_color, \%drink_color ) {
while (($k, $v) = each %$substanceref) {
$substance_color{$k} = $v;
}
}
foreach $substanceref ( \%food_color, \%drink_color ) {
while (($k, $v) = each %$substanceref) {
if (exists $substance_color{$k}) {
print "Warning: $k seen twice. Using the first definition.\n";
next;
}
$substance_color{$k} = $v;
}
}
@all_colors{keys %new_colors} = values %new_colors;
Finding Common or Different Keys in Two Hashes
my @common = ();
foreach (keys %hash1) {
push(@common, $_) if exists $hash2{$_};
}
# @common now contains common keys
my @this_not_that = ();
foreach (keys %hash1) {
push(@this_not_that, $_) unless exists $hash2{$_};
}
# %food_color per the introduction
# %citrus_color is a hash mapping citrus food name to its color.
%citrus_color = ( Lemon => "yellow",
Orange => "orange",
Lime => "green" );
# build up a list of non-citrus foods
@non_citrus = ();
foreach (keys %food_color) {
push (@non_citrus, $_) unless exists $citrus_color{$_};
}
Hashing References
use Tie::RefHash;
tie %hash, "Tie::RefHash";
# you may now use references as the keys to %hash
# Class::Somewhere=HASH(0x72048)
#
# ARRAY(0x72048)
use Tie::RefHash;
use IO::File;
tie %name, "Tie::RefHash";
foreach $filename ("/etc/termcap", "/vmunix", "/bin/cat") {
$fh = IO::File->new("< $filename") or next;
$name{$fh} = $filename;
}
print "open files: ", join(", ", values %name), "\n";
foreach $file (keys %name) {
seek($file, 0, 2); # seek to the end
printf("%s is %d bytes long.\n", $name{$file}, tell($file));
}
Presizing a Hash
# presize %hash to $num
keys(%hash) = $num;
# will have 512 users in %users
keys(%users) = 512;
keys(%users) = 1000;
Finding the Most Common Anything
%count = ();
foreach $element (@ARRAY) {
$count{$element}++;
}
Representing Relationships Between Data
%father = ( 'Cain' => 'Adam',
'Abel' => 'Adam',
'Seth' => 'Adam',
'Enoch' => 'Cain',
'Irad' => 'Enoch',
'Mehujael' => 'Irad',
'Methusael' => 'Mehujael',
'Lamech' => 'Methusael',
'Jabal' => 'Lamech',
'Jubal' => 'Lamech',
'Tubalcain' => 'Lamech',
'Enos' => 'Seth' );
while (<>) {
chomp;
do {
print "$_ "; # print the current name
$_ = $father{$_}; # set $_ to $_'s father
} while defined; # until we run out of fathers
print "\n";
}
while ( ($k,$v) = each %father ) {
push( @{ $children{$v} }, $k );
}
$" = ', '; # separate output with commas
while (<>) {
chomp;
if ($children{$_}) {
@children = @{$children{$_}};
} else {
@children = "nobody";
}
print "$_ begat @children.\n";
}
foreach $file (@files) {
local *F; # just in case we want a local FH
unless (open (F, "<$file")) {
warn "Couldn't read $file: $!; skipping.\n";
next;
}
while (<F>) {
next unless /^\s*#\s*include\s*<([^>]+)>/;
push(@{$includes{$1}}, $file);
}
close F;
}
@include_free = (); # list of files that don't include others
@uniq{map { @$_ } values %includes} = undef;
foreach $file (sort keys %uniq) {
push( @include_free , $file ) unless $includes{$file};
}
Program: dutree
#% du pcb
#19 pcb/fix
#
#20 pcb/rev/maybe/yes
#
#10 pcb/rev/maybe/not
#
#705 pcb/rev/maybe
#
#54 pcb/rev/web
#
#1371 pcb/rev
#
#3 pcb/pending/mine
#
#1016 pcb/pending
#
#2412 pcb
#2412 pcb
#
#
#|
# 1371 rev
#
#
#| |
# 705 maybe
#
#
#| | |
# 675 .
#
#
#| | |
# 20 yes
#
#
#| | |
# 10 not
#
#
#| |
# 612 .
#
#
#| |
# 54 web
#
#
#|
# 1016 pending
#
#
#| |
# 1013 .
#
#
#| |
# 3 mine
#
#
#|
# 19 fix
#
#
#|
# 6 .
#% dutree
#% dutree /usr
#% dutree -a
#% dutree -a /bin
# download the following standalone program
#!/usr/bin/perl -w
# dutree - print sorted indented rendition of du output
use strict;
my %Dirsize;
my %Kids;
getdots(my $topdir = input());
output($topdir);
# run du, read in input, save sizes and kids
# return last directory (file?) read
sub input {
my($size, $name, $parent);
@ARGV = ("du @ARGV |"); # prep the arguments
while (<>) { # magic open is our friend
($size, $name) = split;
$Dirsize{$name} = $size;
($parent = $name) =~ s#/[^/]+$##; # dirname
push @{ $Kids{$parent} }, $name unless eof;
}
return $name;
}
# figure out how much is taken up in each directory
# that isn't stored in subdirectories. add a new
# fake kid called "." containing that much.
sub getdots {
my $root = $_[0];
my($size, $cursize);
$size = $cursize = $Dirsize{$root};
if ($Kids{$root}) {
for my $kid (@{ $Kids{$root} }) {
$cursize -= $Dirsize{$kid};
getdots($kid);
}
}
if ($size != $cursize) {
my $dot = "$root/.";
$Dirsize{$dot} = $cursize;
push @{ $Kids{$root} }, $dot;
}
}
# recursively output everything,
# passing padding and number width in as well
# on recursive calls
sub output {
my($root, $prefix, $width) = (shift, shift || '', shift || 0);
my $path;
($path = $root) =~ s#.*/##; # basename
my $size = $Dirsize{$root};
my $line = sprintf("%${width}d %s", $size, $path);
print $prefix, $line, "\n";
for ($prefix .= $line) { # build up more output
s/\d /| /;
s/[^|]/ /g;
}
if ($Kids{$root}) { # not a bachelor node
my @Kids = @{ $Kids{$root} };
@Kids = sort { $Dirsize{$b} <=> $Dirsize{$a} } @Kids;
$Dirsize{$Kids[0]} =~ /(\d+)/;
my $width = length $1;
for my $kid (@Kids) { output($kid, $prefix, $width) }
}
}
# download the following standalone program
#!/usr/bin/perl
# dutree_orig: the old version pre-perl5 (early 90s)
@lines = `du @ARGV`;
chop(@lines);
&input($top = pop @lines);
&output($top);
exit;
sub input {
local($root, *kid, $him) = @_[0,0];
while (@lines && &childof($root, $lines[$#lines])) {
&input($him = pop(@lines));
push(@kid, $him);
i}
if (@kid) {
local($mysize) = ($root =~ /^(\d+)/);
for (@kid) { $mysize -= (/^(\d+)/)[0]; }
push(@kid, "$mysize .") if $size != $mysize;
}
@kid = &sizesort(*kid);
}
sub output {
local($root, *kid, $prefix) = @_[0,0,1];
local($size, $path) = split(' ', $root);
$path =~ s!.*/!!;
$line = sprintf("%${width}d %s", $size, $path);
print $prefix, $line, "\n";
$prefix .= $line;
$prefix =~ s/\d /| /;
$prefix =~ s/[^|]/ /g;
local($width) = $kid[0] =~ /(\d+)/ && length("$1");
for (@kid) { &output($_, $prefix); };
}
sub sizesort {
local(*list, @index) = shift;
sub bynum { $index[$b] <=> $index[$a]; }
for (@list) { push(@index, /(\d+)/); }
@list[sort bynum 0..$#list];
}
sub childof {
local(@pair) = @_;
for (@pair) { s/^\d+\s+//g; s/$/\//; }
index($pair[1], $pair[0]) >= 0;
}
SOURCE: http://pleac.sourceforge.net/pleac_perl/index.html
Map function in perl
my @in = qw( Bu1s5ter Mi6mi Roscoe Gin98ger El123la );
my @out = map { s/\d+//g } @in;
print "in: @in\nout: @out\n";
#OUTPUT
#in: Buster Mimi Roscoe Ginger Ella
#out: 2 1 1 1
my @in = qw( Bu1s5ter Mi6mi Roscoe Gin98ger El123la );
my @out = map { my $s = $_; $s =~ s/\d+//g; $s } @in;
print "in: @in\nout: @out\n";
#OUPTUT
#in: Bu1s5ter Mi6mi Roscoe Gin98ger El123la
#out: Buster Mimi Roscoe Ginger Ella
SOURCE: http://www.effectiveperlprogramming.com/blog/659
my @out = map { s/\d+//g } @in;
print "in: @in\nout: @out\n";
#OUTPUT
#in: Buster Mimi Roscoe Ginger Ella
#out: 2 1 1 1
my @in = qw( Bu1s5ter Mi6mi Roscoe Gin98ger El123la );
my @out = map { my $s = $_; $s =~ s/\d+//g; $s } @in;
print "in: @in\nout: @out\n";
#OUPTUT
#in: Bu1s5ter Mi6mi Roscoe Gin98ger El123la
#out: Buster Mimi Roscoe Ginger Ella
SOURCE: http://www.effectiveperlprogramming.com/blog/659
Rename bunch of files
my @files = glob '*';
foreach (@files) {
if(/.pl/) {
($new = $_) =~ s/\.pl/\.plx/;
print "old: $_\nnew: $new\n\n";
rename $_ => $new;
}
}
foreach (@files) {
if(/.pl/) {
($new = $_) =~ s/\.pl/\.plx/;
print "old: $_\nnew: $new\n\n";
rename $_ => $new;
}
}
Use array references with the array operators in Perl
#Use array references with the array operators
my $ref = [ qw(Buster Mimi Ginger Ella) ];
sub get_dogs { [ qw(Nicki Addy) ] }
push @$ref, 'Addy';
print "Pets are @$ref\n";
my $dog = shift @{ get_dogs() };
print "Dog is $dog\n";
my $ref = [ qw(Buster Mimi Ginger Ella) ];
sub get_dogs { [ qw(Nicki Addy) ] }
push @$ref, 'Addy';
print "Pets are @$ref\n";
my $dog = shift @{ get_dogs() };
print "Dog is $dog\n";
XML::XPath in Perl
use strict;
use warnings;
use XML::XPath;
my $xpath = "//bookstore";
#my $xpath = "//book[last()]/price";
#my $xpath = "//book[price>35.00]";
#my $xpath = "//title|//price";
my $xml = <<'XMLDOC';
<?xml version="1.0" encoding="ISO-8859-1"?>
<bookstore>
<book>
<title lang="eng">Harry Potter</title>
<price>29.99</price>
</book>
<book>
<title lang="eng">Learning XML</title>
<price>39.95</price>
</book>
</bookstore>
XMLDOC
my $result = '';
my $xp = XML::XPath->new(xml => $xml);
for my $node ($xp->findnodes( $xpath )->get_nodelist) {
$result .= $node->getName . ": " . $node->string_value;
}
$result =~ s/^\s*$//gm;
print $result;
use warnings;
use XML::XPath;
my $xpath = "//bookstore";
#my $xpath = "//book[last()]/price";
#my $xpath = "//book[price>35.00]";
#my $xpath = "//title|//price";
my $xml = <<'XMLDOC';
<?xml version="1.0" encoding="ISO-8859-1"?>
<bookstore>
<book>
<title lang="eng">Harry Potter</title>
<price>29.99</price>
</book>
<book>
<title lang="eng">Learning XML</title>
<price>39.95</price>
</book>
</bookstore>
XMLDOC
my $result = '';
my $xp = XML::XPath->new(xml => $xml);
for my $node ($xp->findnodes( $xpath )->get_nodelist) {
$result .= $node->getName . ": " . $node->string_value;
}
$result =~ s/^\s*$//gm;
print $result;
17 ways to Optimize VBA Code for FASTER Macros
Here is a summary of the article:
1. Analyze the Logic
2. Turn off ScreenUpdating
3. Turn off 'Automatic Calculations'
4. Disable Events
5. Hide Page breaks
6. Use 'WITH' statement
7. Use vbNullString instead of ""
8. Release memory of Object variables
9. Reduce the number of lines using colon(:)
10. Prefer constants
11. Avoid Unnecessary Copy and Paste
12. Clear the Clipboard after Paste
13. Avoid 'Macro Recorder' style code.
14. Use 'For Each' than 'Indexed For'
15. Use 'Early Binding' rather 'Late Binding'
16. Avoid using Variant
17. Use Worksheet Functions wherever applicable
Analyze the logic: Before optimizing the syntax, pay more attention in optimizing the logic. Without a good logic, a good written VBA macro program has no value. So streamline your program logic and get the best performance of macros.
Avoid 'Screen Flickering' or 'Screen Repainting': Use
Application.ScreenUpdating = False 'To Turn Off at the start of code.
Application.ScreenUpdating = False 'To Turn on at the end of the code.
Turn off automatic calculations: Whenever content(s) of a cell or range of cells are changed, the formulas dependent on them and Volatile functions are recalculated. You may turn off the automatic calculation using
Application.Calculation = xlCalculationManual 'To turn off the automatic calculation
Application.Calculation = xlCalculationAutomatic 'To turn On the automatic calculation
Now, whenever due to the program logic(that due to macros dependent on existing formulas) you need to calculate the formulas, you may use the following code accordingly.
ActiveSheet.Calculate ' To calculate the formulas of Active Worksheet
Application.Calculate ' To calculate the formulas of Active workbook or all workbooks in current application.
Stop Events: Use Application.EnableEvents to tell VBA processor whether to fire events or not. We rarely fire an event for each cell we're changing via code. Hence, turning off events will speed up our VBA code performance.
Hide Page Breaks:When we run a Microsoft VBA macro in a later version of Microsoft Excel, the macro may take longer to complete than it does in earlier versions of Excel. For example, a macro that required several seconds to complete in an earlier version of Excel may require several minutes to complete in a later version of Excel. This problem may occur if the following conditions are true:
Refer to this Microsoft article for more details - http://support.microsoft.com/kb/199505
Use 'WITH' statement when working with objects: If we have to access an object's properties and methods in several lines, we must avoid using object's name or fully qualified object path again and again. It is annoying for VBA processor as it needs to fully qualify the object each time. (Isn't it annoying for us too when some work or something is told us again and again? Got it Guys !
The point here to understand is minimum qualifying of an object by VBA processor. i.e. using minimum dots/periods(.) in the code. This concept tells us to use [A1] rather than Range("A1") and Range("StockRange")(3,4) rather than Range("StockRange").Cells(3,4)
Use vbNullString instead of ""(2 double quotes) : vbNullString is slightly faster than "", since vbNullString is not actually a string, but a constant set to 0 bytes, whereas "" is a string consuming at least 4-6 bytes for just existence.
For example: Instead of strVariable = "", use strVariable = vbNullString.
Release memory from object variables: Whenever we create an object in VBA, we actually create two things -- an object, and a pointer (called an object reference). We might say, "VB does not use pointers", but it is not true. "VB does not let you manipulate pointers" is more precise. Behind the scenes, VB still makes extensive use of pointers. To destroy an object in VB, you set it to Nothing. But wait a minute. If all we ever use are object pointers, how can we set the object itself to Nothing? The answer is: We can't.
When we set a reference to Nothing, something called the garbage collector kicks in. This little piece of software tries to determine whether or not an object should be destroyed. There are many ways to implement a garbage collector, but Visual Basic uses what is called the reference count method.
When VB interprets the last line(where we generally sets our objects to Nothing), it will remove the existing reference. At this point, if the object has no more references, the garbage collector will destroy the object and deallocate all its resources. If any other references point to the same object, the object will not be destroyed.
Reduce the number of Lines: Avoid multiple statements especially when they can be clubbed into one line. For example - See these 2 macros
As you can see, you can club multiple statements into one using colon character(:). When you do this with multiple statements, it will decrease the readability but will increase the speed.
Compiler Logic: When we save the macro, it is virtually compiled and unlike it's human readable form as we saw in VBE(Visual Basic Editor), keywords(the dark blue words which you cannot use as variable) are saved as three-byte token which are faster to process as machine understand them better and variables, comments and literal strings which are not either keyword or directive are saved "as is". However VBA compiler tokenizes the word but it does not compress the lines and each line is maintained as is ending with the 'Carriage Return'. When the VBA macro is executed, VBA processor fetched single line at a time. The tokens of the fetched line saved by virtual compiler are now interpreted and executed then next line is fetched and so on. When we combine multiple lines using colon into one line, we're reducing the number of fetch cycles the processor must go through.
Our Suggestion: This change will bring minor difference in time due to faster processors today. Moreover, you cannot have more than 255 characters in a line and you won't be able to debug your code using F8 efficiently. So it's a kind of useless, there is no reason to trade-off with readability with such a minor change in time.
Declare variable as Variable and constant as Constant: Seems, obvious ! But many of us don't follow it. Like
Dim Pi As Double
Pi = 3.14159
instead use
Const Pi As Double
Pi = 3.14159
Since, its value is never changed so it will be evaluated once during compilation unlike variable which are evaluated many times during the run-time.
Avoid Unnecessary Copy and Paste: Follow this table rules:
Use Worksheet Functions rather developing own logic: By using Application.WorkSheetFunction, we tell VBA processor to use native code rather than interpreted code as VBA understands the worksheet functions better than your algorithm. So, for example use
mProduct = Application.WorkSheetFunction.Product(Range("C5:C10"))
rather than defining your own logic like this:
mProduct = 1
For i = 5 to 10
mProduct = mProduct * Cells(3,i)
Use 'For Each' rather than 'indexed For': We can avoid using Indexed For when looping through collections. For example, take the code just before this tip. It can be modified to:
For Each myCell in Range("C5:C10")
mProduct = mProduct * myCell.Value
Avoid using 'Macro Recorder' style code:Ya, the code will look genius and eventually perform like Genius too ! You'll better catch it with example, so use:
[A1].Interior.Color = vbRed
rather than
Range("A1").Select
Selection.Interior.Color = vbRed
Using too many Select and Selection effects the performance drastically. Ask yourself why to go in Cell and then change the properties? or rather ask why to go pizza shop when you can enjoy it at your home ;)
Avoid using Variant and Object in declaration statements: Think about better logic and get rid of them. i.e. do not use Dim i As Variant or Dim mCell As Object. By trying to be specific,we will save a lot of system memory this way, particularly in case of large projects. We may not remember which has been declared variant above and misuse a variable assigning any value to it which will be type-casted without errors. A variant's descriptor is 16 bytes long while double is 8 bytes, long is 4 bytes and integer is 2 bytes. Hence use Variant cautiously. As an example, use:
Dim i As Long rather than Dim i As Variant
Similarly use:
Dim mCell As Range 'or
Dim mSheet As Worksheet
rather than
Dim mCell As Object 'or
Dim mSheet As Object
Declare OLE objects directly: Declaring and defining the OLE objects in declaration statement is called 'Early Binding' but declaring an object and defining it later is called 'Late Binding'. Always prefer 'Early Binding' over 'Late Binding'. Now for example use:
Dim oXL As Excel.Application
rather than
Dim oXL As Object
Set oXL = CreateObject("Excel.Application")
Source: http://www.excelitems.com/2010/12/optimize-vba-code-for-faster-macros.html
1. Analyze the Logic
2. Turn off ScreenUpdating
3. Turn off 'Automatic Calculations'
4. Disable Events
5. Hide Page breaks
6. Use 'WITH' statement
7. Use vbNullString instead of ""
8. Release memory of Object variables
9. Reduce the number of lines using colon(:)
10. Prefer constants
11. Avoid Unnecessary Copy and Paste
12. Clear the Clipboard after Paste
13. Avoid 'Macro Recorder' style code.
14. Use 'For Each' than 'Indexed For'
15. Use 'Early Binding' rather 'Late Binding'
16. Avoid using Variant
17. Use Worksheet Functions wherever applicable
Analyze the logic: Before optimizing the syntax, pay more attention in optimizing the logic. Without a good logic, a good written VBA macro program has no value. So streamline your program logic and get the best performance of macros.
Avoid 'Screen Flickering' or 'Screen Repainting': Use
Application.ScreenUpdating = False 'To Turn Off at the start of code.
Application.ScreenUpdating = False 'To Turn on at the end of the code.
The ScreenUpdating property controls most display changes on the monitor while a procedure is running. When screen updating is turned off, toolbars remain visible and Word still allows the procedure to display or retrieve information using status bar prompts, input boxes, dialog boxes, and message boxes. You can increase the speed of some procedures by keeping screen updating turned off. You must set the ScreenUpdating property to True when the procedure finishes or when it stops after an error. Refer MSDN for details.
Turn off automatic calculations: Whenever content(s) of a cell or range of cells are changed, the formulas dependent on them and Volatile functions are recalculated. You may turn off the automatic calculation using
Application.Calculation = xlCalculationManual 'To turn off the automatic calculation
Application.Calculation = xlCalculationAutomatic 'To turn On the automatic calculation
Now, whenever due to the program logic(that due to macros dependent on existing formulas) you need to calculate the formulas, you may use the following code accordingly.
ActiveSheet.Calculate ' To calculate the formulas of Active Worksheet
Application.Calculate ' To calculate the formulas of Active workbook or all workbooks in current application.
Stop Events: Use Application.EnableEvents to tell VBA processor whether to fire events or not. We rarely fire an event for each cell we're changing via code. Hence, turning off events will speed up our VBA code performance.
Hide Page Breaks:When we run a Microsoft VBA macro in a later version of Microsoft Excel, the macro may take longer to complete than it does in earlier versions of Excel. For example, a macro that required several seconds to complete in an earlier version of Excel may require several minutes to complete in a later version of Excel. This problem may occur if the following conditions are true:
* The VBA macro modifies the properties of many rows or columns.Solution: is to disable Page breaks using ActiveSheet.DisplayPageBreaks = False
* An operation has been performed that forced Excel to calculate page breaks. Excel calculates page breaks when we perform any of the following operations:
o We display a print preview of your worksheet.* In Excel 2003 and in earlier versions of Excel, we selected the Page breaks check box on the View tab of the Options dialog box.
o In Microsoft Office Excel 2003 and in earlier versions of Excel, we click Page Setup on the File menu.
o We modify any of the properties of the PageSetup object in a VBA macro.
Refer to this Microsoft article for more details - http://support.microsoft.com/kb/199505
Use 'WITH' statement when working with objects: If we have to access an object's properties and methods in several lines, we must avoid using object's name or fully qualified object path again and again. It is annoying for VBA processor as it needs to fully qualify the object each time. (Isn't it annoying for us too when some work or something is told us again and again? Got it Guys !
SLOW MACRO | |
Sheets(1).Range("A1:E1").Font.Italic = True Sheets(1).Range("A1:E1").Font.Interior.Color = vbRed Sheets(1).Range("A1:E1").MergeCells = True | With Sheets(1).Range("A1:E1") .Font.Italic = True .Font.Interior.Color = vbRed .MergeCells = True End With |
Use vbNullString instead of ""(2 double quotes) : vbNullString is slightly faster than "", since vbNullString is not actually a string, but a constant set to 0 bytes, whereas "" is a string consuming at least 4-6 bytes for just existence.
For example: Instead of strVariable = "", use strVariable = vbNullString.
Release memory from object variables: Whenever we create an object in VBA, we actually create two things -- an object, and a pointer (called an object reference). We might say, "VB does not use pointers", but it is not true. "VB does not let you manipulate pointers" is more precise. Behind the scenes, VB still makes extensive use of pointers. To destroy an object in VB, you set it to Nothing. But wait a minute. If all we ever use are object pointers, how can we set the object itself to Nothing? The answer is: We can't.
When we set a reference to Nothing, something called the garbage collector kicks in. This little piece of software tries to determine whether or not an object should be destroyed. There are many ways to implement a garbage collector, but Visual Basic uses what is called the reference count method.
When VB interprets the last line(where we generally sets our objects to Nothing), it will remove the existing reference. At this point, if the object has no more references, the garbage collector will destroy the object and deallocate all its resources. If any other references point to the same object, the object will not be destroyed.
Reduce the number of Lines: Avoid multiple statements especially when they can be clubbed into one line. For example - See these 2 macros
SLOW MACRO With Selection .WrapText = True .ShrinkToFit = False End With | FAST MACRO With Selection .WrapText = True: .ShrinkToFit = False End With |
Compiler Logic: When we save the macro, it is virtually compiled and unlike it's human readable form as we saw in VBE(Visual Basic Editor), keywords(the dark blue words which you cannot use as variable) are saved as three-byte token which are faster to process as machine understand them better and variables, comments and literal strings which are not either keyword or directive are saved "as is". However VBA compiler tokenizes the word but it does not compress the lines and each line is maintained as is ending with the 'Carriage Return'. When the VBA macro is executed, VBA processor fetched single line at a time. The tokens of the fetched line saved by virtual compiler are now interpreted and executed then next line is fetched and so on. When we combine multiple lines using colon into one line, we're reducing the number of fetch cycles the processor must go through.
Our Suggestion: This change will bring minor difference in time due to faster processors today. Moreover, you cannot have more than 255 characters in a line and you won't be able to debug your code using F8 efficiently. So it's a kind of useless, there is no reason to trade-off with readability with such a minor change in time.
Declare variable as Variable and constant as Constant: Seems, obvious ! But many of us don't follow it. Like
Dim Pi As Double
Pi = 3.14159
instead use
Const Pi As Double
Pi = 3.14159
Since, its value is never changed so it will be evaluated once during compilation unlike variable which are evaluated many times during the run-time.
Avoid Unnecessary Copy and Paste: Follow this table rules:
| Instead of | Use this: |
| Sheet1.Range("A1:A200").Copy Sheet2.Range("B1").PasteSpecial Application.CutCopyMode = False 'Clear Clipboard | 'Bypass the Clipboard Sheet1.Range("A1:A200").Copy Destination:= Sheet2.Range("B1") |
| Sheet1.Range("A1:A200").Copy Sheet2.Range("B1").PasteSpecial xlPasteValues Application.CutCopyMode=False 'Clear Clipboard | 'Bypass the Clipboard if only values are required Sheet2.Range("B1:B200").Value = Sheet1.Range("A1:A200").Value |
| Sheet1.Range("A1:A200").Copy Sheet2.Range("B1").PasteSpecial xlPasteFormulas Application.CutCopyMode=False 'Clear Clipboard | 'Bypass the Clipboard if only formulas are required Sheet2.Range("B1:B200").Formula = Sheet1.Range("A1:A200").Formula 'Same can be done with FormulaR1C1 and Array Formulas. |
Use Worksheet Functions rather developing own logic: By using Application.WorkSheetFunction, we tell VBA processor to use native code rather than interpreted code as VBA understands the worksheet functions better than your algorithm. So, for example use
mProduct = Application.WorkSheetFunction.Product(Range("C5:C10"))
rather than defining your own logic like this:
mProduct = 1
For i = 5 to 10
mProduct = mProduct * Cells(3,i)
Next
Use 'For Each' rather than 'indexed For': We can avoid using Indexed For when looping through collections. For example, take the code just before this tip. It can be modified to:
For Each myCell in Range("C5:C10")
mProduct = mProduct * myCell.Value
Next
This is in relation to qualifying object again and again as using "WITH" statements.Avoid using 'Macro Recorder' style code:Ya, the code will look genius and eventually perform like Genius too ! You'll better catch it with example, so use:
[A1].Interior.Color = vbRed
rather than
Range("A1").Select
Selection.Interior.Color = vbRed
Using too many Select and Selection effects the performance drastically. Ask yourself why to go in Cell and then change the properties? or rather ask why to go pizza shop when you can enjoy it at your home ;)
Avoid using Variant and Object in declaration statements: Think about better logic and get rid of them. i.e. do not use Dim i As Variant or Dim mCell As Object. By trying to be specific,we will save a lot of system memory this way, particularly in case of large projects. We may not remember which has been declared variant above and misuse a variable assigning any value to it which will be type-casted without errors. A variant's descriptor is 16 bytes long while double is 8 bytes, long is 4 bytes and integer is 2 bytes. Hence use Variant cautiously. As an example, use:
Dim i As Long rather than Dim i As Variant
Similarly use:
Dim mCell As Range 'or
Dim mSheet As Worksheet
rather than
Dim mCell As Object 'or
Dim mSheet As Object
Declare OLE objects directly: Declaring and defining the OLE objects in declaration statement is called 'Early Binding' but declaring an object and defining it later is called 'Late Binding'. Always prefer 'Early Binding' over 'Late Binding'. Now for example use:
Dim oXL As Excel.Application
rather than
Dim oXL As Object
Set oXL = CreateObject("Excel.Application")
Source: http://www.excelitems.com/2010/12/optimize-vba-code-for-faster-macros.html
Subscribe to:
Posts (Atom)