Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

Problem in perl/tk

by AMMAR (Initiate)
on Nov 28, 2015 at 19:31 UTC ( [id://1148775]=perlquestion: print w/replies, xml ) Need Help??

AMMAR has asked for the wisdom of the Perl Monks concerning the following question:

This is a tk based mysql application.The problem In this application is that i want to retrieve the value of $sequenceid from $country,$province and $region.i.e if user enters 1st sequence and he enter region Asia, country Pakistan and province as punjab then $sequenceid should be saved as APAPU0000001 (where A for Asia,PA for Pakistan and PU for and 0000001 is 7-digit sequnence identifier). And second problem is in the $sequencefile that there should be a check button to ask for user to enter the sequence manuallly or to enter a file.If press enter a file then the user is asked to put the path of the file and it should be saved in the variable sequencefile. This is the code: 
#!/usr/bin/perl -w
#
# program 5-4
# Chapter 5
# Listing 4
#

use strict;
use DBI;
use Tk;

my $conn = DBI->connect
    ("DBI:mysql:pcr_experiment","root","password15")
    or die("Cannot connect: $DBI::errstr");

my ($sql, @keys, $record);

my %fields =
    ('ID'   => "ID: "   , 'first_name'     => "First Name: "   ,
     'last_name' => "Last name: " , 'initials'  => "Intials: "   ,
     'email' => "Email: " , 'tel_number' => "Telephone Number: ",
     'mob_number'=> "Mobile Number: ",
   'institute_name' => "Institute: " , 'lab_name' => "Lab: " ,'adress'
+=> "Address: ",
     'street'=> "Street: " ,'city'=> "City: ",'country'=> "Country: ",
     'province'=> "Province: ",
     'region'=> "Region: " ,'other_author_names'=> "Other Authors: ",
     'reference'=> "Reference: ", 'personal_statements'=>"Personal Sta
+tements: ", 
     'comments'=>"Comments: ",
      'sequence_id'=>"Sequence ID: ",
      'sequence_file'=>"Sequence file: "
      
      );

my @order =qw(ID first_name last_name  initials email  tel_number mob_
+number institute_name 
lab_name adress street city province country region other_author_names
+ reference personal_statements 
comments  sequence_id sequence_file );
Start_Tk_Interface();
exit;

#-----------------------------------------------------
# Database Routines

sub Get_Record {
    my $ID       = shift;
    my $sql        = qq(SELECT * FROM university WHERE ID = $ID);
    my $hdl_search = $conn->prepare($sql);

    $hdl_search->execute;
    $record = $hdl_search->fetchrow_hashref;

    return($record);
}

sub Delete_Record {
    my $ID  = shift;
    $sql      = qq(DELETE FROM UNIVERSITY WHERE ID = '$ID');

    my $query = $conn->prepare($sql);

    $query->execute 
        or die("\nError executing SQL statement! $DBI::errstr");

    return 1;
}


sub Update_Record {
    my $form   = shift;
    my $caller = shift;

    $caller    -> withdraw();

    my $ID = $form->{'ID'}->get();
    my @keys = keys %$form;
    my @vals = map { $$form{$_}->get() } @keys;

    my $counter = 0;
    $sql  = qq{SELECT FROM UNVIVERSY };

    foreach my $k (@keys){
        $sql .= qq{$k = "$vals[$counter]", };
        $counter++;
    }

    $sql  =~ s/\, $//;
    $sql .=  " WHERE ID = '$ID'";

    my $query = $conn->prepare($sql);

    $query->execute 
        or die("\nError executing SQL statement! $DBI::errstr");

    return 1;
}

sub Add_Record {
    my $form   = shift;
    my $caller = shift;
    $caller    -> withdraw();
  
    my @keys = keys %$form;
    my @vals = map { $conn->quote($$form{$_}->get()) } @keys;

    $sql  = "INSERT INTO UNIVERSITY ("
            . join(", ", @keys)
            . ") VALUES ("
            . join(", ", @vals)
            . ")";

    my $query = $conn->prepare($sql);

    $query->execute 
        or die("\nError executing SQL statement! $DBI::errstr");

    return 1;
}

#------------------------------------------------------
# Tk Interface Routines

my $MainWin;

sub Start_Tk_Interface {
    $MainWin = MainWindow->new(-title => "Choose a Database Action");
    $MainWin->MoveToplevelWindow(100,100);


    my $button1 = $MainWin->Button(-text => 'Add Record',-command => [
+\&change_color, 'red'],
        -command => [\&tk_Add_Record_Dialog, 'add']);

    my $button2 = $MainWin->Button(-text => 'View Record',
        -command => [\&tk_Choose_Dialog, 'View']);

    my $button3 = $MainWin->Button(-text => 'Delete Record',
         -command => [\&tk_Choose_Dialog, 'Delete']);

    my $button4 = $MainWin->Button(-text => 'Quit',
        -command => [$MainWin => 'destroy']);

    $button1 -> grid(-row => 0, -column => 0, 
        -padx => 10, -sticky => 'w');
    $button2 -> grid(-row => 0, -column => 1, 
        -padx => 10, -pady   => 40 );
     $button3 -> grid(-row => 0, -column => 2, 
         -padx => 10);
    $button4 -> grid(-row => 0, -column => 3, 
        -padx => 10, -sticky => 'e');
my @all = $button4->configure( );            # Get info on all options
+ for Button
my $list;
foreach $list (@all) {                    # Print options, not very pr
+etty
    print "@$list\n";
}

     MainLoop();
}

sub tk_Choose_Dialog {
    my $type = shift;

    my $top_win = $MainWin->Toplevel(-title => "Choose Record");
    $top_win->MoveToplevelWindow(110,110);

    $top_win->Label(-text => 'ID: ') ->
        grid(-row => 0, -column => 0, -sticky => 'w');

    my $ID= $top_win->Entry(-width => 20) ->
        grid(-row => 0, -column => 1, -sticky => 'e');

    my $button = $top_win->Button(
        -text    => "$type Record",
        -command => [\&tk_Edit_or_Delete, $top_win, $type, $ID] );

    $button-> grid(-row => 1, -column => 1);

    return 1;
}

sub tk_Edit_or_Delete {
    my $caller = shift;
    my $type   = shift;
    my $ID   = shift()->get();

    $caller->withdraw();

    Delete_Record($ID)                if($type eq 'Delete');
    tk_Add_Record_Dialog("edit", $ID) if($type eq 'View');

    return 1;
}

sub tk_Add_Record_Dialog {
    my ($record, $ID, %form);
    my $type = shift;
    my $row  = 0;

    my $top_win = $MainWin->Toplevel(-title => "Add/View a Record");

    $top_win->MoveToplevelWindow(110,110);

    if($type =~ /edit/){
        $ID   = shift;
        $record = Get_Record($ID);
    }

    foreach my $field (@order){
            
        my $text = $record->{$field};

        $top_win->Label(-text => $fields{$field}) ->
            grid(-row => $row, -column => 0, -sticky => 'w');

        $form{$field}  = $top_win->Entry
            (-width => 50, -textvariable => \$text) ->
            grid(-row=> $row, -column=> 1, -sticky=> 'e');

        $row++;
    }


    my $button;

    if($type =~ /edit/i){
        $button = $top_win->Button(
            -text    => 'Quit', #Third button in edit statement
            -command => [\&Update_Record,\%form, $top_win] );
    }
    else {
        $button = $top_win->Button(
            -text    => 'Add Record',
            -command => sub{ Add_Record(\%form, $top_win)} );
        }

    $button-> grid(-row => $row, -column => 1);

    return 1;
}

[download]

Replies are listed 'Best First'.
Re: Problem in perl/tk
by choroba (Cardinal) on Nov 28, 2015 at 20:03 UTC
    Hi Ammar, welcome to the Monastery. What exactly is your question? Your code is very long, but we can't run it directly, as we don't have the database. To get valuable answers, try to ask concrete questions about details you can't make work. 
    ($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord
}map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,

    [download]
[reply]
[d/l]

      I have six keys in my hash.I want that using tk interface when user enters the values of region,country and province then the value of our sixth key is extracted from these three values (i.e Sequence id is APAPU0000001 if user enters Asia and country Pakistan and Punjab and 1 is added at the end of seven digit identifier).code is given below. 
      use strict;
use DBI;
use Tk;

my $conn = DBI->connect
    ("DBI:mysql:pcr_experiment","root","password15")
    or die("Cannot connect: $DBI::errstr");

my ($sql, @keys, $record);

my %fields =
    ('ID' => "ID: "   , 'province'=> "Province: ",'country'=> "Country
+: "
     'region'=> "Region: " ,
      'sequence_id'=>"Sequence ID: ",
      'sequence_file'=>"Sequence file: "
      
      );

my @order =qw(ID province country region sequence_id sequence_file );
Start_Tk_Interface();
exit;

#-----------------------------------------------------
# Database Routines

sub Get_Record {
    my $ID       = shift;
    my $sql        = qq(SELECT * FROM university WHERE ID = $ID);
    my $hdl_search = $conn->prepare($sql);

    $hdl_search->execute;
    $record = $hdl_search->fetchrow_hashref;

    return($record);
}

sub Delete_Record {
    my $ID  = shift;
    $sql      = qq(DELETE FROM UNIVERSITY WHERE ID = '$ID');

    my $query = $conn->prepare($sql);

    $query->execute 
        or die("\nError executing SQL statement! $DBI::errstr");

    return 1;
}


sub Update_Record {
    my $form   = shift;
    my $caller = shift;

    $caller    -> withdraw();

    my $ID = $form->{'ID'}->get();
    my @keys = keys %$form;
    my @vals = map { $$form{$_}->get() } @keys;

    my $counter = 0;
    $sql  = qq{SELECT FROM UNVIVERSY };

    foreach my $k (@keys){
        $sql .= qq{$k = "$vals[$counter]", };
        $counter++;
    }

    $sql  =~ s/\, $//;
    $sql .=  " WHERE ID = '$ID'";

    my $query = $conn->prepare($sql);

    $query->execute 
        or die("\nError executing SQL statement! $DBI::errstr");

    return 1;
}

sub Add_Record {
    my $form   = shift;
    my $caller = shift;
    $caller    -> withdraw();

    my @keys = keys %$form;
    my @vals = map { $conn->quote($$form{$_}->get()) } @keys;

    $sql  = "INSERT INTO UNIVERSITY ("
            . join(", ", @keys)
            . ") VALUES ("
            . join(", ", @vals)
            . ")";

    my $query = $conn->prepare($sql);

    $query->execute 
        or die("\nError executing SQL statement! $DBI::errstr");

    return 1;
}

#------------------------------------------------------
# Tk Interface Routines

my $MainWin;

sub Start_Tk_Interface {
    $MainWin = MainWindow->new(-title => "Choose a Database Action");
    $MainWin->MoveToplevelWindow(100,100);

    my $button1 = $MainWin->Button(-text => 'Add Record',
        -command => [\&tk_Add_Record_Dialog, 'add']);

    my $button2 = $MainWin->Button(-text => 'View Record',
        -command => [\&tk_Choose_Dialog, 'View']);

    my $button3 = $MainWin->Button(-text => 'Delete Record',
         -command => [\&tk_Choose_Dialog, 'Delete']);

    my $button4 = $MainWin->Button(-text => 'Quit',
        -command => [$MainWin => 'destroy']);

    $button1 -> grid(-row => 0, -column => 0, 
        -padx => 10, -sticky => 'w');
    $button2 -> grid(-row => 0, -column => 1, 
        -padx => 10, -pady   => 40 );
     $button3 -> grid(-row => 0, -column => 2, 
         -padx => 10);
    $button4 -> grid(-row => 0, -column => 3, 
        -padx => 10, -sticky => 'e');

    MainLoop();
}

sub tk_Choose_Dialog {
    my $type = shift;

    my $top_win = $MainWin->Toplevel(-title => "Choose Record");
    $top_win->MoveToplevelWindow(110,110);

    $top_win->Label(-text => 'ID: ') ->
        grid(-row => 0, -column => 0, -sticky => 'w');

    my $ID= $top_win->Entry(-width => 20) ->
        grid(-row => 0, -column => 1, -sticky => 'e');

    my $button = $top_win->Button(
        -text    => "$type Record",
        -command => [\&tk_Edit_or_Delete, $top_win, $type, $ID] );

    $button-> grid(-row => 1, -column => 1);

    return 1;
}

sub tk_Edit_or_Delete {
    my $caller = shift;
    my $type   = shift;
    my $ID   = shift()->get();

    $caller->withdraw();

    Delete_Record($ID)                if($type eq 'Delete');
    tk_Add_Record_Dialog("edit", $ID) if($type eq 'View');

    return 1;
}

sub tk_Add_Record_Dialog {
    my ($record, $ID, %form);
    my $type = shift;
    my $row  = 0;

    my $top_win = $MainWin->Toplevel(-title => "Add/View a Record");

    $top_win->MoveToplevelWindow(110,110);

    if($type =~ /edit/){
        $ID   = shift;
        $record = Get_Record($ID);
    }

    foreach my $field (@order){
            
        my $text = $record->{$field};

        $top_win->Label(-text => $fields{$field}) ->
            grid(-row => $row, -column => 0, -sticky => 'w');

        $form{$field}  = $top_win->Entry
            (-width => 50, -textvariable => \$text) ->
            grid(-row=> $row, -column=> 1, -sticky=> 'e');

        $row++;
    }


    my $button;

    if($type =~ /edit/i){
        $button = $top_win->Button(
            -text    => 'Quit', #Third button in edit statement
            -command => [\&Update_Record,\%form, $top_win] );
    }
    else {
        $button = $top_win->Button(
            -text    => 'Add Record',
            -command => sub{ Add_Record(\%form, $top_win)} );
        }

    $button-> grid(-row => $row, -column => 1);

    return 1;
}

      [download]
[reply]
[d/l]
Re: Problem in perl/tk
by ww (Archbishop) on Nov 28, 2015 at 20:21 UTC
    "Please mail me on my email-id(ammarsabir15@gmail.com)"

    Sure, just as soon as you deposit USD 10000 to my offshore bank account, routing number 132cd9-344756928-aff7!       ;-)

    As you may guess from the above, that isn't how we do it here, some points of which the eminent Canon choroba has already pointed out above. For some further points, you'll be making a good start to better (and less snarky) help if you read On asking for help; How do I post a question effectively?; I know what I mean. Why don't you? and Writeup Formatting Tips.

    And, since I can't decide whether your OP is asking for someone to do your homework or someone to do your $work, you may wish to be explicit if it's either. But then, we don't run a hiring board and we don't run a free-code-writing service.

    OTOH, we do seek to offer the best help we can to those who come here to learn. I'd suggest you recast your question (such as it is) to include:

    1. any warnings or error messages, verbatim.
    2. How the code you show fails to satisfy your needs or meeting your expections (or both, if applicable).
    3. A minimal example how you've tried to solve the exact problem with which you expect help.

    As the reverand Canon said above, welcome, indeed to the Monastery... but please make it easy for us to help you, if that's what you're seeking. Otherwise, of course, you can resort to one of the numerous jobs boards where folk will bid to do your work.


    Questions containing the words "doesn't work" (or their moral equivalent) will usually get a downvote from me unless accompanied by:
    1. code
    2. verbatim error and/or warning messages
    3. a coherent explanation of what "doesn't work actually means.
[reply]
[reply]
Re: Problem in perl/tk
by choroba (Cardinal) on Nov 29, 2015 at 15:11 UTC
    To extract substrings of given strings, use substr. I used the concatenation operator . combined with the assignment operator =, see perlop for details. 
    #! /usr/bin/perl
use warnings;
use strict;

my $country  = 'Pakistan';
my $province = 'Punjab';
my $region   = 'Asia';

my $counter = 1;

my $sequenceid = substr $region, 0, 1;
$sequenceid   .= substr $country, 0, 2;
$sequenceid   .= substr $province, 0, 2;
$sequenceid   .= sprintf '%07d', $counter;

$sequenceid = uc $sequenceid;
print $sequenceid, "\n";

    [download]

    To get a file path from the user, use Tk::FileSelect or Tk::getOpenFile.

    Most of the contents of your post was irrelevant to the question. Please, try to study Short, Self Contained, Correct Example to learn how to ask good questions. 

    ($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord
}map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,

    [download]
[reply]
[d/l]
[select]
Re: Problem in perl/tk
by Pope-O-Matik (Pilgrim) on Nov 29, 2015 at 14:19 UTC

    SELECT * FROM university WHERE ID = $ID

    A couple side points.

    1) * should only be used in COUNT(*), EXISTS(SELECT * ...), and ad-hoc queries. Elsewhere, the column list ought to be specified. This is self-documenting and protects against column changes and reordering.

    2) Please do not use dynamic SQL. It is insecure, and sometimes, not as efficient. It's easy to use a placeholder. Just replace $ID with a question mark (?) and pass the variable in the execute() statement. The foreach can still be used, just have it place question marks instead, and load an array to be used for the execute statement.

[reply]

Back to Seekers of Perl Wisdom

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Node Status?
node history
Node Type: perlquestion [id://1148775]
Approved by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others scrutinizing the Monastery: (4)
As of 2024-04-24 02:52 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found