Ya teniendo varios años programando en Perl, pudiera decirse que el lenguaje no tenía nada nuevo que aportar (que arrogante, ¿nó?) pero después de leer el libro “Learning Perl Objects References & Modules“, aprendí que no podía estar más equivocado. El libro es una referencia sólida, con buenos ejemplos acerca de como trabajar con aspectos complicados pero indispensables del lenguaje como:
- Uso de referencias y su uso estructura de datos complicadas
- Uso de referencias para el manejo de funciones, funciones de ‘callback’.
- Uso de referencias anónimos (clave para otros tópicos avanzados, como objectos).
- Módulos y objetos: es el tratamiento más limpio que he leido hasta la fecha de como hacerlo bien en Perl. Por ejemplo, si bien el autor se pasa un poco de la raya diciendo que Perl ofrece más libertad que otros lenguajes menos flexibles como Java o C++ en la declaración de constructores este se molesta en explicar de manera detallada su punto de vista. Para cualquiera que haya hecho objetos con Perl estas explicaciones son simplemente invaluables.
- Como serializar estructuras compkejas como los módulos standares Data::Dumper y Storable.
- Unit testing con Test::More
Hay otros tópicos que son menos centrales pero pudieran serle útiles como:
- Hacer una distribución de un módulo con h2xs (hay diferencias más que sutiles entre el código generado entre Perl 5.6.q y 5.8.0)
- Como publicar un módulo en CPAN.
Sin embargo el libro no es perfecto; El autor se enfoca muchas veces en sintaxis arcanas que sólo un programador en Perl podría usar (sin considerar que mucha gente está acosumbrada a trabajar con otros lenguajes como C, Java, Python, etc) y que esos cambios son molestos. Otros trucos como su “Schwartzian transform” me parecen que son demasiado engorrosos como para ser utilizados más de una vez (preparese para defender ese tipo de programación si la utiliza en su código). Finalmente, nunca me gustó la “Isla de Gilligan” (lea el libro y entenderá porqué 
).
Pese a sus fallas, el libro en mi opinión es uno de los tratados del tema más completos que he leido hasta ahora y si usted programa en Perl, debería ser una referencia obligada en su biblioteca.
Para darle algo que pensar, aqui le dejo el código de un programa en Perl (CGI) que escribí hace poco (por hobby) el cual utilizando ‘SNMP get table’ obtiene valores de ejecución de un servidor que está corriendo un agente Net-SNMP. Sólo probé el código en Apache + Linux Fedora Core 2, así que no sé que tan lejos pueda llegar utilizandolo en otro lado:
#!/usr/bin/perl
use strict;
use CGI qw(:standard);
use CGI::Carp qw(fatalsToBrowser);
use Net::SNMP;
my $cgi = new CGI;
my %test_oid = (
"disk space" => ".1.3.6.1.4.1.2021.9",
"load" => ".1.3.6.1.4.1.2021.10",
"mailq" => ".1.3.6.1.4.1.2021.53",
"free" => ".1.3.6.1.4.1.2021.54"
);
print $cgi->header();
my $url = $cgi->url();
my @oids = keys %test_oid;
my %config;
my @machines;
my $conf_file = $cgi->path_translated() . "instantCheck.conf";
read_config_file(\%config, \@machines, $conf_file);
print $cgi->start_html("Verify the status of a machine on real time: " . $cgi->script_name());
if (! defined $cgi->param("printresults")) {
print $cgi->p("Please select the machine you want to inspect and choose a type of report to display:"),
$cgi->start_form(-action => $url, -method => "POST"),
$cgi->scrolling_list(
-name => "machines",
-value => \@machines,
-multiple => "1"
),
$cgi->br(),
$cgi->checkbox_group(
-name => "oids",
-value => \@oids,
-default => ["disk space"]
),
$cgi->br(),
$cgi->hidden(-name => "printresults", -value => "1"),
$cgi->submit(),
$cgi->reset(),
$cgi->end_form();
} elsif ( (defined $cgi->param("machines")) && (defined $cgi->param("oids")) ) {
print "
\n";
foreach my $machine ($cgi->param("machines")) {
print $cgi->h1("Results for: $machine");
my $session;
my $error;
($session, $error) = Net::SNMP->session(
-hostname => $machine,
-version => $config{"snmp.version"},
-timeout => $config{"snmp.timeout"},
-community => $config{"snmp.community"});
if ($error) {
warn "[ERROR]: There was an error: $error";
} else {
foreach my $oid ($cgi->param("oids")) {
if (! defined $test_oid{$oid}) {
warn "Unknown OID";
next;
}
print $cgi->b("$oid: \n");
my $result = $session->get_table(
-baseoid => $test_oid{$oid}
);
if ($session->error()) {
my $error = $session->error();
warn "[ERROR]: There was an error: $error";
next;
}
pretty_print($oid, $result, $cgi);
%$result = ();
}
print $cgi->br();
}
if (defined $session) {
$session->close();
}
}
print "
\n";
print $cgi->a({-href => $url}, "Click here to check other machines.");
} else {
print $cgi->h1("Please provide a machine and a test to perform and try again!"),
$cgi->a({-href => $url}, "Click here to check other machines.");
}
print $cgi->end_html();
# *******************************************
# ************* SCRIPT ROUTINES *************
# *******************************************
# Read the script configuration file
sub read_config_file {
my $hash_ref = $_[0];
my $machines = $_[1];
my $file_name = $_[2];
open(FILE, $file_name) || die "'$file_name', $!";
while () {
chomp($_);
if ($_ =~ /^#/) {
next;
}
my ($key, $value) = split ('=', $_);
if ($key !~ /machines/) {
$hash_ref->{$key}=$value;
} else {
@{$machines} = split(',', $value);
}
}
close(FILE);
}
sub pretty_print {
my $oid = $_[0];
my $result = $_[1];
my $cgi = $_[2];
if ($oid eq "load") {
printf "%10s %10s %10s\n", $result->{$test_oid{"$oid"} . ".1.2.1"}, $result->{$test_oid{"$oid"} . ".1.2.2"}, $result->{$test_oid{"$oid"} . ".1.2.3"};
printf "%10f %10f %10f\n", $result->{$test_oid{"$oid"} . ".1.3.1"}, $result->{$test_oid{"$oid"} . ".1.3.2"}, $result->{$test_oid{"$oid"} . ".1.3.3"};
} elsif ($oid eq "disk space") {
my $disks = scalar(keys %{$result})/12; # We receive 12 parameters with each reading...
printf "%20s %20s %20s %20s %20s\n", "Disk name", "Total space", "Available space", "Used space", "Percentaje used";
for (my $idx=1; $idx <= $disks; $idx++) { my $used=$result->{$test_oid{"$oid"} . ".1.8." . $idx};
my $free=$result->{$test_oid{"$oid"} . ".1.7." . $idx};
my $total=$result->{$test_oid{"$oid"} . ".1.6." . $idx};
printf "%20s %20s %20s %20s %20f\n", $result->{$test_oid{"$oid"} . ".1.3." . $idx}, $total, $free, $used, (($free/$used)*1.0);
}
printf "\n";
} else { # There is no filter for this OID. Display it "as is"
# Create and index for the data. We require than the output to come in an ordered way
my %index;
foreach my $key (keys %{$result}) {
my $fixedkey = $key;
$fixedkey =~ s/\.//g;
$index{$fixedkey}=$key;
}
foreach my $key (sort {$a <=> $b} keys %index) {
print ("$result->{$index{$key}}\n");
}
}
}
__END__
=head1 NAME
instantCheck.cgi - A script to get immediate stats of a given machine without loging in.
=head1 DESCRIPTION
Simply copy this script to your web server cgi-bin directory and change it permissions to 755.
Then create a configuration file like the following one:
# SNMP community string for version 1, 2c. It is assumed to be common for all the involved machines
snmp.community=test
# Version used to ask the agent. It is assumed to be common for all the involved machines
snmp.version=2
# SNMP operation timeout
snmp.timeout=60
# List of machines to poll
machines=localhost,localhost.localdomain
If you need to parse a given output, check for the 'pretty_print' routine. One way to get it right is to use snmpwalk on Linux
if available:
snmpwalk -v 1 -c XXXX -On servername .1.3.6.1.4.1.2021.9
=head1 REQUIREMENTS
This script requires the following Perl modules:
=over 4
=item CGI >= 2.38
=item CGI::Carp >= 2.38
=item Net::SNMP >= 5.0.1
=cut
The CGI was also tested only on Perl 5.8.0 so it is probably that will not work on older versions of Perl.
=head1 LICENCE
This code is covered under the GNU GPL License.
=head1 AUTHOR
José Vicente Núñez Zuleta (josevnz@users.sourceforge.net). RHCE, SCJD, SCWCD.
=cut
Sin categoría
Comentarios recientes