Perl Maven Cookbook v0.01
Perl Maven Cookbook v0.01
Perl Maven Cookbook v0.01
version 0.01
Gabor Szabo
http://perlmaven.com/
print "$msg\n\n"; } print "Usage: $0 --fname FirstName --lname LastName --run\n"; exit; }
$ perl diskspace.pl ; df / Total Size: 48062440 K Available: 38720692 K Used: 9341748 K Percent Full: 20 % Total available to me: 36279216 K Filesystem /dev/sda1 1K-blocks 48062440 Used Available Use% Mounted on 9341748 36279216 21% /
# # Run the script in a cron job # # 1) Report to Boss if there are people with large files # # 2) If a user has a file that is too big then ask him to remove the # large e-mail from the mail server via web access # This one has not been implemented yet # ###################################################### use Mail::Sendmail qw(sendmail); use Filesys::DfPortable qw(dfportable); ################## Limit Definitions # the size of the /var/spool/mail/username file in bytes my $report_to_boss_limit = 1_000_000; my $report_to_user_limit = 500_000; my $domain = '@company.com'; my $boss_email = 'boss@company.com'; my $from_email = 'Disk Usage Report <sysadmin@company.com>'; my $disk_space_percantage = 80;
my %file_size; # each user has a file in that directory foreach my $path (glob "/var/spool/mail/*") { if ($path =~ /Save/) { # disregard the Save directory next; } if ($path =~ /\.pop$/) { # disregard temporary .pop files next; } $file_size{$path} = -s $path; }
my $txt = ""; # sort files by size foreach my $path (sort {$file_size{$b} <=> $file_size{$a}} keys %file_size) { my $name = $path; $name =~ s{/var/spool/mail/}{}; if ($file_size{$path} > $report_to_boss_limit) { $txt .= "$name\t\t" . int ($file_size{$path}/1_000_000) . " MB\n"; } if ($file_size{$path} > $report_to_user_limit) { my $msg = "You are currently using $file_size{$path} bytes\n"; $msg .= "Please reduce it to under $report_to_user_limit\n"; sendmail ( To => "$name$domain", From => $from_email, Subject => 'Disk Usage Report' . localtime(), Message => $msg,
5
); } } my @disks = qw(/ /boot); foreach my $disk (@disks) { my $df = dfportable($disk, 1024); if ($df->{per} > $disk_space_percantage) { $txt .= "\n\nDiskspace is low\n\nUsing "; $txt .= $df->{per} . "\% of the space on $disk\n"; } } if ($txt) { $txt = "Disk Usage of /var/spool/mail on the incoming mail server\n" . "Reporting users over $report_to_boss_limit bytes\n\n" . $txt; sendmail ( To => $boss_email, From => $from_email, Subject => 'Disk Usage Report' . localtime(), Message => $txt, ); }
my $text = <<'END_TEXT'; <html> <head> <title>Hello</title> </head> <body> <h1>World</h1> </body> </html> END_TEXT my %opt; GetOptions(\%opt, 'from=s', 'to=s', 'cc=s', 'subject=s', 'textfile=s', 'smtp=s', ) or pod2usage(); if (not $opt{from} or not $opt{to} or not $opt{subject} ) { pod2usage(); } if ($opt{textfile}) { $text = read_file( $opt{textfile} ); } send_files(\%opt, $opt{subject}, $text, @ARGV); sub send_files { my ($opt, $subject, $message_body, @files) = @_; my $msg = MIME::Lite->new( From => $opt->{from}, To => $opt->{to}, Cc => $opt->{cc}, Subject => $subject,
7
Type => 'multipart/mixed' ) or die "Error creating multipart container: $!\n"; $msg->attach( Type => ($message_body =~ /<html>/ ? 'text/html' : 'text/plain'), Data => $message_body ) or die "Error adding the text message part: $!\n"; foreach my $filename (@files) { $msg->attach( Type => ($filename =~ /\.xls$/ ? 'application/xls' : 'text/plain'), Path => $filename, Filename => basename($filename), Disposition => 'attachment' ) or die "Error adding $filename: $!\n"; } if ($opt->{smtp}) { $msg->send('smtp', $opt->{smtp}, Timeout => 60) or die $!; } else { $msg->send or die $!; } return; } =head1 SYNOPSIS Sending and e-mail with or without attachements perl send_files.pl --from from@company.com --to to@company.com --subject "Subject line" report.xls --textfile path/to/content.txt --smtp HOSTNAME
=cut
foreach my $sheet ($xls->sheets) { while ($sheet->has_data) { my @data = $sheet->next_row; print join "|", @data; print "\n"; } }
class device name address class alias device name address class owner device name address class
= = = = = = = = = = = = = = =
B 234224 Big Blue 115.6.69.8 B Foxbox 234235 Big Green box 115.6.79.1 G Boss 334235 Small Yellow 115.6.79.10 Y
examples/applications/process_config.pl #!/usr/bin/perl use strict; use warnings; =head1 DESCRIPTION File have sections separated by empty lines Each section has several field = value entries like this: Given a value of the name field print out all the values in this section device name address class =cut if (@ARGV != 2) { die "\n Usage: $0 filename name\n } my ($filename, $name) = @ARGV; = = = = 234234 Big 115.6.79.8 B
Try:
$0 examples/config.txt Big\n\n";
open(my $fh, "<", $filename) or die "Could not open '$filename' $!"; my %data; while (my $line = <$fh>) { chomp $line; if ($line =~ /^\s*$/ and %data) { if ($data{name} eq $name) { foreach my $k (keys %data) { printf "%-10s = %s\n", $k, $data{$k}; } exit; }
10
%data = (); } else { my ($field, $value) = split /\s*=\s*/, $line; $data{$field} = $value; } }
examples/applications/process_fields.pl #!/usr/bin/perl use strict; use warnings; use Text::CSV_XS qw(); use Data::Dumper qw(Dumper); my $filename = shift or die "Usage: $0 FILENAME\n"; open(my $fh, "<", $filename) or die "Could not open '$filename': $!"; my $csv = Text::CSV_XS->new; my $key = "Name"; my $header = <$fh>; chomp $header; $csv->parse($header); my @header = $csv->fields; my %data; while (my $line = <$fh>) { chomp $line; $csv->parse($line); my @cols = $csv->fields; my %h; @h{@header} = @cols; $data{$h{$key}} = \%h; } print Dumper \%data;
11
This is a simple Perl script that should be installed to a CGIExec enabled directory of Apache. When the user hits this page the first time it displays a white page with only entry-box and a submit button
12
on it. the user can fill the box, examples/applications/html.pl #!/usr/bin/perl use strict; use warnings; use CGI; use HTML::Template; my $template = HTML::Template->new(filename => "examples/html.tmpl"); my $q = CGI->new; print $q->header;
examples/applications/xml_simple.pl
13
#!/usr/bin/perl use strict; use warnings; use XML::Simple qw(XMLin); my $xml = XMLin("examples/simple.xml", ForceArray => 1); #use Data::Dumper qw(Dumper); #print Dumper $xml; #exit; print join "-", keys %{$xml->{person}}; print "\n"; foreach my $id (keys %{$xml->{person}}) { printf "%-10s %-10s %-10s\n", $xml->{person}{$id}{fname}[0], $xml->{person}{$id}{lname}[0], $xml->{person}{$id}{idnum}[0]; }
use warnings; use Getopt::Long qw(GetOptions); use DBI qw(); my $action; GetOptions("action=s" => \$action); if (not $action or $action !~ /^(insert|selecta|selecth)$/) { print <<"USAGE"; Usage: $0 --action insert|selecta|selecth USAGE exit; } my $dbfile = "sample.db"; my $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile","","", {}); if ($action eq "insert") { insert(); } if ($action eq "selecta") { fetch_arrays(); } if ($action eq "selecth") { fetch_hashref(); }
sub insert { my @people = ( ['Foo', 'Bar'], ['Apple', 'Pie'], ); foreach my $person (@people) { $dbh->do("INSERT INTO people (id, fname, lname) VALUES(?, ?, ?)", undef, 1, @$person); } return; } sub fetch_arrays { my $sth = $dbh->prepare("SELECT lname, fname FROM people WHERE id = ?"); $sth->execute(1); while (my @result = $sth->fetchrow_array()) { print "lname: $result[0], fname: $result[1]\n"; } $sth->finish; return; } sub fetch_hashref { my $sth = $dbh->prepare("SELECT lname, fname FROM people WHERE id = ?");
15
$sth->execute(1); while (my $result = $sth->fetchrow_hashref("NAME_lc")) { print "lname: $result->{lname}, fname: $result->{fname}\n"; } $sth->finish; return; }
2.14. Net::LDAP
examples/applications/ldap.pl #!/usr/bin/perl use strict; use warnings; use Net::LDAP; my $server = "ldap.itd.umich.edu"; my $ldap = Net::LDAP->new( $server ) or die $@; $ldap->bind; my $result base filter attr ); = $ldap->search( => "", => "(&(cn=Jame*) (sn=Woodw*))", => ["mail"],
$result->code && die $result->error; printf "COUNT: %s\n", $result->count; foreach my $entry ($result->entries) { $entry->dump; } print "===============================================\n"; foreach my $entry ($result->entries) { printf "%s <%s>\n", $entry->get_value("displayName"), ($entry->get_value("mail") || ''); $entry->add ( "nephew" => "Foo Bar" ); $entry->replace ( "mail" => 'foo@bar.com'); my $res = $entry->update($ldap); if ($res->code) { warn "Failed to update: " . $res->error . "\n"; }; } my $res = $ldap->add( 'cn=root, o=University of Michigan, c=US', attr => [
16
cn => 'Foo Bar', ou => 'My Place in the Universe', mail => 'mail@address.com', ], ); if ($res->code) { warn "Failed to add: " . $res->error . "\n"; } $ldap->unbind;
2.15. Tie::File
examples/applications/tie.pl #!/usr/bin/perl use strict; use warnings; use Tie::File; tie my @file, 'Tie::File', "data.txt" or die $!; $file[7] = "Hello";
17
3. Book
3.16. Simple Database access using Perl DBI and SQL
While in most fields Perl adheres to the concept of TMTOWDI,in accessing relation databases Perl has a de-facto standardcalled DBI or Database independent interface for Perl. Architecture The Perl scripts use DBI which in turn uses the appropriateDatabase Driver (e.g. DBD::Oracle for Oracle , DBD::Pg for PostgreSQL and DBD::SQLite to access SQLite ). Those drivers are compiled together with the C client librariesof the respective database engine. In case of SQLite, of course all thedatabase engine gets embedded in the perl application. It is very hard to improve on the lovely ASCII-art that comeswith the documentation of DBI so let me reproduce it here: |<- Scope of DBI ->| .-. .--------------. .-------------. .-------. | |---| XYZ Driver |---| XYZ Engine | | Perl | | | `--------------' `-------------' | script| |A| |D| .--------------. .-------------. | using |--|P|--|B|---|Oracle Driver |---|Oracle Engine| | DBI | |I| |I| `--------------' `-------------' | API | | |... |methods| | |... Other drivers `-------' | |... `-' Simple example I'll use SQLite to demonstrate the examples. That will make itvery easy for you to try them on your computer.(e.g All versions of DWIM Perl already comewith the necessary modules.) #!/usr/bin/perl use strict; use warnings; use DBI; my $dbfile = "sample.db"; my $dsn = "dbi:SQLite:dbname=$dbfile"; my $user = ""; my $password = ""; my $dbh = DBI->connect($dsn, $user, $password, { PrintError => 0, RaiseError => 1, AutoCommit => 1, FetchHashKeyName => 'NAME_lc', }); $dbh->disconnect; We load DBI but we do not explicitly load the database driver.That will be done by DBI. The DSN (Data Source Name) is very straight forward.It contains the type of the database. That will be the clue to DBI which DBD to load.In case of SQLite, the only thing we really need is the path to the database file. The username and password fields were left empty. I think they are notrelevant at all for SQLite. The last parameter of the connect call is a reference to a hash containingsome attributes I like to set. The DBI->connect call returns a database handle object that usually we store in a variablecalled $dbh. The call to disconnect from the database is optional as itwill automatically be called when the variable
18
$dbh goes outof scope but it having it might be a clear indication that you are done with thedatabase. CREATE TABLE Of course having a connection is not enough. We need to be able to fetch data from thedatabase or insert data into the database but for our example to work first weactually need to create the tables of the database. In this case we can do this with a single command: my $sql = <<'END_SQL'; CREATE TABLE people ( id INTEGER PRIMARY KEY, fname VARCHAR(100), lname VARCHAR(100), email VARCHAR(100) UNIQUE NOT NULL, password VARCHAR(20) ) END_SQL $dbh->do($sql); The first one is just a here document of an SQL statement to CREATE TABLE.Then we call the do method of the database handle which will send theSQL statement to the database. INSERT Now let's see the real thing, inserting data: my $fname = 'Foo'; my $lname = 'Bar', my $email = 'foo@bar.com'; $dbh->do('INSERT INTO people (fname, lname, email) VALUES (?, ?, ?)', undef, $fname, $lname, $email); To insert a row we call the $dbh->do method again but instead of passingthe actual data, we put question-marks ? as place-holders. The SQL statement is followed by the word undef.That's actually the place of a hash-reference providingparameters to this specific call, similar to the attributespassed to the connect method but I think it is rarely used. That is followed by the actual values that go in place of the the place-holders. As you can see we did not have to put the place-holders in any kind of quotesnor did we have to somehow convert the values. DBI did it for us. This helps us avoid SQL injection attacks.Even if you meet someone called Bobby Tables . UPDATE For updating some data in the database we also use the do method. my $password = 'hush hush'; my $id = 1; $dbh->do('UPDATE people SET password = ? WHERE id = ?', undef, $password, $id); Nothing special here. An SQL statement with some place-holders. undefinstead of the extra attributes and the parameters to be used in place ofthe place-holders. SELECT This is by far the most interesting part of the database access. As the SELECTstatement can return a lot of rows and a lot of values in each row we cannot usea simple call to the do method.
19
Instead, there are several ways to fetch the data. I'll show here two.For both we have 3 steps: prepare the SQL statement.execute the statement with specific data and fetch the rows. From these, the prepare statement can be shared by - assuming the queriesonly differ in the data we pass to them. We create an SQL statement usingquestion marks (?) as place-holders instead of actual values. This call returns a statement handle object that we usually save in avariable called $sth. Then we call the execute method of the statement handle passing toit values that should be placed instead of the place-holders. The third step is the really interesting one.In a while loop we fetch the results, row-by row. For this we can use several methods: The fetchrow_array method will return the values of the next row in the result setas a list, that we can assign to an array. The order of the elements is as the orderof the fields in the query. (fname, lname in our case). The fetchrow_hashref method will return a reference to a hash. In the hashthe keys will be the names of the fields in the database. As different databases mightreturn these names of the fields in different cases we configured our database handlerto make sure they - the names of the fields - will always converted to lower case.(That's what the FetchHashKeyName parameter did, when connecting to the database.) my $sql = 'SELECT fname, lname FROM people WHERE id > ? AND id < ?'; my $sth = $dbh->prepare($sql); $sth->execute(1, 10); while (my @row = $sth->fetchrow_array) { print "fname: $row[0] lname: $row[1]\n"; } $sth->execute(12, 17); while (my $row = $sth->fetchrow_hashref) { print "fname: $row->{fname} lname: $row->{lname}\n"; } Exercise Take the above snippets of code. Use the first one to set up thedatabase and create a table. Then use the second one to inserta few people in the table. Finally use the last example to extract some data from the databaseand print it out. If you have any question, feel free to ask below. Thanks to sigzero for correcting a bug in the examples! Subscribe to my mailing list If you are interested getting updates when I post new articles,please subscribe to my newsletter:
20
Index
* CGI - Generate web page (2.11) (page 12) * csv - Process multi field csv file (2.9) (page 11) * database - Database access using DBI and DBD::SQLite (2.13) (page 14) * DBD - Database access using DBI and DBD::SQLite (2.13) (page 14) * DBD::SQLite - Simple Database access using Perl DBI and SQL (3.16) (page 18) * DBI - Database access using DBI and DBD::SQLite (2.13) (page 14) - Simple Database access using Perl DBI and SQL (3.16) (page 18) * df - Reporting file system diskspace usage (df) (2.2) (page 4) * du - Reporting diskspace usage on the mail server (2.3) (page 4) - A du like script (2.4) (page 6) * Excel - Read Excel file (2.6) (page 8) * GET - Fetch web page (2.10) (page 12) * HTML::Template - Generate web page (2.11) (page 12) * http - Fetch web page (2.10) (page 12) * LDAP - Net::LDAP (2.14) (page 16) * LWP::Simple - Fetch web page (2.10) (page 12) * MIME - Send files by e-mail (2.5) (page 7) * Net::LDAP - Net::LDAP (2.14) (page 16) * SQL - Simple Database access using Perl DBI and SQL (3.16) (page 18) * SQLite - Database access using DBI and DBD::SQLite (2.13) (page 14) * Tie::File - Tie::File (2.15) (page 17) * web - Fetch web page (2.10) (page 12) * XML - Parse XML file (2.12) (page 13) * XML::Simple - Parse XML file (2.12) (page 13)