Annotation of palm/Palm-Keyring/test3.pl, Revision 1.4
1.1 andrew 1: #!/usr/bin/perl
1.4 ! andrew 2: # $RedRiver: palmkeyring-tk,v 1.3 2006/04/18 19:39:45 andrew Exp $
1.1 andrew 3: ########################################################################
4: # palmkeyring-tk *** A GUI for 'Keyring for PalmOS' written in perl
5: #
6: # 2006.01.31 #*#*# andrew fresh <andrew@mad-techies.org>
7: ########################################################################
8: use strict;
9: use warnings;
10:
1.2 andrew 11: use Tk 8.0;
12: use Tk::widgets qw/ Dialog BrowseEntry ROText ProgressBar /;
1.1 andrew 13:
1.2 andrew 14: use lib 'lib';
15: use Palm::Keyring;
16:
1.4 ! andrew 17: my $NAME = 'Palm Keyring';
! 18: my $VERSION = 0.01;
! 19:
! 20: my $File = shift || "Keys-Gtkr.PDB";
! 21: my $Keyring = Open($File);
1.2 andrew 22:
23:
24: my $lock_when = 0;
25: my $unlocked = time; # Change this to 0 when I get more stuff filled out
26: my $lock_timeout = 30;
27:
1.4 ! andrew 28: build_window();
! 29: MainLoop;
! 30:
! 31:
1.2 andrew 32:
33:
1.4 ! andrew 34: sub build_window
! 35: {
! 36:
! 37: my $MW = MainWindow->new();
! 38: $MW->optionAdd('*BorderWidth' => 1);
! 39:
! 40: my $pane = $MW->Panedwindow(
! 41: Name => 'main',
! 42: -showhandle => 1,
! 43: -orient => 'horizontal'
! 44: )->pack(-fill => 'both', -expand => 1);
! 45:
! 46: my $lists_frame = $pane->Frame(Name => 'lists')
! 47: ->pack(-side=>'top',-anchor=>'nw',-fill=>'x');
! 48: my $right_frame = $pane->Frame(Name => 'right',-relief=>'sunken')
! 49: ->pack(-side=>'top',-anchor=>'ne',-fill=>'both',-expand=>1);
! 50:
! 51: my $account_frame = $right_frame->Frame(Name => 'account')
! 52: ->pack(-side=>'top',-anchor=>'nw',-fill=>'both',-expand=>1);
! 53: my $lock_frame = $right_frame->Frame(Name => 'lock',-relief=>'raised')
! 54: ->pack(-side=>'bottom',-fill=>'x');
! 55:
! 56: $pane->add('.main.lists');
! 57: $pane->add('.main.right');
1.2 andrew 58:
59: # Lists
1.4 ! andrew 60: my $category_list = $lists_frame->BrowseEntry()
! 61: ->pack(-side=>'top',-fill=>'x');
! 62: $category_list->insert(-1, 'All');
! 63: my $accounts_list = $lists_frame->Scrolled('Listbox', -scrollbars => 'e')
! 64: ->pack(-side=>'top',-fill=>'both',-expand=>1);
1.2 andrew 65:
66:
67: # Account
1.4 ! andrew 68: my %account_entry;
! 69: foreach my $label (qw/Category Name Account Password/) {
! 70: $account_entry{$label} = $account_frame->LabEntry(-state=>'readonly',
! 71: -labelWidth => 10,
! 72: -labelPack => [-side => 'left', -anchor => 'w'],
! 73: -label=>$label . ': ', -text => 'my' . $label)
! 74: ->pack(-side=>'top',-anchor=>'nw',-fill=>'x');
! 75: }
! 76:
! 77: $account_entry{'Details'} = $account_frame->ROText(-wrap => 'word',-height=>5,-width=>30)
! 78: ->pack(-side=>'top',-anchor=>'nw',-fill=>'both',-expand=>1);
! 79: $account_entry{'Details'}->insert('1.0',"This is a test\nThis is only a test");
1.2 andrew 80:
81:
82: # Lock
1.4 ! andrew 83: my $lock_button = $lock_frame->Button(-text => 'Lock', -command => \&Lock)
! 84: ->pack(-side=>'left');
! 85: my $lock_progress = $lock_frame->ProgressBar(
! 86: -variable=>\$lock_when,
! 87: -blocks => $lock_timeout,
! 88: -from => $lock_timeout,
! 89: -to => 0,
! 90: -gap => 0,
! 91: )->pack(-side=>'right',-fill=>'x',-expand=>1,-padx=>5);
1.2 andrew 92:
1.4 ! andrew 93: $lock_progress->repeat(500,\&Lock_Timeout);
1.2 andrew 94:
1.4 ! andrew 95: my $menubar = build_menubar($MW);
1.2 andrew 96:
1.4 ! andrew 97: _populate_lists($Keyring, $category_list, $accounts_list);
1.2 andrew 98:
1.4 ! andrew 99: return $MW;
! 100: }
1.2 andrew 101:
102:
103: sub build_menubar {
104:
1.4 ! andrew 105: my $MW = shift;
! 106:
! 107: # Create the menubar and File and Quit menubuttons. Note
! 108: # that the cascade's menu widget is automatically created.
1.2 andrew 109:
1.4 ! andrew 110: my $menubar = $MW->Menu;
! 111: $MW->configure(-menu => $menubar);
! 112: my $file = $menubar->cascade(-label => '~File', -tearoff => 0);
! 113: my $help = $menubar->cascade(-label => '~Help', -tearoff => 0);
! 114:
! 115: # Create the menuitems for each menu. First, the File menu item.
! 116:
! 117: $file->command(-label => "Open", -command => \&Open);
! 118: $file->command(-label => "Close", -command => \&Close);
! 119: $file->command(-label => "Quit", -command => \&exit);
! 120:
! 121: # Finally, the Help menuitems.
! 122:
! 123: $help->command(-label => 'Version');
! 124: $help->separator;
! 125: $help->command(-label => 'About');
! 126:
! 127: my $ver_dialog = $MW->Dialog(-title => $NAME . ' Version',
! 128: -text => "$NAME\n\nVersion $VERSION",
! 129: -buttons => ['OK'],
! 130: -bitmap => 'info');
! 131: my $about_dialog = $MW->Dialog(-title => 'About ' . $NAME,
! 132: -text => 'About ' . $NAME . "\n" .
! 133: '© Copyright 2006 Andrew Fresh <andrew@mad-techies.org>',
! 134: -buttons => ['OK']);
! 135: my $menu = $help->cget('-menu');
! 136: $menu->entryconfigure('Version', -command => [$ver_dialog => 'Show']);
! 137: $menu->entryconfigure('About', -command => [$about_dialog => 'Show']);
1.2 andrew 138:
1.4 ! andrew 139: $menubar; # return the menubar
1.2 andrew 140:
141: }
142:
143: sub Lock
144: {
1.4 ! andrew 145: $unlocked = time;
1.2 andrew 146: }
147:
148: sub Lock_Timeout
149: {
1.4 ! andrew 150: #return unless $unlocked;
! 151: my $diff = time - $unlocked;
! 152: if ($diff > $lock_timeout) {
! 153: print "Timed out!";
! 154: Tk::exit();
! 155: Lock();
! 156: } else {
! 157: $lock_when = $diff;
! 158: }
1.2 andrew 159: }
160:
161: sub Open
162: {
1.4 ! andrew 163: my $file = shift;
! 164: my $pdb = Palm::Keyring->new;
! 165: $pdb->Load($file) || die "Couldn't load '$file'";
! 166: return $pdb;
1.2 andrew 167: }
168:
169: sub Close
170: {
171: }
172:
1.4 ! andrew 173: sub _populate_lists
1.2 andrew 174: {
1.4 ! andrew 175: my $pdb = shift;
! 176: my $cat = shift;
! 177: my $acct = shift;
! 178: foreach my $category (@{ $pdb->{'appinfo'}->{'categories'} }) {
! 179: next unless $category->{'name'};
! 180: $cat->insert( $category->{'id'}, $category->{'name'});
! 181: }
! 182: foreach my $account (@{ $pdb->{'records'} }) {
! 183: next unless $account->{'plaintext'}->{'name'};
! 184: $acct->insert('end', $account->{'plaintext'}->{'name'});
! 185: }
1.2 andrew 186:
187: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to test3.pl CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / palm / Palm-Keyring