Perl

Principales aplicaciones de Perl:

• Administración de sistemas
• Desarrollo web
• Programación en red
• Desarrollo de GUI
• ...

Algunas características

• Combina características de shell, awk y sed con otros lenguajes de alto nivel
• Soporte de distintos paradigmas de programación (imperativa, orientada a objetos y funcional)
• Potente sistema de procesamiento de texto mediante expresiones regulares
• Enorme colección de módulos disponibles

Ejecución de un script Perl

• Directamente en la línea de comandos:

  # Renombra *.txt a *-2010.txt
  $ perl -e 'foreach (<*.txt>) 
  >  { s/\.txt$//; rename("$_.txt", "$_-2010.txt") }'
  

• En un script

  #!/usr/bin/perl
  use strict;   # Exige predeclarar las variables (my)
  use warnings; # Avisa de posibles errores
  #
  # Abre el fichero de contraseñas y lee cada línea.
  my $filename = "/etc/passwd";  # Nombre del fichero
  open(FILE, "<", $filename)     # Abre el fichero (solo lectura)
    or die "No puedo abrir: $!"; # Termina si falla  
  while(my $line = <FILE>) {     # Lee cada línea
  	print $line;
  }
  close(FILE);                  # Cierra el fichero
  

Tipos de datos en Perl

1. Escalares (números o strings)

   $a = "manzanas";
   $b = "peras";
   print $a." y ".$b."\n"; # Muestra "peras y manzanas"
   print "$a y $b\n";      # Muestra "peras y manzanas"
   

2. Arrays

   @frutas = ("naranjas", "limones", "uvas");
   print $frutas[2];       # uvas
   ($n, $l) = @frutas;     # $n="naranjas", $l="limones"
   push(@frutas, "cocos"); # $frutas[3] = "cocos"
   $c = pop(@frutas);      # $c = "cocos"
   $nf = scalar(@frutas);  # $nf = 3
   $fr = "@frutas";        # $fr = "naranjas limones uvas"
   @fo = split(/ /, $fr);  # @fo = ("naranjas", "limones", "uvas")
   

3. Mapas (arrays asociativos)

   %edad_de = {
       Eva  => 23,
       Ana  => 19,
       Oscar => 41
   }
   print $edad_de{Ana};    # Imprime 19
   $edad_de{Eva}=18;       # Cambia un valor
   $edad_de{Juan} = 26;    # Añade un elemento al mapa
   

4. Variables especiales
   • $_ Variable por defecto (la mayoría de las funciones de Perl toman $_ como argumento por defecto)
   • @ARGV array con los argumentos de la línea de comandos
   • %ENV Mapa con las variables de entorno

Control de flujo

Lazos

foreach (@frutas) { # Recorre el array
    print $_."\n";  # Imprime un elemento por
                    # línea. El punto concatena
}                   # dos strings.

print "\nAñade más frutas ";  # Imprime un mensaje
$a = <STDIN>;                 # Lee de la entrada estándar
chop $a;                      # y elimina el \n 
while ( $a ) {		# Si la entrada no está vacía 
    push(@frutas, $a);	# añádela al array
    $a = <STDIN>; chop $a;    # y lee una nueva entrada
}

Condicionales

if ( not $tengo_manzanas ) {      
  compra(\@frutas,"manzanas" ); # El array se pasa por 
}                               # referencia

Alternativa:

unless ($tengo_manzanas) {
  compra(\@frutas,"manzanas");
}

También es válido:

compra(\@frutas,"manzanas") if not $tengo_manzanas;

Subrutinas

• Los parámetros se recogen en @_

sub compra {
    ( $array, $string ) = @_; # Los parametros se recogen 
                              # como escalares
    push(@$array, $string);   # La referencia se convierte 
                              # a array
}

Expresiones regulares

             # Sin argumentos, lee la entrada estandar
while(<>) {  # con argumentos, usa estos como nombres 
             # de ficheros y los lee línea a línea
  print if /http:\/\//; # Muestra las líneas con http://
  print if s/ttx/txt/ig; # Muestra las líneas con "ttx"
                         # y hace el cambio por "txt"
			 # g=global, i=case insensitive
}

$string = "oCme mas futra";
$string =~ s/oCme/Come/;  # =~ Aplica sustitución a $string
$string =~ s/futr/frut/;
print $string; # Imprime "Come mas fruta"

Ejemplos

1. Muestra las terminaciones de los ficheros del directorio actual

   #!/usr/bin/perl
   use strict; 
   use warnings;
   foreach (glob("*")) {       # Recorre los ficheros
       my @file = split(/\./); # Los separa por .
       my $term = pop(@file);  # Extrae el último elemento
       print "$term\n";
   }
   

2. En un directorio, renombra *.xml a *.html

   #!/usr/bin/perl
   use strict; 
   use warnings;
   unless (scalar(@ARGV) == 1) {
     print "Necesito un directorio como argumento\n"; exit 1;
   }
   if( not -d $ARGV[0] ) {
     print "$ARGV[0] no es un directorio\n"; exit 1;
   }
   # Cambia al directorio
   chdir $ARGV[0]; 
   # Recorre los ficheros .xml         
   foreach my $file (glob "*.xml") { 
     # Construye el nuevo nombre
     my $new = substr($file, 0, -3) . "html";
     # Renombra los ficheros
     rename $file, $new;
   }
   

3. Lee un fichero de texto numerando las líneas no vacías

   #!/usr/bin/perl
   use strict; 
   use warnings;
   open(my $fichero, "<", "f.txt") 
        or die "No puedo abrir f.txt:$!";
   my $nl="001"; # Entero de tres dígitos
   while(<$fichero>) {
     if(!/^$/) {        # Sólo las líneas no vacías
       print "$nl $_";  # Pon un número de línea
       $nl++; 
     }
     else {
       print "$_";      # Línea vacía sin número
     }
   }
   

4. Script para añadir usuarios al sistema

   use strict; use warnings;
   # Módulo para leer parámetros de entrada
   use Getopt::Long;  
   my $addusr = "/usr/sbin/adduser";
   my $nombre=""; my $apellido="";
   # Obtiene los parámetros
   GetOptions("nombre=s" => \$nombre, 
        "apellido=s" => \$apellido ) or uso(); 
   # Comprueba los parámetros sean correctos
   if( not $nombre or not $apellido ) {     
       uso();
   }
   if ( $nombre !~ /^[a-zA-Z]+$/) {         
       uso("El nombre debe ser alfabético");
   }
   if ( $apellido !~ /^[a-zA-Z]+$/) {  
       uso("El apellido debe ser alfabético");
   }
   

   # Construye el username 
   my $username = lc( substr($apellido, 0, 1) . $nombre);  
   # Directorio HOME 
   my $home     = "/home/$username";
   # Comando a ejecutar
   my $comando = qq($addusr --home $home --disabled-password \\
               --gecos "$nombre $apellido" $username);
   system $comando; # Ejecuta el comando
   
   # Error e información de uso
   sub uso {
     my ($msg) = @_;      # Recogo los parámetros
     if ($msg) {          # Si se pasa un mensaje de error, 
        print "$msg\n\n"; # lo muestra
     }
     print "Usar: $0 --nombre Nombre --apellido Apellido\n";
     exit;
   }
   

Referencias

• The Perl Directory: página principal de Perl
• Perl programming documentation: extensa documentación
• Comprehensive Perl Archive Network: módulos y documentación de Perl
• The CPAN search site: para buscar en el CPAN