view release on metacpan or  search on metacpan

lib/Tk/TM/Common.pm  view on Meta::CPAN

    $opt  =$opt   ||'';
    $dbopt=$dbopt || {};
 my $dbh;
 eval('use DBI');
 my $dlg   =$scr ? (ref($scr) eq 'ARRAY' ? $scr->[0] : $scr) 
                 : new Tk::MainWindow(-title=>Tk::TM::Lang::txtMsg('Login')); 
 my $rspfd;
 my $dsnlb =$dlg->Label(-text=>Tk::TM::Lang::txtMsg('Database'))
                ->grid(-row=>0, -column=>0, -sticky=>'w');
 my $dsnfd =$dlg->Entry(-textvariable=>\$dsn)
                ->grid(-row=>0, -column=>1, -columnspan=>2, -sticky=>'we');
            $dsnfd->configure(-state=>'disabled', -bg=>$dlg->cget(-bg)) if $opt !~/dsn|edit/i;
 my $usrlb =$dlg->Label(-text=>Tk::TM::Lang::txtMsg('User'))
                ->grid(-row=>1, -column=>0, -sticky=>'w');
 my $usrfd =$dlg->Entry(-textvariable=>\$usr)
                ->grid(-row=>1, -column=>1, -columnspan=>2, -sticky=>'we');
 my $pswlb =$dlg->Label(-text=>Tk::TM::Lang::txtMsg('Password'))
                ->grid(-row=>2, -column=>0, -sticky=>'w');
 my $pswfd =$dlg->Entry(-textvariable=>\$psw,-show=>'*')
                ->grid(-row=>2, -column=>1, -columnspan=>2, -sticky=>'we');
 my $btnok =$dlg->Button(-text=>Tk::TM::Lang::txtMsg($scr ? 'Login' : 'Ok')
                        ,-command=>
                           sub{$rspfd->configure(-text=>'Connecting...');
                               my $curs =$dlg->cget(-cursor);
                               $dlg->configure(-cursor=>$CursorWait);
                               $dlg->update;
                               $dlg->configure(-cursor=>$curs);
                               if (eval {$dbh =DBI->connect($dsn,$usr,$psw,$dbopt)}) 
                                    {$rspfd->configure(-text=>'Connected'); 
                                     eval {$_[0] =$dsn};

lib/Tk/TM/Common.pm  view on Meta::CPAN

                                     $dlg->destroy if !$scr}
                               else {$rspfd->configure(-text=>$DBI::errstr)}
                              }
                        )
                ->grid(-row=>3, -column=>($scr ? 2 : 1), -sticky=>'we');
 my $btncn =$dlg->Button(-text=>Tk::TM::Lang::txtMsg('Cancel')
                        ,-command=>sub{if(!$scr && $opt =~/return/i) {$dlg->destroy} else {Tk::exit}})
                ->grid(-row=>3, -column=>2, -sticky=>'we') if !$scr;
    $rspfd =ref($scr) eq 'ARRAY' ? $scr->[1]
           :$dlg->Label(-anchor=>'w',-relief=>'sunken')
                ->grid(-row=>4, -column=>0, -columnspan=>3, -sticky=>'we');
 $dsnfd->bind('<Key-Return>',sub{$btnok->invoke});
 $usrfd->bind('<Key-Return>',sub{$btnok->invoke});
 $pswfd->bind('<Key-Return>',sub{$btnok->invoke});
 if (!$scr) {
  # $dlg->bind('<Key-Return>',sub{$btnok->invoke});
    $dlg->bind('<Key-Escape>',sub{$btncn->invoke});
    if ($opt =~/center/i) {
       $dlg->update;
       $dlg->geometry('+'.int(($dlg->screenwidth() -$dlg->width())/2.2) 
                     .'+'.int(($dlg->screenheight() -$dlg->height())/2.2));

lib/Tk/TM/wgBlank.pm  view on Meta::CPAN

   $wg =$self->Label(ref($wgs1) ? ('-text',@$wgs1) : ('-text',$wgs1));
   $wg->grid(-column=>$col, -row=>$row, -sticky=>'w');

   my ($colspan, $rowspan)=(1,1);
   while (!defined($wgs1[0])) {shift(@wgs1)};
   if ($wgs1[0] =~/^\d+$/) {$colspan =$wgs1[0]; shift(@wgs1)}
   if ($wgs1[0] =~/^\d+$/) {$rowspan =$wgs1[0]; shift(@wgs1)}
   $col++;
   $wgs1 =shift(@wgs1);
   $wg =$self->$wgs1(@wgs1);
   $wg->grid(-column=>$col,-row=>$row,-sticky=>'w',-columnspan=>$colspan,-rowspan=>$rowspan);
   push(@{$self->{-widgets}}, $wg);
 }

 $self->set(-widgets=>$self->{-widgets});
}

#######################
sub Adapt {
  my $self =shift;
  return($self) if !$self->{-do} || !$self->{-do}->{-dbfds};