Return to test3.pl CVS log

Up to [local] / palm / Palm-Keyring

Annotation of palm/Palm-Keyring/test3.pl, Revision 1.5

1.5     ! andrew      1: #!/usr/bin/perl
        !             2: # $RedRiver: palmkeyring-tk,v 1.4 2006/06/13 00:03:39 andrew Exp $
        !             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:
        !            11: use Tk 8.0;
        !            12: use Tk::widgets qw/ Dialog BrowseEntry ROText ProgressBar /;
        !            13:
        !            14: use lib 'lib';
        !            15: use Palm::Keyring;
        !            16:
        !            17: my $NAME    = 'Palm Keyring';
        !            18: my $VERSION = 0.01;
        !            19:
        !            20: my $File    = shift || "Keys-Gtkr.PDB";
        !            21: my $Keyring = Open($File);
        !            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:
        !            28: build_window();
        !            29: MainLoop;
        !            30:
        !            31:
        !            32:
        !            33:
        !            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');
        !            58:
        !            59: # Lists
        !            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);
        !            65:
        !            66:
        !            67: # Account
        !            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");
        !            80:
        !            81:
        !            82: # Lock
        !            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);
        !            92:
        !            93:        $lock_progress->repeat(500,\&Lock_Timeout);
        !            94:
        !            95:        my $menubar = build_menubar($MW);
        !            96:
        !            97:        _populate_lists($Keyring, $category_list, $accounts_list);
        !            98:
        !            99:        return $MW;
        !           100: }
        !           101:
        !           102:
        !           103: sub build_menubar {
        !           104:
        !           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.
        !           109:
        !           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']);
        !           138:
        !           139:        $menubar;                        # return the menubar
        !           140:
        !           141: }
        !           142:
        !           143: sub Lock
        !           144: {
        !           145:        $unlocked = time;
        !           146: }
        !           147:
        !           148: sub Lock_Timeout
        !           149: {
        !           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:        }
        !           159: }
        !           160:
        !           161: sub Open
        !           162: {
        !           163:        my $file = shift;
        !           164:        my $pdb  = Palm::Keyring->new;
        !           165:        $pdb->Load($file) || die "Couldn't load '$file'";
        !           166:        return $pdb;
        !           167: }
        !           168:
        !           169: sub Close
        !           170: {
        !           171: }
        !           172:
        !           173: sub _populate_lists
        !           174: {
        !           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:        }
        !           186:
        !           187: }