Implementando una clase en Perl

Acabamos de implementar un objeto de la clase PDB usando registros y subrutinas, ahora lo haremos usando la sintaxis propia de la programación orientada a objetos. Para ello debemos crear un paquete .pm que contendrá el código de la clase. Como ejemplo os muestro la clase PDB, contenida en el archivo PDB.pm , donde veréis que usamos la función bless que permite distinguir al intérprete entre referencias y objetos:

package PDB;   # se incluye en otro programa con 'use PDB.pm;'

use strict;

sub PDB::constructor  # en ingles este metodo suele llamarse 'new'
{
	# autoreferencia a la clase y atributos como parametros
	my($clase,$nombre,$n_de_cadenas,$archivoPDB) = @_;

	# implementacion de atributos como una tabla asociativa
	my $objeto = {
		'nombre' => $nombre,              
		'ncadenas' => $n_de_cadenas,
		'archivo' => $archivoPDB,
		'coordenadas' => [],
	};
	
	# podria haber sido como un arreglo, mas eficiente, pero menos obvio el contenido 
	#$objeto->[0] = $nombre;
	#$objeto->[1] = $n_de_cadenas;
	#$objeto->[2] = $archivoPDB;
	#$objeto->[3] = [];
		
	bless($objeto,$clase); # la funcion bless da caracter de objeto a la referencia $objeto

	return $objeto;
}

sub PDB::pon_nombre_archivo
{
	my($objeto,$archivoPDB) = @_;
	$objeto->{'archivo'} = $archivoPDB;
}


sub PDB::leer_archivoPDB   
{
	# autoreferencia al objeto y parametros
	my($objeto, $comprimido) = @_;
	
	# variables locales
	my @coordenadas = ();
	
	if(!$objeto->{'archivo'}) 
	{ 
		print "'archivo' no esta definido\n";
		return 0; 
	}
	
	if($comprimido == 1)
	{
		open(PDB,"zcat $objeto->{'archivo'} |") || warn "no puedo leer zcat $objeto->{'archivo'}\n";
	}
	else
	{
		open(PDB,"$objeto->{'archivo'}") || warn "no puedo leer $objeto->{'archivo'}\n";
	}
	
	while(<PDB>)
	{
		if(/^ATOM/||/^TER/)
		{
		 	push(@coordenadas,$_);
		}
	}
	close(PDB);
	
	$objeto->{'coordenadas'} = [ @coordenadas ];
	
	return scalar(@coordenadas); 
}

sub PDB::imprime_coordenadas
{
	my($objeto) = @_;
	print @{ $objeto->{'coordenadas'} };
}

1;

A continuación os muestro la clase derivada PDBdna, contenida en un archivo llamado PDBdna.pm , que hereda de la clase PDB y sólo modifica el método leer_archivoPDB:

package PDBdna;   # se incluye en otro programa con 'use PDBdna.pm;'

use strict;

# clase derivada de PDB, especializada en representar ADN
use PDB;
use vars '@ISA';
@ISA = 'PDB';

# redefino el metodo leer_archivoPDB, para tener en cuanta solo los
# atomos de ADN

sub PDBdna::leer_archivoPDB   
{
	# autoreferencia al objeto y parametros
	my($objeto, $comprimido) = @_;
	
	# variables locales
	my @coordenadas = ();
	
	if(!$objeto->{'archivo'}) 
	{ 
		print "'archivo' no esta definida\n";
		return 0; 
	}
	
	if($comprimido == 1)
	{
		open(PDB,"zcat $objeto->{'archivo'} |") || warn "no puedo leer zcat $objeto->{'archivo'}\n";
	}
	else
	{
		open(PDB,"$objeto->{'archivo'}") || warn "no puedo leer $objeto->{'archivo'}\n";
	}
	
	while(<PDB>)
	{
		# lee solo atomos de ADN
	   if((/^ATOM/ && substr($_,18,1) eq " " && substr($_,19,1) =~ /A|G|C|T/) || /^TER/)
		{
		 	push(@coordenadas,$_);
		}
	}
	close(PDB);
	
	$objeto->{'coordenadas'} = [ @coordenadas ];
	
	return scalar(@coordenadas); 
}


1;

Finalmente, os muestro un ejemplo que deberéis probar donde se utilizan estas clases:

#!/usr/bin/perl -w 
# Ejemplo escrito por Bruno Contreras

use strict;

use PDB;      # incluye PDB.pm
use PDBdna;   # incluye PDBdna.pm, en el mismo directorio

my $pdb1 = PDB->constructor('1lfu',3,'bioinfoPerl/problemas/1lfu.pdb');
$pdb1->leer_archivoPDB(0);
$pdb1->imprime_coordenadas();