Perl en Español
  1. Home
  2. Tutoriales
  3. Foro
  4. Artículos
  5. Donativos
  6. Publicidad
 
Índice general » Mundo Perl » Formación » Perl/TK (ToolKit GUI) MySQL, Editor de registros Responder al tema
Nuevo tema


Página 1 de 1  [ 1 mensaje ] 
  Imprimir vista
Nota 2009-10-27 09:09 @423
TKZeXeDesconectado
Perlero Nuevo 		Registrado: 2009-10-19 08:50 @409
Mensajes: 18
Perl/TK (ToolKit GUI) MySQL, Editor de registros
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]

Syntax: [ Download ] [ Hide ]
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.  

Código Perl :
Syntax: [ Download ] [ Hide ]
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;


Ya lo estaré explicando.

Imagen

¡Saludos!

_________________
Imagen
GUI ADM PERL

Responder al tema  Página 1 de 1
  [ 1 mensaje ] 

Reglas del Foro
No puedes abrir nuevos temas en este Foro
No puedes responder a temas en este Foro
No puedes editar tus mensajes en este Foro
No puedes borrar tus mensajes en este Foro
No puedes enviar adjuntos en este Foro

Publicidad

Socializa
Síguenos por Twitter

Suscríbete GRATUITAMENTE al Boletín de Perl en Español

Saltar a:  
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
Traducción al español por Huan Manwë para phpbb-es.com
phpBB SEO