elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: (TUTORIAL) Aprende a emular Sentinel Dongle By Yapis


  Mostrar Temas
Páginas: 1 [2]
11  Programación / Scripting / Tutorial Perl/Tk. en: 19 Noviembre 2008, 21:34 pm
Ya que no he visto referencia alguna en la web sobre tutoriales de Perl/Tk en Espanol.
Aqui presento uno como parte de mi colaboracion personal......

Que necesita tu SO para ejercer esto?

1 - El interprete Perl.

Nada mas. No es requerido que tengas las librerias TK instaladas en tu SO, ya que
en este caso utilizare el modulo Perl::Tk el cual no es mas que una implementacion
de algunos 'widgets' de Tk, mas son independientes y no requieren ni trabajan directamente
con las librerias de Tk.

Si disponemos de Perl, tenemos que bajar el Modulo Perl::Tk de la web de Cpan. Para ello abrimos
una terminal Shell y hacemos con el usuario 'root' lo siguiente.

bash$ perl -MCPAN -e shell

Si es la primera vez que ejecutas la terminal de CPAN te aparecera un cuestionario de preguntas
de configuracion.. deberas responder segun tus gustos. Al terminar entramos al interprete de cpan.

cpan>

Cuando lo veas sencillamente manda a buscar he instalar el modulo requerido.

cpan> install Tk

Cpan se encargara de buscar, bajar he instalar todo. al finalizar puedes salir de alli, y abrir un editor
para comenzar a trabajar con perl y Tk.

En el editor colocamos lo siguiente :

#!/usr/bin/perl
use strict;
use warnings;
use Tk;

Expongo.. En la primera linea '#!/usr/bin/perl' indica cual sera el interprete que llamara la aplicacion.
La segunda y tercera linea 'use strict' y 'use warnings' son 2 pragmas de Perl, estas sirven la primera para
recordarnos a codear explicitamente en un lenguaje estructurado limpio (nada de break, continue, goto, etc).
Y la segunda sirve como Debugger en caso de que queramos depurar al ejecutar el script.

La tercera linea 'use Tk' sencillamente importa el modulo 'Tk' a nuestra aplicacion.

#!/usr/bin/perl
use strict;
use warnings;
use Tk;

my $ventana = MainWindow->new();
$ventana->minsize(qw(400 400));
$ventana->resizable('FALSE','FALSE');
$ventana->Label(-text => "Hola Mundo")->pack();

MainLoop();

Guardamos todo lo anterior y ejecutamos :

bash$ perl aplicacion.pl

Se abrira una ventana con un Hola Mundo.

Explicaciones ::

my $ventana = MainWindow->new();
* En esta linea declaramos una variable 'my $ventana' que inicializa un objeto que funcionara como la ventana principal.
Perl tiene 3 tipos de declaracion para las variables, las escalares siempre comienzan con simbolo de dolar $ y guardan cualquier dato caracter o numerico, los arreglos que siempre comienzan con el simbolo arroba @ y por igual guardan cualquier dato caracter o numerico y las variables hash que comienzan con el simbolo % y son variables que hacen referencia a un caracter o numero .. En resumen en Perl no hay que declarar el tipo de dato a guardar dentro de una variable. (Para mas info de tipos de variables, averiguen sobre programacion en Perl).

$ventana->minsize(qw(400 400));
* En esta linea se especifica que el tamano minimo de nuestra ventana sera 400 de ancho y 400 de largo.

$ventana->resizable('FALSE','FALSE');
* EN esta linea se especifica que la ventana no podra ser reducida ni agrandada tanto por ancho como por largo.

$ventana->Label(-text => "Hola Mundo", -font => 'Courier')->pack();
* En esta linea creamos un objeto widget Label que llevara como Texto la palabra 'Hola Mundo'. Todos los objetos de Tk tienen tienen
opciones en este caso el objeto Label le estamos pasando una opcion de Texto a presentar en la ventana, en este caso 'Hola Mundo',
al objeto Label tambien le pasamos otra opcion, -font es el tipo de fuente que llevara definido nuestro 'Hola Mundo' en este caso
utilizo Courier pero igual pueden utilizar otro soportado dentro de su SO. las opciones de los objetos widgets deben ir separadas por coma.

