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]

In reply to Re^2: Problem in perl/tk by Anonymous Monk
in thread Problem in perl/tk by AMMAR

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.