$system = system(perl -MModule::Name -e1);
if(defined(@system)) {
print "Module Exists\n";
}
else
{
print "Module does not exists\n";
}
if(defined(@system)) {
print "Module Exists\n";
}
else
{
print "Module does not exists\n";
}
Sunday, January 30, 2011
tk button with url link
use strict;
use warnings;
use Tk;
my $url = 'http://google.com';
my $mw = tkinit;
my $link = $mw->Button(
-textvariable => \$url,
-fg => '#0000FF',
-relief => 'flat',
-command => sub{system('start', $url)}, )->pack;
MainLoop;
tk choose directory
use strict;
use warnings;
use Tk;
my $mw = tkinit;
my $Directory = $mw->chooseDirectory(
-title => "title",
-initialdir => "E:/Spoken/ENGLISH-FOR-LOW-LEVELS/ENGLISH-FOR-LOW-LEVELS",
-mustexist => 1,
);
MainLoop;
print $Directory;
use warnings;
use Tk;
my $mw = tkinit;
my $Directory = $mw->chooseDirectory(
-title => "title",
-initialdir => "E:/Spoken/ENGLISH-FOR-LOW-LEVELS/ENGLISH-FOR-LOW-LEVELS",
-mustexist => 1,
);
MainLoop;
print $Directory;
Saturday, January 29, 2011
perl: difference between use encoding 'utf8' and use utf8
`use utf8;` tells the compiler that the script is written
in UTF-8. That's all it does. `use encoding 'utf8'` tells it the srcipt is in UTF-8,
its literal strings are in UTF-8, and STDIN, STDOUT,
and DATA are in UTF-8.
$ perl -Mutf8 -e'print"\x{2022}\n";'
Wide character in print at -e line 1.
•
$ perl -Mencoding=utf8 -e'print"\x{2022}\n";'
•
find out odd or even element in array
@list = qw(a b c d e);
#to get even numbers
#method 1:
my $t = 1;
my @test = grep { $t^=1 } @list;
print "@test\n\n";
#Method 2:
@list = qw(a b c d e);
my $t = 1;
my @test = grep { $t = 1-$t } @list;
print "@test\n\n";
#Method 3:
my $t = 1;
my @test = grep { ++$t % 2 } @list;
print "@test\n\n";
#perl -le "$t=1; print grep { $t^=1 } qw( a b c d e );
#perl -le"@a = qw( a b c d e ); print map { $_%2 ? $a[$_] : () } 0..$#
#to get odd numbers
#method 1:
@list = qw(a b c d e);
my $t = 0;
my @array = grep { $t^=1 } @list;
print "@array";
#perl -le"$t=0; print grep { $t^=1 } qw( a b c d e );"
#to get even numbers
#method 1:
my $t = 1;
my @test = grep { $t^=1 } @list;
print "@test\n\n";
#Method 2:
@list = qw(a b c d e);
my $t = 1;
my @test = grep { $t = 1-$t } @list;
print "@test\n\n";
#Method 3:
my $t = 1;
my @test = grep { ++$t % 2 } @list;
print "@test\n\n";
#perl -le "$t=1; print grep { $t^=1 } qw( a b c d e );
#perl -le"@a = qw( a b c d e ); print map { $_%2 ? $a[$_] : () } 0..$#
#to get odd numbers
#method 1:
@list = qw(a b c d e);
my $t = 0;
my @array = grep { $t^=1 } @list;
print "@array";
#perl -le"$t=0; print grep { $t^=1 } qw( a b c d e );"
Sorting Hash of Arrays
|
convert html to pdf
#Add Module..
use PDF::FromHTML;
#Create object for that Module..
my $pdf = new PDF::FromHTML( encoding => 'utf-8' );
# Loading from a file..
$pdf->load_file('source.htm');
# Or from a scalar reference:
#$input = "<html><body>sample test<br><b>deiveegan</b></
# $pdf->load_file(\$input);
# Perform the actual conversion..
$pdf->convert(
Font => 'arial.ttf',
LineHeight => 18,
Landscape => 2,
);
# Write to a file:.
$pdf->write_file('Target.pdf')
# Or to a scalar reference:
# $pdf->write_file(\$output);
use PDF::FromHTML;
#Create object for that Module..
my $pdf = new PDF::FromHTML( encoding => 'utf-8' );
# Loading from a file..
$pdf->load_file('source.htm');
# Or from a scalar reference:
#$input = "<html><body>sample test<br><b>deiveegan</b></
# $pdf->load_file(\$input);
# Perform the actual conversion..
$pdf->convert(
Font => 'arial.ttf',
LineHeight => 18,
Landscape => 2,
);
# Write to a file:.
$pdf->write_file('Target.pdf')
# Or to a scalar reference:
# $pdf->write_file(\$output);
perl: get mismatch one array element into another array element
#!/usr/bin/perl -w
@content = (1,2,3,4,5,6,7,8,9,'a','b','c','d','e');
@alphabets = ('a','b','c','d','e','f','g','h');
# create a hash with elements of @alphabets as keys and assign them a value 1
%alpha_hash =();
foreach my $alpha (@alphabets)
{
$alpha_hash{$alpha} = 1;
}
foreach $elem (@content)
{
if(! $alpha_hash{$elem}) # it's not in %alpha_hash, so this is what we need
{
print $elem."\n"; #it is the one not present in $alphabets
}
}
@content = (1,2,3,4,5,6,7,8,9,'a','b','c','d','e');
@alphabets = ('a','b','c','d','e','f','g','h');
# create a hash with elements of @alphabets as keys and assign them a value 1
%alpha_hash =();
foreach my $alpha (@alphabets)
{
$alpha_hash{$alpha} = 1;
}
foreach $elem (@content)
{
if(! $alpha_hash{$elem}) # it's not in %alpha_hash, so this is what we need
{
print $elem."\n"; #it is the one not present in $alphabets
}
}
How to know if document exists on a URL in perl
use LWP::Simple;
$URL='http://www.expertsguide.info/';
if (head($URL))
{
print '$URL exists' ;
}
else
{
print 'URL does not contain anything';
}
head() function returns much more information eg, Content-type, document length, last modified time, expiry date and server name. Capture that using,
view sourceprint?
my @headers = head $URL;
print join "\n", @headers;
$URL='http://www.expertsguide.info/';
if (head($URL))
{
print '$URL exists' ;
}
else
{
print 'URL does not contain anything';
}
head() function returns much more information eg, Content-type, document length, last modified time, expiry date and server name. Capture that using,
view sourceprint?
my @headers = head $URL;
print join "\n", @headers;
Wednesday, January 26, 2011
How can I read in an entire file all at once
Are you sure you want to read the entire file and store it in memory?
If you map the file, you can virtually load the entire file into a string without actually storing it in memory:
use File::Map qw(map_file);
map_file my $string, $filename;
Once mapped, you can treat $string as you would any other string. Since you don't necessarily have to load the data, mmap-ing can be very fast and may not increase your memory footprint.
If you want to load the entire file, you can use the "File::Slurp" module to do it in one one simple and efficient step:
use File::Slurp;
my $all_of_it = read_file($filename); # entire file in scalar
my @all_lines = read_file($filename); # one line per element
The customary Perl approach for processing all the lines in a file is to
do so one line at a time:
open my $input, '<', $file or die "can't open $file: $!";
while (<$input>) {
chomp;
# do something with $_
}
close $input or die "can't close $file: $!";
This is tremendously more efficient than reading the entire file into memory as an array of lines and then processing it one element at a time, which is often--if not almost always--the wrong approach. Whenever you see someone do this:
my @lines = <INPUT>;
You should think long and hard about why you need everything loaded at once. It's just not a scalable solution. You might also find it more fun to use the standard "Tie::File" module, or the "DB_File" module's $DB_RECNO bindings, which allow you to tie an array to a file so that
accessing an element the array actually accesses the corresponding line in the file.
You can read the entire filehandle contents into a scalar.
my $var;
{
local $/;
open my $fh, '<', $file or die "can't open $file: $!";
$var = <$fh>;
}
That temporarily undefs your record separator, and will automatically close the file at block exit. If the file is already open, just use this:
my $var = do { local $/; <$fh> };
You can do that one better by using a localized @ARGV so you can eliminate the "open":
my $var = do { local( @ARGV, $/ ) = $file; <> };
For ordinary files you can also use the "read" function.
read( $fh, $var, -s $fh );
That third argument tests the byte size of the data on the "INPUT" filehandle and reads that many bytes into the buffer $var.
If you map the file, you can virtually load the entire file into a string without actually storing it in memory:
use File::Map qw(map_file);
map_file my $string, $filename;
Once mapped, you can treat $string as you would any other string. Since you don't necessarily have to load the data, mmap-ing can be very fast and may not increase your memory footprint.
If you want to load the entire file, you can use the "File::Slurp" module to do it in one one simple and efficient step:
use File::Slurp;
my $all_of_it = read_file($filename); # entire file in scalar
my @all_lines = read_file($filename); # one line per element
The customary Perl approach for processing all the lines in a file is to
do so one line at a time:
open my $input, '<', $file or die "can't open $file: $!";
while (<$input>) {
chomp;
# do something with $_
}
close $input or die "can't close $file: $!";
This is tremendously more efficient than reading the entire file into memory as an array of lines and then processing it one element at a time, which is often--if not almost always--the wrong approach. Whenever you see someone do this:
my @lines = <INPUT>;
You should think long and hard about why you need everything loaded at once. It's just not a scalable solution. You might also find it more fun to use the standard "Tie::File" module, or the "DB_File" module's $DB_RECNO bindings, which allow you to tie an array to a file so that
accessing an element the array actually accesses the corresponding line in the file.
You can read the entire filehandle contents into a scalar.
my $var;
{
local $/;
open my $fh, '<', $file or die "can't open $file: $!";
$var = <$fh>;
}
That temporarily undefs your record separator, and will automatically close the file at block exit. If the file is already open, just use this:
my $var = do { local $/; <$fh> };
You can do that one better by using a localized @ARGV so you can eliminate the "open":
my $var = do { local( @ARGV, $/ ) = $file; <> };
For ordinary files you can also use the "read" function.
read( $fh, $var, -s $fh );
That third argument tests the byte size of the data on the "INPUT" filehandle and reads that many bytes into the buffer $var.
Tuesday, January 25, 2011
Array count
New Method:
@fruits = qw(apple orange banana mango apple);
$num_apple = grep /^(.*?)$/i, @fruits;
print $num_apple;
@fruits = qw(apple orange banana mango apple);
$num_apple = grep /^(.*?)$/i, @fruits;
print $num_apple;
using each to iterate over an array
use strict;
use warnings;
my @array = (50..59);
while(my ($f, $g) = (splice @array, 0, 2)) {
print "f $f, g $g\n";
}
use warnings;
my @array = (50..59);
while(my ($f, $g) = (splice @array, 0, 2)) {
print "f $f, g $g\n";
}
Exact twice occur
@crops = qw(wheat corn barley rice corn soybean hay
alfalfa rice hay beets corn hay);
@dupes = grep { $count{$_} == 2 } #Exact two occurance
grep { ++$count{$_} > 1 } @crops; #more than two occurance
print "@dupes\n";
alfalfa rice hay beets corn hay);
@dupes = grep { $count{$_} == 2 } #Exact two occurance
grep { ++$count{$_} > 1 } @crops; #more than two occurance
print "@dupes\n";
grep files name only, not directory or else
@files = grep { -f and -T } glob '* .*';
$" = "\n";
print "@files\n";
$" = "\n";
print "@files\n";
Sort by dictionary order
use locale;
@array = qw(ASCII ascap at_large atlarge A ARP arp);
@sorted = sort { ($da = lc $a) =~ s/[\W_]+//g;
($db = lc $b) =~ s/[\W_]+//g;
$da cmp $db;
} @array;
print "@sorted\n"
@array = qw(ASCII ascap at_large atlarge A ARP arp);
@sorted = sort { ($da = lc $a) =~ s/[\W_]+//g;
($db = lc $b) =~ s/[\W_]+//g;
$da cmp $db;
} @array;
print "@sorted\n"
how to reverse an array without reverse function
@array = qw(a b z c e);
while(@array) {
$last = pop(@array);
push(@array1, $last);
}
print @array1;
while(@array) {
$last = pop(@array);
push(@array1, $last);
}
print @array1;
Monday, January 24, 2011
perl: HTML::Entities decode
use HTML::Entities;
open(F1, ">1.txt");
$a = "Våre norske tegn bør æres";
decode_entities($a);
print F1 $a;
__END__
Våre norske tegn bør æres
open(F1, ">1.txt");
$a = "Våre norske tegn bør æres";
decode_entities($a);
print F1 $a;
__END__
Våre norske tegn bør æres
perl: no of element count
open(IN, "VersR-R 02-11.html") || die "Input file cann't open: $!";
read (IN, $file, -s IN);
close IN;
while($file =~ s/<(([A-Za-z]+)\s*[^>]*)>//i) {
$hash{$2}++;
}
print "$_\t$hash{$_}\n" foreach (keys %hash);
read (IN, $file, -s IN);
close IN;
while($file =~ s/<(([A-Za-z]+)\s*[^>]*)>//i) {
$hash{$2}++;
}
print "$_\t$hash{$_}\n" foreach (keys %hash);
Friday, January 21, 2011
How do I find the day or week of the year
The "localtime" function returns the day of the year. Without an argument "localtime" uses the current time.
$day_of_year = (localtime)[7];
The "POSIX" module can also format a date as the day of the year or week of the year.
use POSIX qw/strftime/;
my $day_of_year = strftime "%j", localtime;
my $week_of_year = strftime "%W", localtime;
To get the day of year for any date, use "POSIX"'s "mktime" to get a time in epoch seconds for the argument to "localtime".
use POSIX qw/mktime strftime/;
my $week_of_year = strftime "%W",
localtime( mktime( 0, 0, 0, 18, 11, 87 ) );
The "Date::Calc" module provides two functions to calculate these.
use Date::Calc;
my $day_of_year = Day_of_Year( 1987, 12, 18 );
my $week_of_year = Week_of_Year( 1987, 12, 18 );
$day_of_year = (localtime)[7];
The "POSIX" module can also format a date as the day of the year or week of the year.
use POSIX qw/strftime/;
my $day_of_year = strftime "%j", localtime;
my $week_of_year = strftime "%W", localtime;
To get the day of year for any date, use "POSIX"'s "mktime" to get a time in epoch seconds for the argument to "localtime".
use POSIX qw/mktime strftime/;
my $week_of_year = strftime "%W",
localtime( mktime( 0, 0, 0, 18, 11, 87 ) );
The "Date::Calc" module provides two functions to calculate these.
use Date::Calc;
my $day_of_year = Day_of_Year( 1987, 12, 18 );
my $week_of_year = Week_of_Year( 1987, 12, 18 );
Thursday, January 20, 2011
delete multiple keys in hash
use strict;
use warnings;
my %Age = (
Tom => 26,
Peter => 51,
Jones => 23,
);
my @temp = delete @Age{'Tom', 'Peter'};
$, = " ";
print "Deleted values:", @temp, "\n";
print "Remaining keys:", keys %Age;
use warnings;
my %Age = (
Tom => 26,
Peter => 51,
Jones => 23,
);
my @temp = delete @Age{'Tom', 'Peter'};
$, = " ";
print "Deleted values:", @temp, "\n";
print "Remaining keys:", keys %Age;
push and unshift to add multiple element in array
#push, unshift are add multiple element in an array.
#But pop and shift are only one element is remove in an array
use strict;
use warnings;
my @array = qw(1 2 3 4 5 6 7 8);
my @insert = qw(11 12 13);
push(@array, "9", "10"); #insert in the end of an array
$, = "\n";
print @array;
print "\n\ninsert multiple element in the array\n";
unshift(@array, @insert); #insert in the start in an array
$, = "\n";
print @array;
#But pop and shift are only one element is remove in an array
use strict;
use warnings;
my @array = qw(1 2 3 4 5 6 7 8);
my @insert = qw(11 12 13);
push(@array, "9", "10"); #insert in the end of an array
$, = "\n";
print @array;
print "\n\ninsert multiple element in the array\n";
unshift(@array, @insert); #insert in the start in an array
$, = "\n";
print @array;
sort hash keys and values
use strict;
use warnings;
my %array = (
'3' => 'apple',
'11' => 'orange',
'5' => 'banana'
);
my @key = sort {$a <=> $b} keys %array;
my @value = sort {$a cmp $b} values %array;
print "@key\n\n";
print "@value";
use warnings;
my %array = (
'3' => 'apple',
'11' => 'orange',
'5' => 'banana'
);
my @key = sort {$a <=> $b} keys %array;
my @value = sort {$a cmp $b} values %array;
print "@key\n\n";
print "@value";
Interchange two variable without assign new variable
#swap two values
($a, $b) = (11, 12);
($b, $a) = ($a, $b);
print "$a\t$b\n\n";
($x,@y) = (1, 2, 3, 4);
print "\$x: $x\n";
print "\@y: @y\n\n\n";
(@x, $y) = (1, 2, 3, 4);
print "\@x: @x\n";
print "\$y: $y\n\n";
@array = qw(a a a a);
@array = 3 x @array;
print "@array";
__END__
12 11
$x: 1
@y: 2 3 4
@x: 1 2 3 4
$y:
3333
($a, $b) = (11, 12);
($b, $a) = ($a, $b);
print "$a\t$b\n\n";
($x,@y) = (1, 2, 3, 4);
print "\$x: $x\n";
print "\@y: @y\n\n\n";
(@x, $y) = (1, 2, 3, 4);
print "\@x: @x\n";
print "\$y: $y\n\n";
@array = qw(a a a a);
@array = 3 x @array;
print "@array";
__END__
12 11
$x: 1
@y: 2 3 4
@x: 1 2 3 4
$y:
3333
Wednesday, January 19, 2011
Data Types
Data Types
- Scalars
- Arrays & Lists
- Hashes
- References
- Filehandles
- Perl is smart enough to know how you're using something
- Numerics can be strings; strings can be numerics
- Arrays can be scalars
- Hashes can be arrays
- Arrays can be hashes
- Single value
- Arbitrary large
- Can contain binary data, even nulls.
- Can be numeric or string, depending on context
- Arbitrary-sized array of scalars
- Can contain any scalar
- Used when you want to preserve order of something
- Collection of scalars
- Keyed by a unique case-sensitive string
- Useful for lookups or checking for existence
- Same as associative arrays in awk, or the CMap class in MFC.
- Is a scalar, and can be used anywhere a scalar can
- Perl version of pointers
Hash Manipulation
keys() function
- Returns a list containing all the keys of the hash
- Calling keys() on an
empty hash returns an empty list
- The keys are not in any order: not sorted, not in order added, not
nothin'.
- Each keys in the list will be unique, because all keys in the hash are unique.
- Partner of the keys()
function
- Returns a list containing all the values in the hash
- Calling values() on
an empty hash returns an empty list
- The values are not in any order: not sorted, not in order added, not
nothin'.
- Values are not necessarily unique, because values in the hash don't
have to be.
my %stats; $stats{ "name" } = "Andy Lester"; $stats{ "age" } = 31; @keys = keys %stats; # @keys is ( "name", "age" ), or maybe ( "age", "name" ) @values = values %stats; # @values is ( "Andy Lester", 31 ) or maybe ( 31, "Andy Lester" )
- To loop over a hash, get a list of keys, sort it, and loop on it
my %stats; $stats{ "name" } = "Andy Lester"; $stats{ "age" } = 31; my @keys = keys %stats; @keys = sort @keys; for my $key ( @keys ) { print "$key: ", $stats{ $key }, "\n"; } # Prints: # age: 31 # name: Andy Lester
- Use the delete()
function to remove a hash entry
my %stats; $stats{ "name" } = "Andy Lester"; $stats{ "age" } = 31; delete $stats{ "name" }; # %stats now has only one value - Note that you do NOT want to set the hash element to undef. The hash element will still exist, with a value of undef.
A Short Guide to DBI
General information about relational databases
Relational databases started to get to be a big deal in the 1970's, andthey're still a big deal today, which is a little peculiar, because they're a 1960's technology.A relational database is a bunch of rectangular tables. Each row of a table is a record about one person or thing; the record contains several pieces of information called fields. Here is an example table:
LASTNAME FIRSTNAME ID POSTAL_CODE AGE SEX
Gauss Karl 119 19107 30 M
Smith Mark 3 T2V 3V4 53 M
Noether Emmy 118 19107 31 F
Smith Jeff 28 K2G 5J9 19 M
Hamilton William 247 10139 2 M
The names of the fields are LASTNAME, FIRSTNAME, ID,
POSTAL_CODE, AGE, and SEX. Each line in the table is a
record, or sometimes a row or tuple. For example, the first row of the table represents a 30-year-old male
whose name is Karl Gauss, who lives at postal code 19107, and whose ID
number is 119.Sometimes this is a very silly way to store information. When the information naturally has a tabular structure it's fine. When it doesn't, you have to squeeze it into a table, and some of the techniques for doing that are more successful than others. Nevertheless, tables are simple and are easy to understand, and most of the high-performance database systems you can buy today operate under this 1960's model.
About SQL
SQL stands for Structured Query Language. It was invented at IBM in the 1970's. It's a language for describing searches and modifications to a relational database.SQL was a huge success, probably because it's incredibly simple and anyone can pick it up in ten minutes. As a result, all the important database systems support it in some fashion or another. This includes the big players, like Oracle and Sybase, high-quality free or inexpensive database systems like MySQL, and funny hacks like Perl's
DBD::CSV module, which we'll see later.There are four important things one can do with a table:
- SELECT
- Find all the records that have a certain property
- INSERT
- Add new records
- DELETE
- Remove old records
- UPDATE
- Modify records that are already there
people. Here are examples of each of the four important kinds of queries:
SELECT firstname FROM people WHERE lastname = 'Smith'(Locate the first names of all the Smiths.)
DELETE FROM people WHERE id = 3(Delete Mark Smith from the table)
UPDATE people SET age = age+1 WHERE id = 247(William Hamilton just had a birthday.)
INSERT INTO people VALUES ('Euler', 'Leonhard', 248, NULL, 58, 'M')
(Add Leonhard Euler to the table.)
There are a bunch of other SQL commands for creating and discarding tables, for granting and revoking access permissions, for committing and abandoning transactions, and so forth. But these four are the important ones. Congratulations; you are now a SQL programmer. For the details, go to any reasonable bookstore and pick up a SQL quick reference.
Every database system is a little different. You talk to some databases over the network and make requests of the database engine; other databases you talk to through files or something else.
Typically when you buy a commercial database, you get a library with it. The vendor has written some functions for talking to the database in some language like C, compiled the functions, and the compiled code is the library. You can write a C program that calls the functions in the library when it wants to talk to the database.
Every vendor's library is different. The names of the functions vary, and the order in which you call them varies, and the details of passing queries to the functions and getting the data back out will vary. Some libraries, like Oracle's, are very thin—they just send the query over to the network to the real database and let the giant expensive real database engine deal with it directly. Other libraries will do more predigestion of the query, and more work afterwards to turn the data into a data structure. Some databases will want you to spin around three times and bark like a chicken; others want you to stand on your head and drink out of your sneaker.
What DBI is For
There's a saying that any software problem can be solved by adding a layer of indirection. That's what Perl'sDBI (`Database Interface') module is all about. It was written by Tim Bunce.DBI is designed to protect you from the details of the vendor libraries. It has
a very simple interface for saying what SQL queries you want to make, and
for getting the results back. DBI doesn't know how to talk to any particular database, but it does know how
to locate and load in DBD (`Database Driver') modules. The DBD modules have the vendor libraries in them and know how to talk to the real
databases; there is one DBD module for every different database.When you ask
DBI to make a query for you, it sends the query to the appropriate DBD module, which spins around three times or drinks out of its sneaker or
whatever is necessary to communicate with the real database. When it gets the
results back, it passes them to DBI. Then DBI gives you the results. Since your program only has to deal with DBI, and not with the real database, you don't have to worry about barking
like a chicken.
DBI library. You are using two databases at once. One is an Oracle database
server on some other machine, and another is a DBD::CSV database that stores the data in a bunch of plain text files on the local
disk.Your program sends a query to
DBI, which forwards it to the appropriate DBD module; let's say it's DBD::Oracle. DBD::Oracle knows how to translate what it gets from DBI into the format demanded by the Oracle library, which is built into it. The
library forwards the request across the network, gets the results back, and
returns them to
DBD::Oracle. DBD::Oracle returns the results to DBI as a Perl data structure. Finally, your program can get the results from
DBI.On the other hand, suppose that your program was querying the text files. It would prepare the same sort of query in exactly the same way, and send it to
DBI in exactly the same way. DBI would see that you were trying to talk to the DBD::CSV database and forward the request to the DBD::CSV module. The DBD::CSV module has Perl functions in it that tell it how to parse SQL and how to
hunt around in the text files to find the information you asked for. It
then returns the results to DBI as a Perl data structure. Finally, your program gets the results from DBI in exactly the same way that it would have if you were talking to Oracle
instead.There are two big wins that result from this organization. First, you don't have to worry about the details of hunting around in text files or talking on the network to the Oracle server or dealing with Oracle's library. You just have to know how to talk to
DBI.Second, if you build your program to use Oracle, and then the following week upper management signs a new Strategic Partnership with Sybase, it's easy to convert your code to use Sybase instead of Oracle. You change exactly one line in your program, the line that tells
DBI to talk to DBD::Oracle, and have it use DBD::Sybase instead. Or you might build your program to talk to a cheap, crappy
database like MS Access, and then next year when the application is doing
well and getting more use than you expected, you can upgrade to a better
database next year without changing any of your code.There are
DBD modules for talking to every important kind of SQL database. DBD::Oracle will talk to Oracle, and DBD::Sybase will talk to Sybase. DBD::ODBC will talk to any ODBC database including Microsoft Acesss. (ODBC is a
Microsoft invention that is analogous to
DBI itself. There is no DBD module for talking to Access directly.) DBD::CSV allows SQL queries on plain text files.
DBD::mysql talks to the excellent MySQL database from TCX DataKonsultAB in Sweden.
(MySQL is a tremendous bargain: It's $200 for commercial use,
and free for noncommerical use.)
Example of How to Use DBI
Here's a typical program. When you run it, it waits for you to type a last
name. Then it searches the database for people with that last name and
prints out the full name and ID number for each person it finds. For
example:
Enter name> Noether
118: Emmy Noether
Enter name> Smith
3: Mark Smith
28: Jeff Smith
Enter name> Snonkopus
No names matched `Snonkopus'.
Enter name> ^D
Here is the code:
use DBI;
my $dbh = DBI->connect('DBI:Oracle:payroll')
or die "Couldn't connect to database: " . DBI->errstr;
my $sth = $dbh->prepare('SELECT * FROM people WHERE lastname = ?')
or die "Couldn't prepare statement: " . $dbh->errstr;
print "Enter name> ";
while ($lastname = <>) { # Read input from the user
my @data;
chomp $lastname;
$sth->execute($lastname) # Execute the query
or die "Couldn't execute statement: " . $sth->errstr;
# Read the matching records and print them out
while (@data = $sth->fetchrow_array()) {
my $firstname = $data[1];
my $id = $data[2];
print "\t$id: $firstname $lastname\n";
}
if ($sth->rows == 0) {
print "No names matched `$lastname'.\n\n";
}
$sth->finish;
print "\n";
print "Enter name> ";
}
$dbh->disconnect;
use DBI;This loads in the
DBI module. Notice that we don't have to load in any DBD module. DBI will do that for us when it needs to. my $dbh = DBI->connect('DBI:Oracle:payroll');
or die "Couldn't connect to database: " . DBI->errstr;
The connect call tries to connect to a database. The first argument, DBI:Oracle:payroll, tells DBI what kind of database it is connecting to. The Oracle part tells it to load DBD::Oracle and to use that to communicate with the database. If we had to switch to
Sybase next week, this is the one line of the program that we would change.
We would have to change Oracle to Sybase.payroll is the name of the database we will be searching. If we were going to
supply a username and password to the database, we would do it in the connect call:
my $dbh = DBI->connect('DBI:Oracle:payroll', 'username', 'password')
or die "Couldn't connect to database: " . DBI->errstr;
If DBI connects to the database, it returns a database handle object, which we store into $dbh. This object represents the database connection. We can be connected to
many databases at once and have many such database connection objects.If
DBI can't connect, it returns an undefined value. In this case, we use die to abort the program with an error message.
DBI->errstr returns the reason why we couldn't connect—``Bad password'' for example.
my $sth = $dbh->prepare('SELECT * FROM people WHERE lastname = ?')
or die "Couldn't prepare statement: " . $dbh->errstr;
The prepare call prepares a query to be executed by the database. The argument is any
SQL at all. On high-end databases, prepare will send the SQL to the database server, which will compile it. If
prepare is successful, it returns a statement handle object which represents the statement; otherwise it returns an undefined
value and we abort the program. $dbh->errstr will return the reason for failure, which might be ``Syntax error in SQL''.
It gets this reason from the actual database, if possible.The
? in the SQL will be filled in later. Most databases can handle this. For
some databases that don't understand the ?, the DBD module will emulate it for you and will pretend that the database
understands how to fill values in later, even though it doesn't.print "Enter name> ";Here we just print a prompt for the user.
while ($lastname = <>) { # Read input from the user
...
}
This loop will repeat over and over again as long as the user enters a last
name. If they type a blank line, it will exit. The Perl
<> symbol means to read from the terminal or from files named on the command
line if there were any.my @data;This declares a variable to hold the data that we will get back from the database.
chomp $lastname;This trims the newline character off the end of the user's input.
$sth->execute($lastname) # Execute the query
or die "Couldn't execute statement: " . $sth->errstr;
execute executes the statement that we prepared before. The argument $lastname is substituted into the SQL in place of the
? that we saw earlier. execute returns a true value if it succeeds and a false value otherwise, so we
abort if for some reason the execution fails. while (@data = $sth->fetchrow_array()) {
...
}
fetchrow_array returns one of the selected rows from the database. You get back an array
whose elements contain the data from the selected row. In this case, the
array you get back has six elements. The first element is the person's
last name; the second element is the first name; the third element is the
ID, and then the other elements are the postal code, age, and sex.Each time we call
fetchrow_array, we get back a different record from the database. When there are no more
matching records,
fetchrow_array returns the empty list and the while loop exits.
my $firstname = $data[1];
my $id = $data[2];
These lines extract the first name and the ID number from the record data.
print "\t$id: $firstname $lastname\n";This prints out the result.
if ($sth->rows == 0) {
print "No names matched `$lastname'.\n\n";
}
The rows method returns the number of rows of the
database that were selected. If no rows were selected, then there is
nobody in the database with the last name that the user is looking
for. In that case, we print out a message. We have to do this
after the while loop that fetches whatever rows
were available, because with some databases you don't know how many
rows there were until after you've gotten them all.
$sth->finish;
print "\n";
print "Enter name> ";
Once we're done reporting about the result of the query, we print another
prompt so that the user can enter another name.
finish tells the database that we have finished retrieving
all the data for this query and allows it to reinitialize the handle so
that we can execute it again for the next query.
$dbh->disconnect;When the user has finished querying the database, they type a blank line and the main
while loop exits. disconnect closes the connection to the database.
Cached Queries
Here's a function which looks up someone in the example table, given their ID number, and returns their age: sub age_by_id {
# Arguments: database handle, person ID number
my ($dbh, $id) = @_;
my $sth = $dbh->prepare('SELECT age FROM people WHERE id = ?')
or die "Couldn't prepare statement: " . $dbh->errstr;
$sth->execute($id)
or die "Couldn't execute statement: " . $sth->errstr;
my ($age) = $sth->fetchrow_array();
return $age;
}
It prepares the query, executes it, and retrieves the result.
There's a problem here though. Even though the function works correctly, it's inefficient. Every time it's called, it prepares a new query. Typically, preparing a query is a relatively expensive operation. For example, the database engine may parse and understand the SQL and translate it into an internal format. Since the query is the same every time, it's wasteful to throw away this work when the function returns.
Here's one solution:
{ my $sth;
sub age_by_id {
# Arguments: database handle, person ID number
my ($dbh, $id) = @_;
if (! defined $sth) {
$sth = $dbh->prepare('SELECT age FROM people WHERE id = ?')
or die "Couldn't prepare statement: " . $dbh->errstr;
}
$sth->execute($id)
or die "Couldn't execute statement: " . $sth->errstr;
my ($age) = $sth->fetchrow_array();
return $age;
}
}
There are two big changes to this function from the previous version.
First, the $sth variable has moved outside of the function; this tells Perl that its value
should persist even after the function returns. Next time the function is
called, $sth will have the same value as before.Second, the
prepare code is in a conditional block. It's only executed if $sth does not yet have a value. The first time the function is called, the prepare code is executed and the statement handle is stored into $sth. This value persists after the function returns, and the next time the
function is called, $sth still contains the statement handle and the prepare code is skipped.Here's another solution:
sub age_by_id {
# Arguments: database handle, person ID number
my ($dbh, $id) = @_;
my $sth = $dbh->prepare_cached('SELECT age FROM people WHERE id = ?')
or die "Couldn't prepare statement: " . $dbh->errstr;
$sth->execute($id)
or die "Couldn't execute statement: " . $sth->errstr;
my ($age) = $sth->fetchrow_array();
return $age;
}
Here the only change to to replace prepare with prepare_cached. The prepare_cached call is just like prepare, except that it looks to see if the query is the same as last time. If so,
it gives you the statement handle that it gave you before.Transactions
Many databases support transactions. This means that you can make a whole bunch of queries which would modify the databases, but none of the changes are actually made. Then at the end you issue the special SQL queryCOMMIT, and all the changes are made simultaneously. Alternatively, you can issue
the query ROLLBACK, in which case all the queries are thrown away.As an example of this, consider a function to add a new employee to a database. The database has a table called
employees that looks like this:
FIRSTNAME LASTNAME DEPARTMENT_ID
Gauss Karl 17
Smith Mark 19
Noether Emmy 17
Smith Jeff 666
Hamilton William 17
and a table called departments that looks like this:
ID NAME NUM_MEMBERS
17 Mathematics 3
666 Legal 1
19 Grounds Crew 1
The mathematics department is department #17 and has three members: Karl
Gauss, Emmy Noether, and William Hamilton.Here's our first cut at a function to insert a new employee. It will return true or false depending on whether or not it was successful:
sub new_employee {
# Arguments: database handle; first and last names of new employee;
# department ID number for new employee's work assignment
my ($dbh, $first, $last, $department) = @_;
my ($insert_handle, $update_handle);
my $insert_handle =
$dbh->prepare_cached('INSERT INTO employees VALUES (?,?,?)');
my $update_handle =
$dbh->prepare_cached('UPDATE departments
SET num_members = num_members + 1
WHERE id = ?');
die "Couldn't prepare queries; aborting"
unless defined $insert_handle && defined $update_handle;
$insert_handle->execute($first, $last, $department) or return 0;
$update_handle->execute($department) or return 0;
return 1; # Success
}
We create two handles, one for an insert query that will insert the new employee's name and department number into
the employees table, and an update query that will increment the number of members in the new employee's
department in the department table. Then we execute the two queries with the appropriate arguments.
There's a big problem here: Suppose, for some reason, the second query fails. Our function returns a failure code, but it's too late, it has already added the employee to the
employees table, and that means that the count in the departments table is wrong. The database now has corrupted data in it.
The solution is to make both updates part of the same transaction. Most databases will do this automatically, but without an explicit instruction about whether or not to commit the changes, some databases will commit the changes when we disconnect from the database, and others will roll them back. We should specify the behavior explicitly.
Typically, no changes will actually be made to the database until we issue a
commit. The version of our program with commit looks like this:
sub new_employee {
# Arguments: database handle; first and last names of new employee;
# department ID number for new employee's work assignment
my ($dbh, $first, $last, $department) = @_;
my ($insert_handle, $update_handle);
my $insert_handle =
$dbh->prepare_cached('INSERT INTO employees VALUES (?,?,?)');
my $update_handle =
$dbh->prepare_cached('UPDATE departments
SET num_members = num_members + 1
WHERE id = ?');
die "Couldn't prepare queries; aborting"
unless defined $insert_handle && defined $update_handle;
my $success = 1;
$success &&= $insert_handle->execute($first, $last, $department);
$success &&= $update_handle->execute($department);
my $result = ($success ? $dbh->commit : $dbh->rollback);
unless ($result) {
die "Couldn't finish transaction: " . $dbh->errstr
}
return $success;
}
We perform both queries, and record in $success whether they both succeeded. $success will be true if both queries succeeded, false otherwise. If the queries
succeded, we commit the transaction; otherwise, we roll it back, cancelling
all our changes.The problem of concurrent database access is also solved by transactions. Suppose that queries were executed immediately, and that some other program came along and examined the database after our insert but before our update. It would see inconsistent data in the database, even if our update would eventually have succeeded. But with transactions, all the changes happen simultaneously when we do the
commit, and the changes are committed automatically, which means that any other
program looking at the database either sees all of them or none.
do
If you're doing an UPDATE, INSERT, or DELETE there is no data that comes back from the database, so there is a short
cut. You can say
$dbh->do('DELETE FROM people WHERE age > 65');
for example, and DBI will prepare the statement, execute it, and finish it. do returns a true value if it succeeded, and a false value if it failed.
Actually, if it succeeds it returns the number of affected rows. In the
example it would return the number of rows that were actually deleted. (DBI plays a magic trick so that the value it turns is true even when it is 0.
This is bizarre, because 0 is usually false in Perl. But it's convenient
because you can use it either as a number or as a true-or-false success
code, and it works both ways.)AutoCommit
If your transactions are simple, you can save yourself the trouble of having to issue a lot ofcommits. When you make the connect call, you can specify an AutoCommit option which will perform an automatic commit operation after every successful query. Here's what it looks like:
my $dbh = DBI->connect('DBI:Oracle:payroll',
{AutoCommit => 1},
)
or die "Couldn't connect to database: " . DBI->errstr;
Automatic Error Handling
When you make theconnect call, you can specify a RaiseErrors option that handles errors for you automatically. When an error occurs, DBI will abort your program instead of returning a failure code. If all you
want is to abort the program on an error, this can be convenient: my $dbh = DBI->connect('DBI:Oracle:payroll',
{RaiseError => 1},
)
or die "Couldn't connect to database: " . DBI->errstr;
Don't do This
People are always writing code like this: while ($lastname = <>) {
my $sth = $dbh->prepare("SELECT * FROM people
WHERE lastname = '$lastname'");
$sth->execute();
# and so on ...
}
Here we interpolated the value of $lastname directly into the SQL in the prepare call.
This is a bad thing to do for three reasons.
First,
prepare calls can take a long time. The database server has to compile the SQL and
figure out how it is going to run the query. If you have many similar
queries, that is a waste of time.Second, it will not work if
$lastname contains a name like O'Malley or D'Amico or some other name with an '. The ' has a special meaning in SQL, and the database will not understand when you
ask it to prepare a statement that looks like
SELECT * FROM people WHERE lastname = 'O'Malley'It will see that you have three
's and complain that you
don't have a fourth matching ' somewhere else.Finally, if you're going to be constructing your query based on a user input, as we did in the example program, it's unsafe to simply interpolate the input directly into the query, because the user can construct a strange input in an attempt to trick your program into doing something it didn't expect. For example, suppose the user enters the following bizarre value for
$input:x' or lastname = lastname or lastname = 'yNow our query has become something very surprising:
SELECT * FROM people WHERE lastname = 'x'
or lastname = lastname or lastname = 'y'
The part of this query that our sneaky user is interested in is the
second or clause. This clause selects all the records
for which lastname is equal to lastname;
that is, all of them. We thought that the user was only going to be
able to see a few records at a time, and now they've found a way to
get them all at once. This probably wasn't what we wanted.| References |
|
• A complete list of DBD modules are available here
• You can download these modules here • DBI modules are available here• You can get MySQL from www.tcx.se |
? into the query, like this
SELECT * FROM people WHERE lastname = ?All my examples look like this. It is safer and more convenient and more efficient to do it this way.
Multidimensional array
use strict; #unconstrct varible to findout purpose
use warnings; #warnings purpose
use File::Slurp; #to get file scalar, array or hash
my @ifile = read_file("E:/Purand/test/mtab.txt");
my $row = @ifile; #number of rows count
my $col = my @cols = (split /\t/, $ifile[0]);
#number of columns count
my @array = (); #array initials
my @sfile = ();
my $i = 0; #index variable initials
foreach my $row (@ifile) { #to get each and every line(row)
@sfile = split(/\t/, $row); #split every line and store array
=begin
foreach my $element (@sfile) { #to get each element(cell)
push @{$array[$i]}, $element; #assign array of array(multiarray)
}
=cut
$array[$i]=[@sfile];
my @sfile = (); #reset array
$i++; #array(row) index increment
}
for(my $m = 0; $m < $row; $m++) { #loop to be run no. of rows
for(my $n = 0; $n < $col; $n++) { #loop to run no. of cols
print $array[$m]->[$n], "\t"; #print out each and every cell with alignment
}
print "\n"; #every row seperation
}
use warnings; #warnings purpose
use File::Slurp; #to get file scalar, array or hash
my @ifile = read_file("E:/Purand/test/mtab.txt");
my $row = @ifile; #number of rows count
my $col = my @cols = (split /\t/, $ifile[0]);
#number of columns count
my @array = (); #array initials
my @sfile = ();
my $i = 0; #index variable initials
foreach my $row (@ifile) { #to get each and every line(row)
@sfile = split(/\t/, $row); #split every line and store array
=begin
foreach my $element (@sfile) { #to get each element(cell)
push @{$array[$i]}, $element; #assign array of array(multiarray)
}
=cut
$array[$i]=[@sfile];
my @sfile = (); #reset array
$i++; #array(row) index increment
}
for(my $m = 0; $m < $row; $m++) { #loop to be run no. of rows
for(my $n = 0; $n < $col; $n++) { #loop to run no. of cols
print $array[$m]->[$n], "\t"; #print out each and every cell with alignment
}
print "\n"; #every row seperation
}
perl function
For specific information on a function, use perldoc -f function_name to get a concise summary.
| abs | absolute value |
|---|---|
| chdir | change current directory |
| chmod | change permissions of file/directory |
| chomp | remove terminal newline from string variable |
| chop | remove last character from string variable |
| chown | change ownership of file/directory |
| close | close a file handle |
| closedir | close a directory handle |
| cos | cosine |
| defined | test whether variable is defined |
| delete | delete a key from a hash |
| die | exit with an error message |
| each | iterate through keys & values of a hash |
| eof | test a filehandle for end of file |
| eval | evaluate a string as a perl expression |
| exec | quit Perl and execute a system command |
| exists | test that a hash key exists |
| exit | exit from the Perl script |
| glob | expand a directory listing using shell wildcards |
| gmtime | current time in GMT |
| grep | filter an array for entries that meet a criterion |
| index | find location of a substring inside a larger string |
| int | throw away the fractional part of a floating point number |
| join | join an array together into a string |
| keys | return the keys of a hash |
| kill | send a signal to one or more processes |
| last | exit enclosing loop |
| lc | convert string to lowercase |
| lcfirst | lowercase first character of string |
| length | find length of string |
| local | temporarily replace the value of a global variable |
| localtime | return time in local timezone |
| log | natural logarithm |
| m// | pattern match operation |
| map | perform on operation on each member of array or list |
| mkdir | make a new directory |
| my | create a local variable |
| next | jump to the top of enclosing loop |
| open | open a file for reading or writing |
| opendir | open a directory for listing |
| pack | pack a list into a compact binary representation |
| package | create a new namespace for a module |
| pop | pop the last item off the end of an array |
| print to terminal or a file | |
| printf | formatted print to a terminal or file |
| push | push a value onto the end of an array |
| q/STRING/ | generalized single-quote operation |
| qq/STRING/ | generalized double-quote operation |
| qx/STRING/ | generalized backtick operation |
| qw/STRING/ | turn a space-delimited string of words into a list |
| rand | random number generator |
| read | read binary data from a file |
| readdir | read the contents of a directory |
| readline | read a line from a text file |
| readlink | determine the target of a symbolic link |
| redo | restart a loop from the top |
| ref | return the type of a variable reference |
| rename | rename or move a file |
| require | load functions defined in a library file |
| return | return a value from a user-defined subroutine |
| reverse | reverse a string or list |
| rewinddir | rewind a directory handle to the beginning |
| rindex | find a substring in a larger string, from right to left |
| rmdir | remove a directory |
| s/// | pattern substitution operation |
| scalar | force an expression to be treated as a scalar |
| seek | reposition a filehandle to an arbitrary point in a file |
| select | make a filehandle the default for output |
| shift | shift a value off the beginning of an array |
| sin | sine |
| sleep | put the script to sleep for a while |
| sort | sort an array or list by user-specified criteria |
| splice | insert/delete array items |
| split | split a string into pieces according to a pattern |
| sprintf | formatted string creation |
| sqrt | square root |
| stat | get information about a file |
| sub | define a subroutine |
| substr | extract a substring from a string |
| symlink | create a symbolic link |
| system | execute an operating system command, then return to Perl |
| tell | return the position of a filehandle within a file |
| tie | associate a variable with a database |
| time | return number of seconds since January 1, 1970 |
| tr/// | replace characters in a string |
| truncate | truncate a file (make it smaller) |
| uc | uppercase a string |
| ucfirst | uppercase first character of a string |
| umask | change file creation mask |
| undef | undefine (remove) a variable |
| unlink | delete a file |
| unpack | the reverse of pack |
| untie | the reverse of tie |
| unshift | move a value onto the beginning of an array |
| use | import variables and functions from a library module |
| values | return the values of a hash variable |
| wantarray | return true in an array context |
| warn | print a warning to standard error |
| write | formatted report generation |
Tuesday, January 18, 2011
Perl Hash
Initialize (clear, or empty) a hash
Assigning an empty list is the fastest method.Solution
my %hash = ();
Initialize (clear, or empty) a hash reference
People have asked how to initialize a hash reference (aka hash ref and href). This is the way to go:Solution
my $hash_ref = {}; # a reference to an empty hash, ref will return HASH
The great thing about this is that if before performing an actual
assignment, you want to determine (using the ref operator) the type of
thingy that a reference is pointing to, you can!... and you can expect it to
be a HASH built-in type, because that is what the line above initializes
it to be.Note
If you treat the variable just as any scalar variable; and use the my declaration alone, or assign a value, ref will return false.
my $hash_ref;
my $hash_ref = 0; # zero
Add a key/value pair to a hash
In the solutions below, quotes around the keys can be omitted when the keys are identifiers.Hash:
Solution
$hash{ 'key' } = 'value'; # hash
$hash{ $key } = $value; # hash, using variables
Hash reference:Solution
$href->{ 'key' } = 'value'; # hash ref
$href->{ $key } = $value; # hash ref, using variables
Add several key/value pairs to a hash
SolutionThe following statements are equivalent, though the second one is more readable:
%hash = ( 'key1', 'value1', 'key2', 'value2', 'key3', 'value3' );
%hash = (
key1 => 'value1',
key2 => 'value2',
key3 => 'value3',
);
Copy a hash
Solutionmy %hash_copy = %hash; # copy a hash
my $href_copy = $href; # copy a hash ref
Delete a single key/value pair
The solution differs for a hash and a hash reference, but both cases can use the delete function.Solution
Hash:
delete $hash{$key};
Hash reference: delete $hash_ref->{$key};
Perform an action on each key/value pair in a hash
The actions below print the key/value pairs.Solution
Use each within a while loop. Note that each iterates over entries in an apparently random order, but that order is guaranteed to be the same for the functions keys and values.
while ( my ($key, $value) = each(%hash) ) {
print "$key => $value\n";
}
A hash reference would be only slightly different: while ( my ($key, $value) = each(%$hash_ref) ) {
print "$key => $value\n";
}
SolutionUse keys with a for loop.
for my $key ( keys %hash ) {
my $value = $hash{$key};
print "$key => $value\n";
}
Example my $file = $ARGV[0] || "-";
my %from = ();
open FILE, "< $file" or die "Can't open $file : $!";
while( <FILE> ) {
if (/^From: (.*)/) { $from{$1}++ } # count recurrences of sender
}
close FILE;
for my $sender ( sort keys %from ) {
print "$sender: $from{$sender}\n";
}
Get the size of a hash
Solutionprint "size of hash: " . keys( %hash ) . ".\n";Solution
my $i = 0;
$i += scalar keys %$hash_ref; # method 1: explicit scalar context
$i += keys %$hash_ref; # method 2: implicit scalar context
Use hash references
Solution sub foo
{
my $hash_ref;
$hash_ref->{ 'key1' } = 'value1';
$hash_ref->{ 'key2' } = 'value2';
$hash_ref->{ 'key3' } = 'value3';
return $hash_ref;
}
my $hash_ref = foo();
print "the keys... ", sort keys %$hash_ref, "...\n";
Create a hash of hashes; via references
The following two solutions are equivalent, except for the way the look. In my opinion the second approach is clearer.Solution
$requiredPatches_href->{ $patch }->{ os } = $os;
$requiredPatches_href->{ $patch }->{ arch } = $arch;
$requiredPatches_href->{ $patch }->{ info } = $info;
Solution $requiredPatches_href->{ $patch } = {
os => $os,
arch => $arch,
info => $info,
};
Function to build a hash of hashes; return a reference
Solution sub foo
{
my ( $login, $p, $uid, $gid, $gecos, $dir, $s );
my %HoH = ();
my $file = '/etc/passwd';
open( PASSWD, "< $file" ) or die "Can't open $file : $!";
while( <PASSWD> ) {
( $login, $p, $uid, $gid, $gecos, $dir, $s ) = split( ':' );
$HoH{ $login }{ 'uid' } = $uid;
$HoH{ $login }{ 'gid' } = $gid;
$HoH{ $login }{ 'dir' } = $dir;
}
close PASSWD;
return \%HoH;
}
Access and print a reference to a hash of hashes
Solution my $rHoH = foo();
my( $uid, $gid, $dir );
for my $login ( keys %$rHoH ) {
$uid = $rHoH->{ $login }->{ 'uid' }; # method 1 most readable
$gid = ${ $rHoH->{ $login } }{ 'gid' }; # method 2
$dir = ${ ${ $rHoH }{ $login } }{ 'dir' }; # method 3 least readable
print "uid: $uid, gid: $gid, dir, $dir.\n";
}
Solution my $rHoH = foo();
for my $k1 ( sort keys %$rHoH ) {
print "k1: $k1\n";
for my $k2 ( keys %{$rHoH->{ $k1 }} ) {
print "k2: $k2 $rHoH->{ $k1 }{ $k2 }\n";
}
}
Function to build a hash of hashes of hashes; return a reference
Solution sub foo
{
my %HoHoH = ();
while( ... ) {
if( /LOCATION:/ ) {
...
} elsif( /MODULE:/ ) {
$HoHoH{ $loc }{ $module_type }{ MODULE_NAME } = $module_name;
} elsif( $ARGS_ALLOWED ) {
$HoHoH{ $loc }{ $module_type }{ $arg_name } = $arg_value;
}
}
return \%HoHoH;
}
Access and print a reference to a hash of hashes of hashes
Solution my $rHoHoH = foo();
for my $k1 ( sort keys %$rHoHoH ) {
print "$k1\n";
for my $k2 ( sort keys %{$rHoHoH->{ $k1 }} ) {
print "\t$k2\n";
for my $k3 ( sort keys %{$rHoHoH->{ $k1 }->{ $k2 }} ) {
print "\t\t$k3 => $rHoHoH->{ $k1 }->{ $k2 }->{ $k3 }\n";
}
}
}
Print the keys and values of a hash, given a hash reference
Solution while( my ($k, $v) = each %$hash_ref ) {
print "key: $k, value: $v.\n";
}
Determine whether a hash value exists, is defined, or is true
Solution print "Value EXISTS, but may be undefined.\n" if exists $hash{ $key };
print "Value is DEFINED, but may be false.\n" if defined $hash{ $key };
print "Value is TRUE at hash key $key.\n" if $hash{ $key };
ExampleLet's say we execute an sql query where some of the resulting values may be NULL. Before attempting to use any of the values we should first check whether they are defined, as in the following code. Note that the subroutine
sql_fetch_hashref() takes care of connecting to the database, preparing the
statement, executing it, and returning the resulting row as a hash reference
using DBI's fetchrow_hashref() method. my $answers = 'a,b,c,d,e';
my $sql = "select max_time, $answers from questions " .
'where question_number=?';
my $hash_ref = sql_fetch_hashref( $sql, $q );
my @answers = split ',', $answers;
my $max_time = $hash_ref->{max_time} || '60';
my $hash_ref_ans;
for my $letter ( @answers ) {
$hash_ref_ans->{ $letter } = $hash_ref->{ $letter }
if defined $hash_ref->{ $letter };
}
The for loop made a new hash of only defined key/value pairs.
References
References are scalars that refer to other variables
References are like pointers in C in that they refer to other variables. Create a reference with the\ operator.my $sref = \$scalar; my $aref = \@array; my $href = \%hash; my $cref = \&subroutine;The thing the reference point to is the "referent".
Dereference a reference with the appropriate sigil, preferably in squiggly braces.
my $other_scalar = ${$sref}; my @other_array = @{$aref}; my %other_hash = %{$href}; &{$cref} # Call the referent.
Arrow pointer is easier way to dereference.
To access array and hashrefs, use the-> operator.my $stooge = $aref->[1]; my $stooge = $href->{Curly};
ref vs isa
- A reference belongs to one class
- You can check this class with
ref - An object reference can inherit from other classes
- You can ask an object if it inherited from a class with
isa - Don't use
refwithout a good reason isais part of the UNIVERSAL package, so you can call it on objectsmy $mech = WWW::Mechanize->new; print "ok\n" if $mech->isa('LWP::UserAgent');
References to anonymous subroutines
Subroutines can be assigned to a variable, then called, allowing code references to be passed around and used at will. This can come in handy if, for example, you're writing a subroutine that needs to execute supplied code as part of its work.my $casefix = sub { return ucfirst lc $_[0] }; my $color = $casefix->("rED"); print "Color: $color\n"; # prints Red
Subroutines
Retrieving arguments to a subroutine with shift
A subroutine's arguments come in via the special @_ array.
The shift without an argument defaults to @_.sub volume { my $height = shift; my $width = shift; my $depth = shift; return $height * $width * $depth; }
Assign arguments to a subroutine with list assignment
You can also assign arguments en masse with list assignment:sub volume { my ($height, $width, $depth) = @_; return $height * $width * $depth; }
Handle arguments directly by accessing @_
In some cases, but we hope very few, you can access arguments directly in the @_ array.sub volume { return $_[0] * $_[1] * $_[2]; }
Arguments passed can get modified
The arguments passed to a subroutine are aliases to the real arguments.my $foo = 3; print incr1($foo) . "\n"; # prints 4 print "$foo\n"; # prints 3 sub incr1 { return $_[0]+1; }This can be good if you want it to be:
sub incr2 { return ++$_[0]; }
Subroutines have no argument checking
You can pass any anything to a subroutine that you want.sub square { my $number = shift; return $number * $number; } my $n = square( 'Dog food', 14.5, 'Blah blah blah' );Only the first argument is used by the function. For that matter, you can call the function with any number of arguments, even no arguments:
my $n = square();and Perl won't complain.
The module Params::Validate solves many of these validation problems.
Perl has "prototypes". Ignore them.
Somewhere along the way, prototypes got added, so you can do things like this:sub square($) { ... } my $n = square( 1, 2, 3 ); # run-time errorHowever, don't use them. They don't work on objects, and they require that the subroutines be declared before they're called. They're a nice idea, but just not practical.
Make things happen at compile time with the BEGIN block
BEGIN is a special type of code block. It allows
programmers to execute code during Perl's compile phase, allowing for
initializations and other things to happen.Perl uses
BEGIN any time you use a module; the following two statements are equivalent:use WWW::Mechanize; BEGIN { require WWW::Mechanize; import WWW::Mechanize; }
Pass in arrays and hashes as references
Remember that the parameters passed into a subroutine are passed as one big array. If you do something like the following:my @stooges = qw( Moe Larry Curly ); my @sandwiches = qw( tuna ham-n-cheese PBJ ); lunch( @stooges, @sandwiches );Then what's passed in to
lunch is the list( "Moe", "Larry", "Curly", "tuna", "ham-n-cheese", "PBJ" );Inside
lunch, how can you tell where the stooges end and the sandwiches begin? You can't. If you try this:sub lunch { my (@stooges, @sandwiches) = @_;then all six elements go into
@stooges and @sandwiches gets nothing.The answer is to use references, as in:
lunch( \@stooges, \@sandwiches ); sub lunch { my $stoogeref = shift; my $sandwichref = shift; my @stooges = @{$stoogeref}; my @sandwichref = @{$sandwichref}; ... }
Subscribe to:
Posts (Atom)