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 inglés este método suele llamarse 'new'
{
	# autoreferencia a la clase y atributos como parámetros
	my($clase,$nombre,$n_de_cadenas,$archivoPDB) = @_;

	# implementación de atributos como una tabla asociativa
	my $objeto = {
		'nombre' => $nombre,              
		'ncadenas' => $n_de_cadenas,
		'archivo' => $archivoPDB,
		'coordenadas' => [],
	};
	
	# podría haber sido como un arreglo, más eficiente, pero menos obvio el contenido 
	#$objeto->[0] = $nombre;
	#$objeto->[1] = $n_de_cadenas;
	#$objeto->[2] = $archivoPDB;
	#$objeto->[3] = [];
		
	bless($objeto,$clase); # la función bless da carácter 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 parámetros
	my($objeto, $comprimido) = @_;
	
	# variables locales
	my @coordenadas = ();
	
	if(!$objeto->{'archivo'}) 
	{ 
		print "'archivo' no está 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>)
	{
		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 moléculas de ADN
use PDB;
use vars '@ISA';
@ISA = 'PDB';

# redefino aquí el método leer_archivoPDB, para tener en cuanta sólo los
# átomos de ADN

sub PDBdna::leer_archivoPDB   
{
	# autoreferencia al objeto y parámetros
	my($objeto, $comprimido) = @_;
	
	# variables locales
	my @coordenadas = ();
	
	if(!$objeto->{'archivo'}) 
	{ 
		print "'archivo' no está 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 sólo átomos 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 en Julio de 2005

use strict;

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

# os sugiero que modifiquéis el código para probar también la clase PDBdna
my $pdb1 = PDB->constructor('1lfu',3,'bioinfoPerl/problemas/1lfu.pdb');
$pdb1->leer_archivoPDB(0);
$pdb1->imprime_coordenadas();