Luego tenemos pack(), este lo que hace es encapsular o guardar el objeto Label dentro de ventana que es nuestro objeto principal. Es obligatorio encapsular el objeto dentro de la ventana padre. En caso de que obvies encapsularla.. perl no sabra donde debe guardar a Label por ende no se presentara en pantalla cuando ejecutemos el script.. ya que lo que saldra en pantalla es el objeto padre ventana y si ventana no tiene un hijo encapsulado no lo mostrara.

pack() aparte de encapsular funciona como un manejador de tamano igual que su contraparte grid().. los cuales explicare mas adelante en otro tutorial.

* MainLoop()
- En esta ultima linea creamos un Loop del objeto principal.. cual es el objetivo de esto? el objetivo es que la linea anterior se encarga de llamar y responder a todos los eventos pasados al objeto principal ventana. Si obviamos esta ultima linea nuestro objeto principal jamas se desplegara por pantalla. Ya que MainLoop maneja todos los eventos del objeto padre.


#!/usr/bin/perl
use strict;
use warnings;
use Tk;

my $ventana = MainWindow->new();
$ventana->minsize(qw(400 400));
$ventana->resizable('FALSE','FALSE');
$ventana->Label(-text => "Hola Mundo")->pack();
my $texto = $ventana->Text(-width => 20, -height => 15, -background => 'white')->pack();
my $entrada = $ventana->Entry(-width => 20, -background => 'white')->pack();
$ventana->Button(-text => "Copiar & Pegar", -command => \&copia)->pack();

MainLoop();

sub copia
{
my $resultado = $entrada->get();
$texto->insert("end", "$resultado");
}

Comentarios :

my $texto = $ventana->Text(-width => 20, -height => 15, -background => 'white')->pack();
* Aca creamos una variable escalar, que guarda un objeto widget de tipo Texto, Texto en este caso tiene 3 opciones
que es de tamano largo y ancho y su color de fondo. Utilizamos pack() al final para especificar que el objeto Text
sera encapsulado dentro del objeto padre ventana.

my $entrada = $ventana->Entry(-width => 20, -background => 'white')->pack();
* Aca creo otra variable que guarda un objeto widget de tipo Entrada, nuevamente con 2 opciones pasadas
siempre separadas por comas, las opciones indican el color de fondo y el largo que llevara el widget.

$ventana->Button(-text => "Copiar & Pegar", -command => \&copia)->pack();
* Aqui declaro un objeto widget tipo Boton, con 2 opciones una el texto a representar el boton, y la otra el
evento que realizara el boton al ser clickeado. Al ser clickeado el boton, este llamara a la funcion 'copia'

sub copia
{
my $resultado = $entrada->get();
$texto->insert("end", "$resultado");
}
* Esta es la funcion llamada cuando el boton es clickeado. Dentro de la funcion se declara una variable escalar '$resultado'
que guardara los datos insertados dentro de la variable '$entrada', recuerden que la variable '$entrada' guarda un objeto Entry cualquier info digitada aqui sera captada get() y guardada en la variable '$resultado'.

$texto->insert("end", "$resultado");
* '$texto' es la variable que guarda al objeto widget de Texto, al llamar a 'insert' este lo que le indica que insertara cierta informacion dentro del widget, en este caso se insertara la variable '$resultado'.
12  Programación / Scripting / Perl/Tk y salida Estandar en: 1 Junio 2008, 00:54 am
Hola usando de ejemplo el siguiente codigo :

Código:
#!/usr/bin/perl
use strict;
use Tk;
use Tk::NoteBook;

my $ventana = MainWindow->new();
$ventana->minsize(qw(700 400));
$ventana->maxsize(qw(700 400));
$ventana->configure(-title => "Proyecto");

my $nota = $ventana->NoteBook(-background => 'white')->pack(-fill => 'both', -expand => 1);
my $pestana = $nota->add('Uno', -label => "Uno")->pack();
my $pestana1 = $nota->add('Dos', -label => "Dos")->pack();
my $pestana2 = $nota->add('Tres', -label => "Tres")->pack();

my $frama = $pestana->Frame->pack();
$frama->Label(-text => " ")->pack();
my $texto = $frama->Scrolled('Text', -width => 80, -height => 20, -background => 'white')->pack();
$frama->Button(-text => "Ver", -borderwidth => 4, -relief => 'raised', -width => 20, -command => \&proceso)->pack(-side => 'left');
$frama->Button(-text => "Limpiar", -borderwidth => 4, -relief => 'raised', -width => 20, -command => \&proceso1)->pack(-side => 'right');

MainLoop();

