• Obtener la cadena complementaria
• Obtener el rna
• Hallar la temperatura de fusión

NOTA: El programa que se detalla a continuación utiliza una aproximación más parecida a la programación en C que en Perl (no se utilizan expresiones regulares, hashes ni las estructuras propias de Perl como en los bucles).

En la práctica segunda se redefinen las rutinas haciéndolas de un modo "más Perl".

#!/usr/bin/perl

##
## Este programa va a permitir
##  1 - leer un fichero de DNA
##  2 - generar una cadena de DNA aleatoria.
##  3 - mostrar la cadena de DNA
##  4 - contar las bases de la secuencia
##

##  5 - hallar la cadena complementaria

# Constantes

my @BASE = ('A','T','G','C');
my $LONGITUD_DEFECTO=25;

# Declaracion de las variables que vamos a utilizar

my ($dna,$opcion);

# Vemos a ver si nos han pasado un fichero como parametro
if ($ARGV[0]) {  # Existe un primer argumento como parametro?
    $dna = carga_fichero($ARGV[0]);
}

do {
    $opcion=opcion_menu();

  SWITCH: {
      ($opcion==0) && do { last SWITCH; };
      ($opcion==1) && do { $dna=pide_y_carga_fichero(); last SWITCH; };
      ($opcion==2) && do { print formato_dna($dna); last SWITCH; };
      ($opcion==3) && do { $dna=genera_dna(); last SWITCH; };
      ($opcion==4) && do { print info_cont_dna($dna); last SWITCH; };

      print "Opcion incorrecta!\n";
  }
} until ($opcion == 0);
    
# Fin del programa

#######################
# Funcion: opcion_menu()
# 
#   Muestra un menu, y devuelve la opcion elegida
#######################

sub opcion_menu {

    my ($opcion);

    print <<"EOTXT";


************************************
******         MENU         ********
************************************
*                                  *
*  1 Carga una secuencia           *
*  2 Muentra la secuencia          *
*  3 Genera una secuencia          *
*  4 Cuenta las bases que hay      *
*                                  *
*  0 Salir                         *
*                                  *
************************************

EOTXT

    print "  Elige opcion: ";
    $opcion=<STDIN>;
    chomp $opcion;
    return $opcion;
}


#######################
# Funcion: carga_fichero(nombre_fichero);
# 
#   Carga la secuencia que haya en el fichero, y la devuelve como resultado
#######################

sub carga_fichero {
    my ($fichero) = @_;
    my ($resultado);

    return(undef) unless ( -r $fichero);

    $resultado='';
    open (DATOS,$fichero);         #### Alternativamente ######
    while (<DATOS>) {              # while($linea=<DATOS>) {
        chomp;                     #   chomp($linea);
        $resultado.=$_;            #   $resultado = $resultado.$linea; }
    }
    close DATOS;

    return $resultado;
}

#######################
# Funcion: pide_y_carga_fichero();
# 
#   Igual, pero previamente pide el nombre del fichero.
#######################

sub pide_y_carga_fichero {
    my ($fichero,$resultado);

    print "Fichero con la secuencia: ";
    $fichero=<STDIN>;
    chomp($fichero);

    $resultado=carga_fichero($fichero);

    print "Error en la carga de $fichero\n" if (! defined $resultado);

    return $resultado;
}

#######################
# Funcion: formato_dna(secuencia);
# 
#   Devuelve una cadena con la secuencia en el formato que queramos mostrar
#######################

sub formato_dna {
    my ($dna) =@_;
    return $dna;   # Ahora mismo no hace nada, la devuelve tal cual
}

#######################
# Funcion: genera_dna(longitud)
# 
#   Genera una secuencia de DNA aleatoria
#######################

sub genera_dna {
    my ($long)=@_;

    $long=$LONGITUD_DEFECTO unless $long;

    my $resultado='';
    while($long--) {
        $resultado.=$BASE[rand 4];
    }

    return $resultado;
}


sub info_cont_dna {
    my ($dna) = @_;

    my ($a,$t,$g,$c,$err,$resltdo);

    cont_dna($dna,\$a,\$t,\$g,\$c);
    $resltdo =<<"EOTXT";

Numero de A: $a
Numero de T: $t
Numero de G: $g
Numero de C: $c

EOTXT

    return $resltdo;
}

sub cont_dna {
    my ($dna,$ref_a,$ref_t,$ref_g,$ref_c)=@_;
# Ver utilidad de los hases cuando esto sea con aminoacidos y no con bases

    my ($cont,$err);
    ($$ref_a,$$ref_t,$$ref_g,$$ref_c)=(0,0,0,0);
    for ($cont=0; $cont<length($dna); $cont++) {
        (substr($dna,$cont,1) eq 'A') && do {$$ref_a++; next; };
        (substr($dna,$cont,1) eq 'T') && do {$$ref_t++; next; };
        (substr($dna,$cont,1) eq 'G') && do {$$ref_g++; next; };
        (substr($dna,$cont,1) eq 'C') && do {$$ref_c++; next; };
        $err++;
    }

    return (length $dna - $err);
}