Foro - Perl en Español

La comunidad de programadores en Perl de habla hispana.

Obviar


  • Publicidad

Perl/TK (ToolKit GUI) MySQL, Editor de registros

Aprende Perl
Publicar una respuesta

Perl/TK (ToolKit GUI) MySQL, Editor de registros

Notapor TKZeXe » 2009-10-27 09:09 @423

Este ejemplo, edita, borra y agrega registros en una base de datos determinada.
Uso de scrollbar para HLIST.
Frames y Toplevels.
Dialog WIDGET (para mensajes e información).

Son algunas lib y widget usados.


Tabla en la base de datos [b]test:[/b]

Sintáxis: [ Descargar ] [ Ocultar ]
Using sql Syntax Highlighting
  1. CREATE TABLE `productos` (
  2.   `ID` int(11) NOT NULL AUTO_INCREMENT,
  3.   `Precio` double(9,3) DEFAULT NULL,
  4.   `Nombre` varchar(50) DEFAULT NULL,
  5.   `URL` varchar(121) DEFAULT NULL,
  6.   PRIMARY KEY  (`ID`)
  7. ) ENGINE=MyISAM  DEFAULT CHARSET=utf8 AUTO_INCREMENT=15 ;
  8.  
  9. --
  10. -- Volcar la base de datos para la tabla `productos`
  11. --
  12.  
  13. INSERT INTO `productos` VALUES (1, 9.600, 'P1', 'crm.jpg');
  14. INSERT INTO `productos` VALUES (2, 9.600, 'P2', 'shamp.png');
  15. INSERT INTO `productos` VALUES (3, 12.600, 'P3', 'makaf.jpg');
  16. INSERT INTO `productos` VALUES (4, 9.600, 'P3', '');
  17. INSERT INTO `productos` VALUES (12, 9.600, 'er', NULL);
  18. INSERT INTO `productos` VALUES (7, 9.600, 'P4', '');
  19. INSERT INTO `productos` VALUES (8, 9.600, 'sa', '');
  20. INSERT INTO `productos` VALUES (9, 9.600, 'p6', '');
  21. INSERT INTO `productos` VALUES (10, 9.600, 'P7', '');
  22. INSERT INTO `productos` VALUES (13, 11.000, 'oli', NULL);
  23. INSERT INTO `productos` VALUES (14, 44.000, 'edff', NULL);
  24.  
Coloreado en 0.002 segundos, usando GeSHi 1.0.8.4

