Perl con Mysql

Hola, aqui les facilito un Perl Script creado por mi

este scripcito lo que hace es conectarse a Mysql y hacer unas subconsultas simples, pueden editarlo a su preferencia o mejorarlo

El script consta de un programa principal y 1 modulo, dicho modulo contiene funciones classes con sus respectivos objetos.

Besos :-*

Programa Principal :::

Código:

#!/usr/bin/perl
use strict;
use warnings;
use lib "/home/marian";
use dependencia;
our @todo = qw(peticion);

my $a = $todo[0];

sub Menu {
do {
print STDOUT "/\/\/\/\/\/\ MYSQL CONECTOR /\/\/\/\/\/\/\/\/ \n";
print STDOUT "----------------------------------------------\n";
print "1 - Ver Base de datos disponible\n";
print "2 - Ver Tablas Disponibles\n";
print "3 - Ver registros de una Tabla\n";
print "4 - Salir\n";

chomp (my $respuesta = <STDIN>);

if ($respuesta == 1) {
	eval $a->db;
}
elsif ($respuesta == 2) {
	eval $a->tablas;
}
elsif ($respuesta == 3) {
	eval $a->registros;
}
elsif ($respuesta == 4) {
	exit(1);
}
elsif ($respuesta eq "") {
	print "Usted debe seleccionar algo\n";
	return Menu();
}
} while (1);
} & Menu;

exit 0;

Modulo que lo acompana ::

Código:

package dependencia;
use strict;
use Mysql;
require "prueba.pl";

sub main {
my $conexión = Mysql->connect("localhost", "primaria", "marian", "123") || die "$!\n";
$conexión->selectdb("primaria") or return "Error";
};

sub peticion::db {
do main();
if (!(main)) {
	print "Error:: No se pudo conectar\n";
	exit(1);
}
else {
my @a = main->listdbs();
	print "La Base de datos disponibles son ::   ";
	print "@a\n";
}
};

sub peticion::tablas {
do main();
if (!(main)) {
	print STDOUT "Error:: No se pudo conectar\n";
	exit(1);
}
else {
my @a = main->listtables();
	print "Las Tablas Disponibles son ::  ";
	print "@a\n";
}
};

sub peticion::registros {
do main();
if (!(main)) {
	print STDOUT "Error:: No se pudo conectar\n";
	exit(1);
}
else {
	print STDOUT "Indique el nombre de la Tabla ::  ";
	my $respuesta = <STDIN>;
	chop $respuesta;
my $a = main->query("SELECT * FROM $respuesta;");
	print "Los Registros de $respuesta son ::  \n";
while ( my @b = $a->fetchrow) {
	print "@b\n";
}
}
};

return 0;