Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

Tk save variables into a file and load

by gpremala (Novice)
on Sep 14, 2018 at 20:36 UTC ( #1222396=perlquestion: print w/replies, xml ) Need Help??

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

Hi, I need help in perl Tk to save, load, default or change config variables, whenever i require. How do I approach.

use Tk 800.000; # These are all the modules that we are using in this script. use Tk::Frame; use Tk::TextUndo; use Tk::Text; use Tk::Scrollbar; use Tk::Menu; use Tk::Menubutton; use Tk::Adjuster; use Tk::DialogBox; use Tk::NoteBook; use Tk::LabEntry; use Data::Dumper; use Scalar::Util qw(reftype); use strict; # Always! $^W++; # Turn on warnings my $DEBUG = 1; # turn off (0) if you don't want to see internals my $mainwindow; my $f; # dialog window my $chipname = "chip"; my $user = "user"; my $config = { SETUPCORNER => ["ss1", "ss2", "ss3", "ss4"] +, HOLDCORNER => ["ff1", "ff2", "ff3", "ff4", +"ff5", "ff6", "ff7", "ff8"], IOHOLD => '0', CHIPNAME => "${chipname}", PTCORNERSUMM => '0', WNS_GREEN => '-0.005', WNS_YELLOW_START => '-0.006', WNS_YELLOW_END => '-0.149', WNS_RED => '-0.150', }; MAIN: { debug("+MAIN"); $mainwindow = MainWindow->new(); $mainwindow->title("Summary Extractor"); $mainwindow->configure(-background => 'cyan'); my $menubar = $mainwindow->Frame(-relief => 'groove', -border +width => 3)->pack(-side => 'top', -fill => 'x'); my $ptcorns = $mainwindow->Frame(-borderwidth => 2, -border = +> 2, -relief => 'groove')->pack( -fill => 'x'); my $dir_flename = $mainwindow->Frame(-borderwidth => 2, -border = +> 2, -relief => 'groove')->pack( -fill => 'x'); my $allbuttons = $mainwindow->Frame()->pack(-fill => 'x'); my $filemenu = $menubar->Menubutton(-text => 'File'); $filemenu->command( -label => 'Open Config', -command => \&loadConfig ); $filemenu->command( -label => 'Save Config', -command => \&saveConfig ); $filemenu->separator(); $filemenu->command( -label => 'Configuration', -command => \&doConfig ); $filemenu->separator(); $filemenu->command( -label => 'Exit', -command => sub {exit;} ); $filemenu->pack(-side => 'left'); my $help_mb = $menubar->Menubutton(-text => 'Help',-borderwidth => 3 +)->pack(-side => 'right'); $help_mb->command(-label => 'About', -command => \&about_program); $help_mb->command(-label => 'Help', -command => \&help); $help_mb->separator(); my $buttons_0 = $allbuttons->Frame()->pack(-fill => 'x'); my $buttons_1 = $allbuttons->Frame()->pack(-fill => 'x'); $buttons_0->Button(-text => 'Load Config', -background => 'red', -co +mmand => \&loadConfig )->pack( -side => 'left', -pady => 2, -padx =>2, -fill => " +both", -expand => 1); $buttons_0->Button(-text => 'Save Config', -background => 'red', -co +mmand => \&saveConfig )->pack( -side => 'left', -pady => 2, -padx =>2, -fill => " +both", -expand => 1); $buttons_0->Button(-text => 'Configuration', -background => 'red', - +command => \&doConfig )->pack( -side => 'left', -pady => 2, -padx =>2, -fill => " +both", -expand => 1); $buttons_0->Button(-text => 'Exit', -background => 'red', -command = +> sub{exit} )->pack( -side => 'left', -pady => 2, -padx =>2, -fill => " +both", -expand => 1); my $chip_frm = $ptcorns->Frame(-borderwidth => 2, -border => 2, -r +elief => 'groove')->pack(-side => 'top', -pady => 9, -padx => 9, -fil +l => 'x'); my $ptcorners = $ptcorns->Frame(-borderwidth => 2, -border => 2, -r +elief => 'groove')->pack(-side => 'left', -pady => 9, -padx => 9, -fi +ll => 'x'); my $chip_frme = $chip_frm->Frame(-relief => 'groove', )->pack(-si +de => 'top'); my $chkbut_frame = $ptcorners->Frame(-relief => 'groove',)->pack(-si +de => 'top'); my $lab_frame = $ptcorners->Frame(-relief => 'groove', )->pack(-s +ide => 'left'); my $chip_lab = $chip_frme->LabEntry(-label => 'CHIP NAME:', -backgro +und => 'white', -labelPack => [-side => 'left', -a +nchor => 'w'], -textvariable => \$config->{CHIPNA +ME}, -width => '40')->pack(-pady => 2); my $setupent = my $setuplabent = my $holdlabent = my $setuplab = my +$holdent = my $holdlab = ""; my $chk = $chkbut_frame->Checkbutton(-text => "Pt Timing Summ ?:", -variable => \$config->{PTCORNERSUMM}, -relief => 'gr +oove', -borderwidth => 2, -command => sub { if ($config->{PTCORNERSUMM}) { $setuplabent->configure( -state => 'normal'); $holdlabent->configure( -state => 'normal'); } else { $setuplabent->configure( -state => 'readonly'); $holdlabent->configure( -state => 'readonly'); }})->pack(-side => 'left',-anchor => 'w', -expand => +1, -pady => 2, -fill => 'both'); $setuplabent = $lab_frame->LabEntry(-label => 'Setup Corners :', +-background => 'white', -labelPack => [-side => 'left', -a +nchor => 'w'], -textvariable => \$config->{SETUPC +ORNER}, -width => '40')->pack(-pady => 2); $holdlabent = $lab_frame->LabEntry(-label => 'Hold Corners :', - +background => 'white', -labelPack => [-side => 'left', -a +nchor => 'w'], -textvariable => \$config->{H +OLDCORNER}, -width => '40')->pack(-pady => 2) +; $setuplabent->configure( -state => $config->{PTCORNERSUMM} ? 'normal +' : 'readonly'); $holdlabent->configure( -state => $config->{PTCORNERSUMM} ? 'normal' + : 'readonly'); while (1) { eval MainLoop(); # Start the event processing } # Will never get here debug ("-MAIN"); } ####################### #Sub routines sub debug { my @msg = shift; print @msg, "\n" if $DEBUG; } sub doConfig { debug("+doConfig"); my $localconfig; # Copy all the configuration items to a local array foreach (keys %$config) { $localconfig->{$_} = $config->{$_}; #debug ($_); } if (not defined $f) { $f = $mainwindow->DialogBox(-title => "Color Configuration", -buttons => ["Load", "Save", "OK", "Cancel"]); my $n = $f->add('NoteBook', -ipadx => 6, -ipady => 6); my $timing = $n->add("timing", -label => "TIMING", -underline + => 0); my $wns_frm = $timing->Frame(-borderwidth => 2, -border => 2, -rel +ief => 'groove', )->pack(-side => 'top', -fill => 'x'); my $tns_frm = $timing->Frame(-borderwidth => 2, -border => 2, -rel +ief => 'groove', )->pack(-side => 'top', -fill => 'x'); my $fep_frm = $timing->Frame(-borderwidth => 2, -border => 2, -rel +ief => 'groove', )->pack(-side => 'top', -fill => 'x'); my $wns_header = $wns_frm->Frame(-relief => 'groove', )->pack(-s +ide => 'top', -fill => 'x'); my $wns_lbl_frm = $wns_frm->Frame(-relief => 'groove', )->pack(-s +ide => 'left'); my $wns_ent_frm = $wns_frm->Frame(-relief => 'groove', )->pack(-s +ide => 'left'); my $wns_lbl_frm1 = $wns_frm->Frame(-relief => 'groove', )->pack(-s +ide => 'left'); my $wns_ent_frm1 = $wns_frm->Frame(-relief => 'groove', )->pack(-s +ide => 'left'); my $wns_name = $wns_header->Label(-text => 'TIMING WNS')->pack(-pa +dy => 2); my $wns_lbl1 = $wns_lbl_frm->Label(-background => 'green', -text = +> 'Lime (>=)')->pack(-pady => 2, -anchor => 'w'); # my $wns_ent1 = $wns_ent_frm->Entry(-textvariable => \$start_wns, - +width => '8')->pack(-pady => 2); my $wns_lbl2 = $wns_lbl_frm1->Label(-text => ':')->pack(-pady => 2 +); my $wns_ent2 = $wns_ent_frm1->Entry(-textvariable => \$localconfig +->{WNS_GREEN}, -width => '8')->pack(-pady => 2); my $wns_lbl3 = $wns_lbl_frm->Label(-background => 'yellow', -text +=> 'Yellow (between)')->pack(-pady => 2, -anchor => 'w'); my $wns_ent3 = $wns_ent_frm->Entry(-textvariable => \$localconfig- +>{WNS_YELLOW_START}, -width => '8')->pack(-pady => 2); my $wns_lbl4 = $wns_lbl_frm1->Label(-text => ':')->pack(-pady => 2 +); my $wns_ent4 = $wns_ent_frm1->Entry(-textvariable => \$localconfig +->{WNS_YELLOW_END}, -width => '8')->pack(-pady => 2); my $wns_lbl5 = $wns_lbl_frm->Label(-background => 'red', -text => +'Red (<=)')->pack(-pady => 2, -anchor => 'w'); # my $wns_ent5 = $wns_ent_frm->Entry(-textvariable => \$start_wns, - +width => '8')->pack(-pady => 2); my $wns_lbl6 = $wns_lbl_frm1->Label(-text => ':')->pack(-pady => 2 +); my $wns_ent6 = $wns_ent_frm1->Entry(-textvariable => \$localconfig +->{WNS_RED}, -width => '8')->pack(-pady => 2); $n->pack(-expand => "yes", -fill => "both", -padx => 5, -pady => 5, -side => "top"); } my $result = $f->Show; # Execute the dialog box if ($result =~ /OK/) { # Copy all the configuration items back foreach (keys %$config) { $config->{$_} = $localconfig->{$_}; } debug(Dumper $config); } debug("-doConfig"); } sub loadConfig {} sub saveConfig {} sub defaultConfig {}

Replies are listed 'Best First'.
Re: Tk save variables into a file and load
by zentara (Archbishop) on Sep 15, 2018 at 14:06 UTC
    Hi, I don't know about your code problem, but as to your original question:
    I need help in perl Tk to save, load, default or change config variables, whenever i require. How do I approach.

    One good way is to use Storable. It allows you to write an existing hash to a file, OR read the file back into a hash.

    Here is some code showing it's basic use. For further info see ztkdb where I use this technique.

    use Tk; use Storable; # Say your config information is in notebook.db # and your config hash is %info. # At startup check if notebook.db exists and load it # into your config hash. If it dosn't exist then it means it's the # first run of the program and do something to make the notebook.db my %info; # global hash to hold your data if(-e 'notebook.db'){ %info = %{retrieve('notebook.db')}; # direct to hash }else{ make_notebook() } # now in your program, as you change things and want to # store them to the notebook.db, you need to save it. # Here is a list of Tk related statements that will automatically # save your notebook.db whenever you exit the program #setup auto save of storable db $mw->protocol('WM_DELETE_WINDOW' => sub { &save_it() }); $SIG{__DIE__} = sub { &save_it()}; $SIG{INT} = sub { &save_it()}; $mw->bind('<Control-c>', [sub{&save_it(); Tk::exit;}] ); # and the save_it sub sub save_it{ store(\%info,'notebook.db'); print "saved\n"; }

    I'm not really a human, but I play one on earth. ..... an animated JAPH
      I need help in perl Tk to save, load, default or change config variables, whenever i require. How do I approach.

      One good way is to use Storable. It allows you to write an existing hash to a file, OR read the file back into a hash.

      I would use Storable only for short-time data storage (i.e. temporary files that survive only for seconds up to hours) on a single machine. Here is why: Re: Perl Storable problem (i Think).

      There are much better ways for long-time data storage and configuration files: Re: Accessing variables in an external hash without eval.

      And for storing more than a few kBytes worth of data, perhaps across several machines, there is DBI and the various supported databases: Re^2: Perl and Database.

      Alexander

      --
      Today I will gladly share my knowledge and experience, for there are no sweeter words than "I told you so". ;-)
Re: Tk save variables into a file and load
by Anonymous Monk on Sep 15, 2018 at 05:58 UTC
Re: Tk save variables into a file and load
by Anonymous Monk on Sep 15, 2018 at 02:10 UTC
    What is the problem?

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://1222396]
Approved by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others perusing the Monastery: (9)
As of 2019-11-12 12:01 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Strict and warnings: which comes first?



    Results (66 votes). Check out past polls.

    Notices?