Código Perl :
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. #!/usr/bin/perl
  2. use strict;
  3. use Tk;
  4. use Tk::HList;
  5. require Tk::LabEntry;
  6. require Tk::Dialog;
  7. use DBI;
  8.  
  9. my $host = "localhost";
  10. my $database="test";
  11. my $user = "root";
  12. my $pw = "28alonso28";
  13. my $tl;
  14. my $oConexInf="DBI:mysql:database=$database;$host:3306";
  15. my $connect=DBI->connect($oConexInf,$user,$pw);
  16.  
  17. #declare vars "glob"
  18. my $e;
  19. my $e2;
  20. #end
  21.  
  22. my $mw = MainWindow->new;
  23. $mw->title("Admin Mysql   By TKZeXe");
  24. $mw->geometry('500x400');
  25. $mw->resizable(0,0);
  26. my $frame = $mw->Frame(-borderwidth => 2, -relief => 'groove');
  27. my $frame2 = $mw->Frame(-borderwidth => 2,-relief => 'groove');
  28. my $scroll = $frame->Scrollbar( );
  29. my $hlist = $frame->HList(-command=>[\&oEditReg],-columns => 3,-width=>"50",-height=>"10",-background=>"white", -header => 1,
  30.                            -selectbackground=>"#CCCCCC", -selectborderwidth=>0);
  31. my $title=$frame->Label(-text => "Productos :\n");
  32. my $title_h1=$mw->Label(-text => "Edita,Borra y revisa tus Productos.\n\n",
  33.                         -foreground =>"Blue");
  34.  
  35. #header (cabeceras)
  36. $hlist->headerCreate(0, -text => "ID");
  37. $hlist->headerCreate(1, -text => "Precio");
  38. $hlist->headerCreate(2, -text => "Nombre");
  39.  
  40. my $query="SELECT ID,Precio,Nombre from Productos ORDER BY ID ASC ";
  41. my $i=0;
  42.  
  43. my $id;
  44. my $price;
  45. my $name;
  46.  
  47. my $sth = $connect->prepare($query);
  48. $sth->execute();
  49.  
  50. while(my @result = $sth->fetchrow_array())
  51. {
  52.   $hlist->add($i);
  53.   $hlist->itemCreate($i, 0, -text => $result[0]);
  54.   $hlist->itemCreate($i, 1, -text => $result[1]);
  55.   $hlist->itemCreate($i, 2, -text => $result[2]);
  56.   $i++;
  57. }
  58.  
  59.  
  60. $hlist->configure(-yscrollcommand => [\&scroll_listboxes],-height=>"10");
  61. $scroll->configure(-command =>['yview' => $hlist]);
  62.  
  63.  
  64. my $Bdelete=$frame2->Button(-text => "Delete",-width=>"10");
  65. my $Badd=$frame2->Button(-text => "Add",-width=>"10");
  66. my $Bedit=$frame2->Button(-text => "Edit",-width=>"10");
  67. #packs
  68. $title_h1->pack(-anchor => 'n');
  69. $frame->pack(-side => "top",-anchor=>"n");
  70. $title->pack();
  71. $hlist->pack(-expand => 0, -fill => 'both',-side => 'left');
  72. $scroll->pack(-side => 'left', -fill => 'y');
  73. $frame2->pack(-side => 'bottom',-fill=>'x');
  74. $Bdelete->pack(-side => 'left',-expand => 1,-padx=>10);
  75. $Bedit->pack(-side => 'left',-expand => 1,-padx=>10);
  76. $Badd->pack(-side => 'left',-expand => 1,-padx=>10);
  77. #end
  78. $Bdelete->bind('<Button-1>',\&oDeleteReg );
  79. $Bedit->bind('<Button-1>',\&oEditReg);
  80. $Badd->bind('<Button-1>',\&oAddReg );
  81.  
  82.  
  83.  
  84.  
  85. sub oDeleteReg{
  86. my $path=@_;
  87. my $Item = $hlist->selectionGet();
  88. my $data=$hlist->itemCget($Item, 0, -text);
  89. my $answer = $mw->Dialog(-title => 'Informacion!',
  90.    -text => 'Deseas borrar definitivamente el registro seleccionado?',
  91.    -default_button => 'no', -buttons => [ 'yes', 'no'],
  92.    -bitmap => 'question' )->Show( );
  93. if ($answer eq 'no') {
  94. return 0;
  95. }
  96. #continue:
  97. my $query="DELETE from Productos WHERE ID='$data' ";
  98. my $sth = $connect->prepare($query);
  99. unless($sth->execute()){
  100. print "Error en la consulta".$sth->errstr;
  101. }else{
  102. $hlist->delete('entry', $Item);
  103. };
  104.  
  105. }
  106. sub oEditReg{
  107. my($patt)=@_;
  108. my $Item = $hlist->selectionGet();
  109. my $data=$hlist->itemCget($Item, 0, -text);
  110. my $query="SELECT ID,Precio,Nombre from Productos WHERE ID='$data' LIMIT 1";
  111. my $sth = $connect->prepare($query);
  112. $sth->execute();
  113. my @result = $sth->fetchrow_array();
  114.  
  115. if (! Exists($tl)) {
  116.     $tl = $mw->Toplevel(-container => 0);
  117.     $tl->title("Toplevel");
  118.     $tl->geometry('400x300');
  119.     $tl->resizable(0,0);
  120.     $tl->Label(-text => "Edita tu Producto \n")->pack(-side=>'top');
  121.     my $f1=$tl->Frame(-borderwidth => 1, -relief => 'groove')->pack(-side => "top",-anchor=>"nw");
  122.     $f1->Label(-text => "Nombre Producto : ")->grid(-row => 0, -column => 0);
  123.     $e = $f1->Entry()->grid(-row => 0, -column => 1);
  124.     $e->insert('end',$result[1]);
  125.     $f1->Label(-text => "Precio Producto (ej: 12.88) : ")->grid(-row => 1, -column => 0);
  126.     $e2 = $f1->Entry()->grid(-row => 1, -column => 1);
  127.     $e2->insert('end',$result[2]);
  128.     my $f2=$tl->Frame(-borderwidth => 1, -relief => 'groove')->pack(-side => "bottom",-fill=>'x');
  129.     $f2->Button(-text => "Editar Registro",-command => \&UpdateReg)->pack(-side=>'left');
  130.     $f2->Button(-text => "Close",-command => sub { $tl->withdraw })->pack(-side=>'right');
  131.   } else {
  132.     $tl->deiconify( );
  133.     $tl->raise( );
  134.   }
  135. }
  136. sub oAddReg{
  137.  if (! Exists($tl)) {
  138.     $tl = $mw->Toplevel(-container => 0);
  139.     $tl->title("Toplevel");
  140.     $tl->geometry('400x300');
  141.     $tl->resizable(0,0);
  142.     $tl->Label(-text => "Ingresa tu Nuevo Producto \n")->pack(-side=>'top');
  143.     my $f1=$tl->Frame(-borderwidth => 1, -relief => 'groove')->pack(-side => "top",-anchor=>"nw");
  144.     $f1->Label(-text => "Nombre Producto : ")->grid(-row => 0, -column => 0);
  145.     $e = $f1->Entry()->grid(-row => 0, -column => 1);
  146.     $f1->Label(-text => "Precio Producto (ej: 12.88) : ")->grid(-row => 1, -column => 0);
  147.     $e2 = $f1->Entry()->grid(-row => 1, -column => 1);
  148.     my $f2=$tl->Frame(-borderwidth => 1, -relief => 'groove')->pack(-side => "bottom",-fill=>'x');
  149.     $f2->Button(-text => "Ingresar Registro",-command => \&InsertInto)->pack(-side=>'left');
  150.     $f2->Button(-text => "Close",-command => sub { $tl->withdraw })->pack(-side=>'right');
  151.   } else {
  152.     $tl->deiconify( );
  153.     $tl->raise( );
  154.   }
  155.  
  156. }
  157. sub UpdateReg{
  158. my($patt)=@_;  
  159. my $name=$e->get();
  160. my $price=$e2->get();
  161. my $Item = $hlist->selectionGet();
  162. my $ID=$hlist->itemCget($Item, 0, -text);
  163. my $query="UPDATE Productos SET Precio='$price',Nombre='$name' WHERE ID='$ID'";
  164. my $sth = $connect->prepare($query);
  165. unless($sth->execute()){
  166. my $answer = $mw->Dialog(-title => 'Informacion!',
  167.    -text => "Error en la consulta".$sth->errstr,
  168.    -default_button => 'Aceptar', -buttons => [ 'Aceptar'],
  169.    -bitmap => 'question' )->Show( );
  170. }else{
  171. my $answer = $mw->Dialog(-title => 'Informacion!',
  172.    -text => 'Haz Actualizado los datos correctamente!',
  173.    -default_button => 'Aceptar', -buttons => [ 'Aceptar'],
  174.    -bitmap => 'question' )->Show( );
  175. };
  176. $tl->withdraw;
  177.  
  178. }
  179. sub InsertInto{
  180. my($patt)=@_;  
  181. my $name=$e->get();
  182. my $price=$e2->get();
  183.  
  184. my $query="INSERT INTO Productos (ID,Precio,Nombre) VALUES('','$price','$name')";
  185. my $sth = $connect->prepare($query);
  186. unless($sth->execute()){
  187. my $answer = $mw->Dialog(-title => 'Informacion!',
  188.    -text => "Error en la consulta".$sth->errstr,
  189.    -default_button => 'Aceptar', -buttons => [ 'Aceptar'],
  190.    -bitmap => 'question' )->Show( );
  191. }else{
  192. my $answer = $mw->Dialog(-title => 'Informacion!',
  193.    -text => 'Haz insertado los datos correctamente!',
  194.    -default_button => 'Aceptar', -buttons => [ 'Aceptar'],
  195.    -bitmap => 'question' )->Show( );
  196. };
  197.  
  198.  
  199. }
  200.  
  201. sub scroll_listboxes {
  202.   my (@args) = @_;
  203.   $scroll->set(@args); # Llama a la barra de desplazamiento
  204.   my ($top, $bottom) = $hlist->yview( );
  205. }
  206.  
  207. MainLoop;
Coloreado en 0.008 segundos, usando GeSHi 1.0.8.4


Ya lo estaré explicando.

Imagen

¡Saludos!
Imagen
GUI ADM PERL
TKZeXe
Perlero nuevo
Perlero nuevo
 
Mensajes: 18
Registrado: 2009-10-19 08:50 @409
Arriba

Publicidad

Publicar una respuesta

Volver a Formación

¿Quién está conectado?

Usuarios navegando por este Foro: No hay usuarios registrados visitando el Foro y 1 invitado

Powered by phpBB® Forum Software © phpBB Group
Traducción al Español Mexicano por nextgen en colaboración con phpbb-es.com
phpBB SEO
Advertisements by Advertisement Management
cron