sub proceso {
my $a = system("ps aux > archivo.txt");
open(AA,"<archivo.txt");
my @b = <AA>;
$texto->insert("end", "@b");
close(AA);
};

sub proceso1 {
system("rm archivo.txt");
$texto->delete('0.0', "end");
};

Mi objetivo es lograr (cosa que aun no se como) imprimir la salida estandar STDOUT de algun comando hacia el widget Text (texto), pero cuando intento digase con system("ps aux") el me imprime obviamente en la terminal que es el verdadero flujo de salida estandar STDOUT, y en el widget me imprime el valor que dicho comando devuelve, ya sea cero o uno... yo no quiero guardar en un texto primero la impresion de cierto comando y luego abrir ese texto he imprimirlo en mi widget, yo quiero saber si hay alguna via de dirigir la salida estandar a un widget texto.
13  Programación / Scripting / Perl con Mysql en: 2 Enero 2008, 17:46 pm
Hola, aqui les facilito un Perl Script creado por mi  :D  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;
14  Programación / Scripting / Mi Script de Perl y Mysql :( en: 14 Diciembre 2007, 14:53 pm
He creado un scriptcito Perl con orientacion OOP ..  soy novata con Perl todavia  :-\  mi scriptcito en cuestion funciona excepto la opcion 5 que me muestra todassss las columnas de una tabla que yo le indique, pongo el nombre de la tabla y se queda buscando y buscando y nunca me responde  :-(  no se que onda yo necesito ver que tienen las tablas dentro. Este es mi scriptcito.

Código:
#!/usr/bin/perl
use strict;
use warnings;
use prueb;
our $respuesta;
our @todo;
our @peti = qw(peticion tabla tablita tables);

print "-------- Mysql Consultas --------\n";
print "-------- Autor : M. ---------\n\n";
print "Inserte por orden y separados por espacio <NO ENTER> :\n *Nombre Host :\n *Nombre Base de datos :\n *Nombre Usuario :\n *Contrasena de Usuario :\n ";
my $opcion = <STDIN>;
chomp($opcion);
@todo = split(/\s+/, $opcion);
print "\n\n";
do {
print "1-Eliminar Tabla\n 2-Crear Tabla\n 3-Ver Listado Tablas\n 4-Ver Listado DB\n 5-Ver Registros Tabla
6-Salir\n";
print "Inserte su peticion\n";
$respuesta = <STDIN>;
chomp($respuesta);

if ($respuesta == 1) { eval $peti[1]->eliminar; }
elsif ($respuesta == 2) { eval $peti[2]->crear; }
elsif ($respuesta == 3) { eval $peti[3]->ver; }
elsif ($respuesta == 4) { eval $peti[3]->db; }
elsif ($respuesta == 5) { eval $peti[3]->registro; }
elsif ($respuesta == 6) { exit(1); };

} while (1);

exit(0);

Este es el modulito que lo acompana.

Código:
package prueb;
use strict;
use Mysql;
require "prueb.pl";
our $respuesta;
our @todo;

sub main {
my $conexión = Mysql->connect($todo[0], $todo[1], $todo[2], $todo[3]) or die "$!\n";
};

sub peticion::query {
& main();
main->selectdb($todo[1]);
main->query($respuesta) || die "$!\n";
};

sub tabla::eliminar {
print "Inserte el nombre de la tabla a Eliminar : ";
my $respuesta = <STDIN>; chomp($respuesta);
& main();
main->selectdb($todo[1]);
my $peticion = main->query("drop table if exists $respuesta;") || die "$!\n";
print STDOUT "Ejecuccion Realizada satisfactoriamente\n";
};

sub tablita::crear {
print "Inserte la sentencia SQL a ingresar\n";
my $respuesta = <STDIN>; chomp($respuesta);
do main;
main->selectdb($todo[1]);
my $peticion = main->query($respuesta) || die "$!\n";
print STDOUT "Ejecuccion Realizada satisfactoriamente\n";
};

sub tables::ver {
do main;
my @tablas = main->listtables;
print "Las tablas disponibles son @tablas\n";
};

sub tables::db {
& main();
my @datas = main->listdbs;
print "Las Base de datos disponibles en su esquema son : \n @datas\n";
};

sub tables::registro {
print "Inserte el nombre de la tabla\n";
my $respuesta = <STDIN>; chop $respuesta;
do main;
main->selectdb($todo[1]);
my $peticion = main->query("SELECT * FROM $respuesta;");
my @peti = $peticion->fetchrow();
print "Los datos de dicha tabla son \n @peti\n";
};

return 0;
15  Programación / Scripting / Script Perl para consultas Mysql en: 9 Noviembre 2007, 18:18 pm
He iniciado un simple y extenso script de perl que hace consultas y subconsultas a Mysql, Postgresql y proximamente Oracle :D

El script en si es basicamente para usuarios que no saben casi nada de SQL y esto les puede server, Bien, el script iba a ser demasiado extenso para 1 solo archivo, asi que lo dividi en varios modulos, por el momento solo publicare el script completo hacia Mysql ya que en el modulo Postgresql me faltan algunas subconsultas que completar y testear en mi PC.
 
He aqui el main.pl del script:

Código:
#!/usr/bin/perl 
 
 use strict;
 use warnings;
 use DBI;
 use Mysql;
 use mysql1;
 use msql1;
 use pgs1;
 use oracle1;
 
 
 printf " ***************************************\n ";
 printf " **************  Genesix ***************\n ";
 printf " ********** Version 1.0 **************\n ";
 printf " ********* Autor:: Marian S. *********\n" ;
 printf " Escriba la base de datos que le gustaria utilizar\n";
 printf "\n";
 printf " 1 - Mysql, 2 -Postgresql, 3 - Oracle  :  Seleccione un numero para continuar  ";
 my $opcion = <STDIN> ;
 chomp $opcion;
 if ($opcion eq 1) {  Mysql(); }
 elsif ($opcion eq 2) { Postgresql(); }
 elsif ($opcion eq 3) { Oracle(); }
 
 sub Mysql {
 my $hostname = "localhost";
 printf "Bienvenido/as al cliente de consultas Mysql :  ";
 printf "Indique que quiere hacer\n";
 printf " 1 - Crear una tabla\n";
 printf " 2 - Eliminar una tabla\n";
 printf " 3 - Crear un backup de una base de datos y todas sus tablas\n" ;
 printf " 4 - Otorgar permisos a una base de datos a un usuario\n" ;
 printf " 5 - Eliminar una Base de Datos\n";
 printf " 6 - Modificar/Alterar una tabla\n" ;
 printf " 7 - Remover permisos de una base de datos a un usuario\n";
 printf " 8 - Crear una base de datos\n";
 my $query = <STDIN>;
 chomp $query;
 if ($query eq 1) { &mysql1::mysql2(); }
 elsif ($query eq 2) { &mysql1::mysql3(); }
 elsif ($query eq 3) { &mysql1::mysql4(); }
 elsif ($query eq 4) { &mysql1::mysql5(); }
 elsif ($query eq 5) { &mysql1::mysql6(); }
 elsif ($query eq 6) { &msql1::msql2(); }
 elsif ($query eq 7) { &msql1::msql3(); }
 elsif ($query eq 8) { &msql1::msql4(); }
 } ;
 
 sub Oracle {
 printf "Bienvenido/a al cliente de consultas Oracle : ";
 printf "Especifique que desea hacer\n";
 printf " 1 - Crear una tabla\n";
 printf " 2 - Eliminar una tabla\n";
 printf " 3 - Crear un backup de una base de datos y todas sus tablas\n" ;
 printf " 4 - Otorgar permisos a una base de datos a un usuario\n" ;
 printf " 5 - bla bla\n";
 my $query = <STDIN>;
 chomp $query;
 if ($query eq 1) { &oracle1::oracle2(); };
 
 } ;
 
 sub Postgresql {
 printf "Bienvenido/a al cliente de consultas Postgresql : ";
 printf "Especifique que desea hacer\n";
 printf " 1 - Crear una tabla\n";
 printf " 2 - Eliminar una tabla\n";
 printf " 3 - Crear un backup de una base de datos y todas sus tablas\n" ;
 printf " 4 - Otorgar permisos a una base de datos a un usuario\n" ;
 printf " 5 - bla bla\n";
 my $query = <STDIN>;
 chomp $query;
 if ($query eq 1) { &pgs1::pgs2(); };
 
 } ;
 
 1;

Bien Como dije divide en modulos el programita solo publicare los modulos de Mysql, ya que los de Postgresql aun estan incompletos aunque los pocos que estan habilitados funcionan
 
Primer modulo de Mysql:

Código:
package mysql1; 
 
 my $hostname = "localhost";
 
 sub mysql2 {
 printf "Indique el nombre de la base de datos a usar : ";
 my $database = <STDIN>;
 chomp $database;
 printf "Nombre de la tabla a crear : " ;
 my $table = <STDIN>;
 chomp $table ;
 printf "Inserte los registros que tendra la nueva tabla : Ejemplo: 'nombre varchar(30), apellidos varchar(30), edad int;' : ";
 my $registro = <STDIN>;
 chomp $registro;
 printf "Indique el nombre de su usuario :  ";
 my $user = <STDIN>;
 chomp $user;
 printf "Indique su contraseña  :  " ;
 my $pass = <STDIN>;
 chomp $pass;
 my $conexión = Mysql->connect("$hostname","$database","$user","$pass") or die ("$!\n") ;
 my $select = $conexión->selectdb("$database") or die ("$!\n");
 my $peticion = $conexión->query("create table $table ($registro);") or die ("$!\n");
 };
 
 sub mysql3 {
 printf "Indique el nombre de la base de datos a usar : ";
 my $database = <STDIN>;
 chomp $database;
 printf "Nombre de la tabla a eliminar : ";
 my $delete = <STDIN>;
 chomp $delete ;
 printf "Indique el nombre de su usuario :  ";
 my $user = <STDIN>;
 chomp $user;
 printf "Indique su contraseña  :  " ;
 my $pass = <STDIN>;
 chomp $pass;
 my $conexión = Mysql->connect("$hostname","$database","$user","$pass") or die ("$!\n") ;
 my $select = $conexión->selectdb("$database") or die ("$!\n");
 my $peticion = $conexión->query("drop table if exists $delete;") or die ("$!\n");
 };
 
 sub mysql4 {
 my $backup = "/usr/bin/mysqldump";
 my $HOME = "~" ;
 my $archivo = "backup.sql";
 my $directorio = "$HOME/backup" ;
 printf "Indique el nombre de su usuario :  ";
 my $user = <STDIN>;
 chomp $user;
 printf "Indique su contraseña  :  " ;
 my $pass = <STDIN>;
 chomp $pass;
 printf "Indique el nombre de la DB de la cual se hara el backup  :  " ;
 my $table = <STDIN>;
 chomp $table;
 my $ubicacion = `cd $directorio 2>/dev/null || mkdir -p ${directorio} && cd $directorio && $backup --opt --user=$user --password=$pass $table > $archivo && tar -cvf $archivo.tar *.sql && compress $archivo.tar && rm *.sql` ;
 sprintf $ubicacion ;
 printf "El backup fue creado satisfactoriamente, Backup guardado en $directorio\n";
 };
 
 sub mysql5 {
 printf "Indique el nombre de su usuario :  ";
 my $user = <STDIN>;
 chomp $user;
 printf "Indique su contraseña  :  " ;
 my $pass = <STDIN>;
 printf "Indique el nombre del usuario que sera privilegiado : ";
 my $user1 = <STDIN>;
 chomp $user1;
 printf "Indique el nombre de la DB a la cual se le dara privilegios a dicho usuario : ";
 my $db = <STDIN>;
 chomp $db;
 printf "Privilegios a otorgar ::: \n";
 printf "1 - Garantizar todos los privilegios (Grant All)\n";
 printf "2 - Garantizar solo permisos de crear, eliminar, actualizar (Grant usage, create, update, eliminar)\n";
 printf "3 - Deseo introducir los permisos que este usuario tendra : ";
 my $eleccion = <STDIN>;
 chomp $eleccion;
 if ($eleccion eq 1) { my $conexión = Mysql->connect("$hostname", "$db", "$user","$pass") or die ("$!\n") ;
 my $select = $conexión->selectdb("$database") or die ("$!\n");
 my $peticion = $conexión->query("grant all privileges on $database.* to $user1@$hostname identified by $pass with grant option;") or die ("$!\n");
 }
 elsif ($eleccion eq 2) { my $conexión = Mysql->connect("$hostname","$database","$user","$pass") or die ("$!\n") ;
 my $select = $conexión->selectdb("$database") or die ("$!\n");
 my $peticion = $conexión->query("grant usage, create, update, drop on $database.* to $user1@$hostname identified by $pass with grant option;") or die ("$!\n"); }
 elsif ($eleccion eq 3) { printf "Introduzca los permisos a garantizar separados por comas y con espacio Ejemplo:: drop, update, alter  sin \ entrecomillar la palabra, ni finalizar con punto y coma ";
 my $opccion = <STDIN>;
 chomp $opccion;
 my $conexión = Mysql->connect("$hostname","$database","$user","$pass") or die ("$!\n") ;
 my $select = $conexión->selectdb("$database") or die ("$!\n");
 my $peticion = $conexión->query("grant $opccion on $database.* to $user1@$hostname identified by $pass with grant option;") or die ("$!\n");
 }
 };
 
 sub mysql6 {
 printf "Indique el nombre de la base de datos a Eliminar : ";
 my $database = <STDIN>;
 chomp $database;
 printf "Indique el nombre de su usuario :  ";
 my $user = <STDIN>;
 chomp $user;
 printf "Indique su contraseña  :  " ;
 my $pass = <STDIN>;
 chomp $pass;
 my $conexión = Mysql->connect("$hostname","$database","$user","$pass") or die ("$!\n") ;
 my $select = $conexión->selectdb("$database") or die ("$!\n");
 my $peticion = $conexión->query("drop database $database;") or die ("$!\n");
 };
 
 1;

Segundo Modulo del Mysql;

Código:
package msql1; 
 
 my $hostname = "localhost";
 
 sub msql2 {
 printf "Indique el nombre de su usuario :  ";
 my $user = <STDIN>;
 chomp $user;
 printf "Indique su contraseña  :  " ;
 my $pass = <STDIN>;
 chomp $pass;
 printf "Indique el nombre de la base de datos donde esta la tabla : ";
 my $database = <STDIN>;
 chomp $database;
 printf "Indique Nombre de la Tabla a utilizar : " ;
 my $table = <STDIN>;
 chomp $table ;
 printf "Que desea modificar en la Tabla\n";
 printf " 1 - Agregar un registro, 2 - Modificar un registro, 3 - Eliminar un registro ; Seleccione un numero para continuar : ";
 my $opcion = <STDIN>;
 chomp $opcion;
 if ($opcion eq 1) { Add(); }
 elsif ($opcion eq 2) { Mod(); }
 elsif ($opcion eq 3) { Drop(); }
 sub Add {
 printf "Introduzca el nuevo dato que desea agregar Ex: 'email varchar(30), edad int' insertar datos no encapsular entre comillas \
 no colocar punto y coma al final tampoco : ";
 my $data = <STDIN>;
 chomp $data;
 my $conexión = Mysql->connect("$hostname","$database","$user","$pass") or die ("$!\n") ;
 my $select = $conexión->selectdb("$database") or die ("$!\n");
 my $peticion = $conexión->query("alter table $table add ($data);") or die ("$!\n");
 sub Mod {
 printf "Indique el registro a modificar Ex: columna disponible - nombre varchar(20) - Modificamos ::  'nombre varchar(30)' - Donde el registro nombre fue cambiado la capacidad de data a guardar con varchar(30)' \ Introducir datos sin entrecomillar y sin punto y coma al final : ";
 my $seleccion = <STDIN>;
 chomp $seleccion;
 my $conexión = Mysql->connect("$hostname","$database","$user","$pass") or die ("$!\n") ;
 my $select = $conexión->selectdb("$database") or die ("$!\n");
 my $peticion = $conexión->query("alter table $table modify $seleccion;") or die ("$!\n");
 }
 sub Drop {
 printf "Introduzca la palabra/columna que desea Eliminar de la Tabla , Ex: nombre : ";
 my $data = <STDIN>;
 chomp $data;
 my $conexión = Mysql->connect("$hostname","$database","$user","$pass") or die ("$!\n") ;
 my $select = $conexión->selectdb("$database") or die ("$!\n");
 my $peticion = $conexión->query("alter table $table drop $data;") or die ("$!\n");
 }
 }
 };
 
 sub msql3 {
 printf "Indique el nombre de su usuario (ROOT para poder eliminar permisos) :  ";
 my $user = <STDIN>;
 chomp $user;
 printf "Indique su contraseña  :  " ;
 my $pass = <STDIN>;
 chomp $pass;
 printf "Indique el nombre del usuario al cual se le removeran los privilegios : ";
 my $user1 = <STDIN>;
 chomp ($user1);
 printf "Indique el nombre de la base de datos : ";
 my $database = <STDIN>;
 chomp $database;
 printf "Indique Nombre de la Tabla (por motivos de conexión) : " ;
 my $table = <STDIN>;
 chomp $table ;
 my $conexión = Mysql->connect("$hostname","$database","$user","$pass") or die ("$!\n") ;
 my $select = $conexión->selectdb("$database") or die ("$!\n");
 my $peticion = $conexión->query("revoke all privileges on $database.* from $user1@$hostname;") or die ("$!\n");
 };
 
 sub msql4 {
 printf "Indique el nombre de su usuario  :  ";
 my $user = <STDIN>;
 chomp $user;
 printf "Indique su contraseña  :  " ;
 my $pass = <STDIN>;
 chomp $pass;
 printf "Indique el nombre del usuario al cual se le removeran los privilegios : ";
 my $user1 = <STDIN>;
 chomp ($user1);
 printf "Indique el nombre de la base de datos : ";
 my $database = <STDIN>;
 chomp $database;
 printf "Indique Nombre de la Tabla (por motivos de conexión) : " ;
 my $table = <STDIN>;
 chomp $table ;
 my $conexión = Mysql->connect("$hostname","$database","$user","$pass") or die ("$!\n") ;
 my $select = $conexión->selectdb("$database") or die ("$!\n");
 my $peticion = $conexión->query("create database $database;") or die ("$!\n");
 };
 
 1;

La parte de Mysql esta practicamente completa a mi entender a lo mejor estoy obviando algo, pero por el momento cumple los objetivos de donde trabajo, varios empleados estan usando este script para hacer subconsultas y consultas rapidas a Mysql y Postgresql.

Obvio el modulo que he creado de Postgresql ya que aun esta incompleto pero las pocas funciones que hace funcionan :) dicho scriptcito esta siendo muy utilizable por ciertos empleados donde laboro, ya que se sienten a gusto con el que me han pedido que haga el mismo script pero version grafica para los usuarios de Windows, y he estado creando el mismo software en version grafica con Tk. Vere como me va hasta ahora muy positivo.

Espero que a alguien le sirva.
16  Programación / Scripting / Peque Perl Script para hacer consultas en: 8 Octubre 2007, 04:11 am
Lo que hace el aburrimiento un Perl Script para hacer consultas lol... Para quien le pueda servidr de algo :) recuerden que no soy muy limpia codeando.

