package Milkbone::PluginLoad; use Milkbone; our $VERSION = '1.0'; use Tk; use Tk::BrowseEntry; use Tk::JBrowseEntry; use Tk::widgets qw(Frame); use base qw(Tk::Toplevel); use strict; use warnings; Construct Tk::Widget 'MBPluginLoad'; sub ClassInit { my ($class, $mw) = @_; $class->SUPER::ClassInit($mw); } sub Populate { my ($self, $args) = @_; $self->SUPER::Populate($args); } sub on_load { my ($self) = @_; print $self->{plugin}; load_plugin($self->{plugin}); init_plugin($self->{plugin}); $self->{parent}->{list}->insert('end', $self->{plugin}); $self->destroy; } sub init { my ($self, $parent) = @_; $self->withdraw; $self->configure(-title => "Load Plugin"); $self->focus(); $self->{plugin} = ""; $self->{parent} = $parent; my %mods; $mods{(m/plugins\/(.*)/)[0]} = 1 while glob("plugins/*"); $mods{(m/plugins\/(.*)/)[0]} = 1 while glob("plugins/*.pl"); $mods{(m/plugins\/(.*)/)[0]} = 1 while glob("plugins/*.zip"); my @entries = sort keys %mods; s/\.pl//g for @entries; s/\.zip//g for @entries; delete $mods{$_} for grep(/~$/, keys %mods); delete $mods{$_} for hook("loaded_plugins"); @entries = grep { $_ ne "CVS" and $_ ne "compress_dist" and $_ ne "clear_dist" } @entries; $self->Label(-text => 'Unloaded Plugins:')->pack(-fill => 'both', -expand => 1); $self->{list} = $self->JBrowseEntry(-choices => [sort @entries], -variable => \$self->{plugin})->pack(); $self->Button(-text => "Load...", -command => [ $self, "on_load"])->pack(-pady => 6, -padx => 6); $self->bind("" => [sub { shift->destroy }, $self]); hook("tk_seticon", -wnd => $self); $self->update; $self->geometry("+" . int(($self->screenwidth() / 2) - int($self->width() / 2)) . "+" . int(($self->screenheight() / 2) - int($self->height() / 2)) ); $self->deiconify; $self->update(); $self->focus; } 1;