#!/usr/bin/perl -w

my $usuario = "Mary" ;
my $pass = "123" ;
my $tiempo = localtime() ;
printf "Bienvenidos a PerLyDB Version 1.0\n" ;
printf "Inserte el Login   :  " ;
chomp(my $eleccion = <STDIN>);
printf "Inserte la contraseña  :  " ;
chomp(my $contraseña = <STDIN>) ;
if ($eleccion eq $usuario && $contraseña eq $pass) { principal() ; }
else {
 for(open(INTRUSOS, ">>intrusos.log")){
    my $temporal = INTRUSOS ;
    printf $temporal (" **********   Acceso Denegado      *************************\n");
    printf $temporal ("Nombre que intento ingresar al sistema : $eleccion \n") ;
    printf $temporal ("Password Utilizado para ingresar  :  $contraseña \n");
    printf $temporal ("Hora que intento ingresar al sistema  :  $tiempo  \n\n\n");
    close($temporal);
printf "Lo siento Acceso denegado\n"
}
}

sub principal {
while(1) {
printf "Bienvenidos al Sistema\n" ;
print "Cargando Opciones.....\n" ;
sleep(1) ;
printf "Que desea hacer \n" ;
printf "1 - Ver Listado de Vehiculos\n" ;
printf "2 - Ver Listado Clientes con Deudas\n" ;
printf "3 - Agregar nuevo Vehiculo \n" ;
printf "4 - Agregar nuevo cliente deudor\n" ;
printf "5 - Salir del sistema\n" ;
my $seleccion = <STDIN> ;
chomp($seleccion) ;
if ($seleccion == '1') {
vehiculos() ; }
elsif ($seleccion == '2') {
clientes() ; }
elsif ($seleccion == '3') {
agrega_auto() ; }
elsif ($seleccion == '4') {
agrega_cliente() ; }
elsif ($seleccion == '5') {
exit() ; }
else { principal() ; }
}


sub vehiculos {
for(open(INTRUSOS, "vehiculos.log")) {
my @autos = <INTRUSOS> ;
my $autos1 = @autos ;
print "Vehiculos Disponibles \n @autos \n" ;
sleep(1) ;
}
} ;

sub clientes {
for(open(INTRUSOS, "clientes.log")) {
my @clientes = <INTRUSOS> ;
print "Clientes con Deudas \n @clientes \n" ;
sleep(1);
}
}

sub agrega_auto {
for(open(INTRUSOS, ">>vehiculos.log")) {
my $temporal = INTRUSOS ;
printf "Inserte la marca del vehiculo : " ;
chomp (my $marca = <STDIN>) ;
printf "Inserte el Ano de Fabricacion : " ;
chomp (my $ano = <STDIN>) ;
printf "Inserte el precio del vehiculo : " ;
chomp (my $precio = <STDIN>) ;
print "Inserte la Placa \n" ;
chomp (my $placa = <STDIN>) ;
printf "Inserte el color \n" ;
chomp (my $color = <STDIN>) ;
printf $temporal " ----- Datos del Vehiculo -------- \n " ;
printf $temporal " Vehiculo Marca $marca  \n ";
printf $temporal " Ano de Fabricacion  $ano  \n" ;
printf $temporal " Precio Disponible  $precio \n " ;
printf $temporal " Fecha de Inclusion  $tiempo  \n" ;
printf $temporal " Color del Vehiculo  $color : " ;
printf $temporal "Placa del vehiculo $placa : " ;
printf $temporal " \n \n " ;
close($temporal) ;
}
}

sub agrega_cliente {
for(open(INTRUSOS, ">>clientes.log")) {
my $temporal = INTRUSOS ;
printf "Inserte el nombre completo del Cliente : " ;
chomp (my $clientito = <STDIN>) ;
printf "Inserte su Cedula : " ;
chomp (my $cedula = <STDIN>) ;
printf "Inserte Monto que adeuda : " ;
chomp (my $precio = <STDIN>) ;
print "Inserte Paga que debe cumplir mensual \n" ;
chomp (my $paga = <STDIN>) ;
printf "Inserte Vehiculo y Precio que compro \n" ;
chomp (my $vehiculo = <STDIN>) ;
printf "Inserte Direccion del cliente \n" ;
chomp (my $direccion = <STDIN>) ;
printf $temporal " ----- Datos del Cliente Adeudor -------- \n " ;
printf $temporal " Estimado Cliente $clientito  \n ";
printf $temporal " Residente en $direccion  \n" ;
printf $temporal " Con cedula de identidad #  $cedula \n " ;
printf $temporal " Adeuda un Monto por el valor de  $precio  \n" ;
printf $temporal " Por lo cual debe pagar mensualmente  $paga : " ;
printf $temporal " \n \n " ;
close($temporal) ;
}
}
}
17  Programación / PHP / Para que sirve || en PHP? en: 29 Septiembre 2007, 16:35 pm
Hola, no soy muy diestra con lenguajes webs, y sobretodo con PHP, pero tengo un empleo freelance como tester de un website tipo Ebay de mi pais, bueno su desarrollador esta creando un control panel de acceso local para que yo maneje de manera mas sencillo el portal,  y me ha dicho que cree el template html de ese index y la web de password en php, Ok lo cree pero antes de mostrarselo a el  :-[ quiero saber como funciona en PHP el delimitador || se que por ejemplo en Unix Bash lee de izquierda a derecha, si la izquierda no se cumple hace la funcion de la derecha, en C++ y C creo, es al reves este delimitador funciona si una de las dos funciones es verdadera, pero en PHP.... como funciona??? porque hazta el momento lo tengo asi el codigo:

<html>
<head>
<title>Problema</title>
</head>
<body>
<form action = "indexito.php" method = "post">
Introduce tu usuario :
<input type = "text" name = "usuario">
Introduce tu Password :
<input type = "password" name = "contrasena">
Repite tu Password :
<input type = "password" name = "contra">
<input type = "submit" value = "Enviar">
<input type = "reset" value = "Borrar">
</body>
</html>


Y este es la  pagina php que recibe los datos.

<html>
<head>
<title>Problema</title>
</head>
<body>

<?php
$solucion = $_REQUEST['usuario'] ;
$solu = $_REQUEST['contrasena'] ;
$sol = $_REQUEST['contra'] ;
if ($solucion != "Tifa" || $solu != "123" || $sol != "123")
echo "No tienes acceso" ;
else
echo "Bienvenido" ;
<--! Luego viene la web de redireccion del control panel :P -->
?>

</body>
</html>


Alguien Podria explicarme en PHP para que va el delimitador || o debo usar &&
Páginas: 1 [2]
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines