CPANPLUS-Shell-Tk
view release on metacpan or search on metacpan
lib/CPANPLUS/Shell/Tk.pm view on Meta::CPAN
package CPANPLUS::Shell::Tk;
#-------------------------------------------------------------------------------
=head1 NAME
CPANPLUS::Shell::Tk - Frontend for CPANPLUS using Tk
=head1 SYNOPSIS
To use CPANPLUS with the Tk GUI do:
perl -MCPANPLUS -e 'shell(Tk)'
=head1 WARNING
This is very early beta!
It may not do what you want it to do and it may break your CPANPLUS
configuration.
Use it accordingly!
=head1 GUI
The GUI is divided into three parts:
=over 2
=item Infowindow on top
The Infowindow shows the current Perl version.
It may show other interesting info in future.
=item Modulelist on the left
In the left window there are three tabs that show a search dialog with result,
a list of installed modules and a list of modules in need of an update.
=item Workwindow
The window on the right shows different things depending on what you are doing
at the moment.
It shows basic information on the module when you select one in the list to the
left.
It shows the POD for the module when you select this from the right-click
popup menu in the list.
It shows the command history with editing facility when selected from the menu.
And it show this POD when you select 'Help' from the Help menu.
=back
=head1 USAGE
=head2 Searching
You can search for a module or for an author.
Select which type of search you want to do in the dropdown listbox.
Your search is always case sensitive but you can use perl regexen
as search value.
=head2 Working with Modules
When you click on the modules in the listbox on the left you get basic
information on the selected module.
When you right click on the module you get a popup menu which lets you do
the following:
=over 2
=item Install
Install the newest version of this module from CPAN.
=item Uninstall
Remove the module from your disk.
=item Fetch
Fetch the module from CPAN but do nothing else.
=item Extract
Fetch the module if necessary and extract it in your .cpanplus directory.
=item Make
Fetch the module if necessary, extract and build it in your .cpanplus
directory.
=item Pod
Display the POD of the module if it is installed.
=back
=head2 Changing the Configuration
Via the Config menu you can change the configuration of CPANPLUS.
=over 2
=item CPANPLUS
Change CPANPLUS config like default shell, debug level and so on.
=item Package sources
Edit the list of package sources.
=back
=head2 Perl
You can view the entire Perl configuration using 'show full config'.
You can restart CPANPLUS::Shell::Tk with another Perl version installed
on your disk.
Currently this only works for *NIX like environments and even here it might
not pick the right perl binaries.
=head2 History
Every command you execute on a module will be logged in a history.
lib/CPANPLUS/Shell/Tk.pm view on Meta::CPAN
# search, installed and update tab
#
sub _setup_left_frame {
my $self = shift;
my $leftframe = shift;
my $MW = $self->{MW};
my $CP = $self->{CP};
my $left = $leftframe->NoteBook(
-background => 'white',
);
my $search_tab = $left->add('search', -label => 'Search');
my $installed_tab = $left->add('installed', -label => 'Installed');
my $update_tab = $left->add('update', -label => 'Update');
$left->pack(-fill => 'both', -expand => 1);
$self->_setup_update_tab($update_tab);
$self->_setup_installed_tab($installed_tab);
$self->_setup_search_tab($search_tab);
}
#------------------------------------------------------------------------
# setup listbox with modules not up to date
#
sub _setup_update_tab {
my $self = shift;
my $update_tab = shift;
my $MW = $self->{MW};
my $CP = $self->{CP};
my $update = $update_tab->Scrolled('MListbox',
-scrollbars => 'osow',
-selectmode => 'extended',
-moveable => 0,
-background => 'white',
);
$update->Subwidget("yscrollbar")->configure(-width => 6);
$update->Subwidget("xscrollbar")->configure(-width => 6);
$update->columnInsert(0, -text => 'Module', -width => 35);
$update->columnGet(0)->Subwidget('heading')->configure(-pady => -1);
$update->pack(-fill => 'both', -expand => 1);
#---- on click, fill details into right frame
$update->bindRows('<ButtonPress-1>',
[ sub {
$self->{$_}->packForget foreach qw(HISTORY POD INFO);
$self->{INFO}->pack(-fill => 'both', -expand => 1);
my @sel = $update->curselection;
my (@mods) = map {$update->columnGet(0)->get($_, $_)} @sel;
$self->{INFO}->delete('0.0', 'end');
return if @mods > 1;
my $rv = $CP->details(modules => [$mods[0]]);
foreach (sort keys %{$rv->{rv}->{$mods[0]}}) {
$self->{INFO}->insert('end', "\n$_:\n\t" . $rv->{rv}->{$mods[0]}->{$_});
}
}
]
);
#---- on right click show popup menu
my $button3_menu = $self->_create_button3_menu($update);
$update->bindRows('<ButtonPress-3>',
[ sub {
my @sel = $update->curselection;
@{$self->{MODS}} = map {$update->columnGet(0)->get($_, $_)} @sel;
$button3_menu->Popup(-popover => 'cursor', -popanchor => 'nw');
},
]
);
$update->insert(0, map { [$_, 1] } sort keys %{$self->{NOT_UPTODATE}});
}
#------------------------------------------------------------------------
# setup listbox with installed modules
#
sub _setup_installed_tab {
my $self = shift;
my $installed_tab = shift;
my $MW = $self->{MW};
my $CP = $self->{CP};
my $installed = $installed_tab->Scrolled('MListbox',
-scrollbars => 'osow',
-selectmode => 'extended',
-moveable => 0,
-background => 'white',
);
$installed->Subwidget("yscrollbar")->configure(-width => 6);
$installed->Subwidget("xscrollbar")->configure(-width => 6);
$installed->columnInsert(0, -text => 'Module', -width => 35);
$installed->columnGet(0)->Subwidget('heading')->configure(-pady => -1);
$installed->pack(-fill => 'both', -expand => 1);
#---- on click, fill details into right frame
$installed->bindRows('<ButtonPress-1>',
[ sub {
$self->{$_}->packForget foreach qw(HISTORY POD INFO);
$self->{INFO}->pack(-fill => 'both', -expand => 1);
my @sel = $installed->curselection;
my (@mods) = map {$installed->columnGet(0)->get($_, $_)} @sel;
$self->{INFO}->delete('0.0', 'end');
return if @mods > 1;
my $rv = $CP->details(modules => [$mods[0]]);
foreach (sort keys %{$rv->{rv}->{$mods[0]}}) {
$self->{INFO}->insert('end', "\n$_:\n\t" . $rv->{rv}->{$mods[0]}->{$_});
}
}
]
);
#---- on right click show popup menu
my $button3_menu = $self->_create_button3_menu($installed);
$installed->bindRows('<ButtonPress-3>',
[ sub {
my @sel = $installed->curselection;
@{$self->{MODS}} = map {$installed->columnGet(0)->get($_, $_)} @sel;
$button3_menu->Popup(-popover => 'cursor', -popanchor => 'nw');
},
]
);
$installed->insert(0, map { [$_, 1] } sort keys %{$self->{INSTALLED}});
}
#------------------------------------------------------------------------
# setup search tab
#
sub _setup_search_tab {
my $self = shift;
my $search_tab = shift;
my $MW = $self->{MW};
my $CP = $self->{CP};
my $search;
my $searchtype = 'module';
my $searchtext;
#---- frame for search form, searchtype (module/author), text and button
my $sf = $search_tab->Frame(
-background => 'white',
);
$sf->pack(-side => 'top', -fill => 'both', -expand => 0);
my $search_type = $sf->BrowseEntry(-variable => \$searchtype,
-state => 'readonly',
-background => 'white',
)->pack(-side => 'top', -anchor => 'w')->insert(0, (qw (module author)));
my $search_entry = $sf->Entry(-relief => 'sunken',
-textvariable => \$searchtext,
);
$search_entry->pack(-side => 'left');
my $search_button = $sf->Button(-text => 'Search',
-pady => -1,
-command => sub {
my $rv = $CP->search(type => $searchtype,
list => [$searchtext],
);
$search->delete(0,'end');
foreach (reverse sort keys %$rv) {
$search->insert(0, [$_]);
}
}
);
$search_button->pack(-side => 'right');
$search_entry->bind('<Key-Return>', sub { $search_button->invoke });
$search_entry->focus;
#---- listbox with searchresult
$search = $search_tab->Scrolled('MListbox',
-scrollbars => 'osow',
-selectmode => 'extended',
-moveable => 0,
-background => 'white',
);
$search->Subwidget("yscrollbar")->configure(-width => 6);
$search->Subwidget("xscrollbar")->configure(-width => 6);
$search->columnInsert(0, -text => 'Module', -width => 35);
$search->columnGet(0)->Subwidget('heading')->configure(-pady => -1);
$search->bindRows('<ButtonPress-1>',
[ sub {
$self->{$_}->packForget foreach qw(HISTORY POD INFO);
$self->{INFO}->pack(-fill => 'both', -expand => 1);
my @sel = $search->curselection;
my (@mods) = map {$search->columnGet(0)->get($_, $_)} @sel;
$self->{INFO}->delete('0.0', 'end');
return if @mods > 1;
my $rv = $CP->details(modules => [$mods[0]]);
foreach (sort keys %{$rv->{rv}->{$mods[0]}}) {
$self->{INFO}->insert('end', "\n$_:\n\t" . $rv->{rv}->{$mods[0]}->{$_});
}
}
]
);
my $button3_menu = $self->_create_button3_menu($search);
$search->bindRows('<ButtonPress-3>',
[ sub {
my @sel = $search->curselection;
@{$self->{MODS}} = map {$search->columnGet(0)->get($_, $_)} @sel;
$button3_menu->Popup(-popover => 'cursor', -popanchor => 'nw');
},
]
);
$search->pack(-side => 'bottom', -fill => 'both', -expand => 1);
}
#------------------------------------------------------------------------
# right frame contains three text widgets, two are always hidden
# 1. history editor
# 2. module info
# 3. module pod
# the actual contents depends on the last action in popup or history menu
#
sub _setup_right_frame {
my $self = shift;
my $rightframe = shift;
#---- setting history widget
my $hist = $rightframe->Scrolled('Text',
-scrollbars => 'osow',
-background => 'white',
-wrap => 'none',
-font => '{Helvetica} -12 {normal}',
);
$hist->Subwidget("yscrollbar")->configure(-width => 6);
$hist->Subwidget("xscrollbar")->configure(-width => 6);
$hist->pack(-fill => 'both', -expand => 1);
$hist->packForget;
#---- read old history, ignore comments and blank lines, set commands to comments
$hist->insert('end', "# Command history\n\n");
open HISTORY, "<$ENV{HOME}/.cpui.hist" or warn $!;
while (<HISTORY>) {
next if /^#/;
next if /^\s*$/;
$hist->insert('end', "# $_");
}
close HISTORY;
$self->{HISTORY} = $hist;
#---- setting pod widget
my $pod = $rightframe->Scrolled('PodText',
-scrollbars => 'w',
-background => 'white',
-wrap => 'word',
-font => '{Helvetica} -12 {normal}',
-poddone => sub { $self->{MW}->title('CPANPLUS') } # PodText changes title, we change it back
);
$pod->Subwidget("yscrollbar")->configure(-width => 6);
$pod->Subwidget("xscrollbar")->configure(-width => 6);
$pod->Subwidget("scrolled")->configure(-scrollbars => '');
$pod->pack(-fill => 'both', -expand => 1);
$pod->packForget;
$self->{POD} = $pod;
#---- setting info widget
my $info = $rightframe->Scrolled('ROText',
-scrollbars => 'osow',
-background => 'white',
-wrap => 'none',
-font => '{Helvetica} -12 {normal}',
);
$info->Subwidget("yscrollbar")->configure(-width => 6);
$info->Subwidget("xscrollbar")->configure(-width => 6);
$info->pack(-fill => 'both', -expand => 1);
$self->{INFO} = $info;
}
#------------------------------------------------------------------------
# popup menu for button 3 in listbox
#
sub _create_button3_menu {
my ($self, $list) = @_;
my $MW = $self->{MW};
my $CP = $self->{CP};
my $menu = $list->Menu(-tearoff => 0,
-menuitems => [
[Button => 'Install',
-command => sub {
$MW->Busy;
$self->{$_}->packForget foreach qw(HISTORY POD INFO);
$self->{INFO}->pack(-fill => 'both', -expand => 1);
$self->{INFO}->delete('0.0', 'end');
$CP->install(modules => $self->{MODS});
$self->{HISTORY}->insert('end', "install\t" . join(' ', @{$self->{MODS}}) . "\n");
$MW->Unbusy;
}],
[Button => 'Uninstall',
-command => sub {
$MW->Busy;
$self->{$_}->packForget foreach qw(HISTORY POD INFO);
$self->{INFO}->pack(-fill => 'both', -expand => 1);
$self->{INFO}->delete('0.0', 'end');
$CP->uninstall(modules => $self->{MODS});
$self->{HISTORY}->insert('end', "uninstall\t" . join(' ', @{$self->{MODS}}) . "\n");
$MW->Unbusy;
}],
[Button => 'Fetch',
-command => sub {
$MW->Busy;
$self->{$_}->packForget foreach qw(HISTORY POD INFO);
$self->{INFO}->pack(-fill => 'both', -expand => 1);
$self->{INFO}->delete('0.0', 'end');
$CP->fetch(modules => $self->{MODS});
$self->{HISTORY}->insert('end', "fetch\t" . join(' ', @{$self->{MODS}}) . "\n");
$MW->Unbusy;
}],
[Button => 'Extract',
-command => sub {
$MW->Busy;
$self->{$_}->packForget foreach qw(HISTORY POD INFO);
$self->{INFO}->pack(-fill => 'both', -expand => 1);
$self->{INFO}->delete('0.0', 'end');
$CP->extract(modules => $self->{MODS});
$self->{HISTORY}->insert('end', "extract\t" . join(' ', @{$self->{MODS}}) . "\n");
$MW->Unbusy;
}],
[Button => 'Make',
-command => sub {
$MW->Busy;
$self->{$_}->packForget foreach qw(HISTORY POD INFO);
$self->{INFO}->pack(-fill => 'both', -expand => 1);
$self->{INFO}->delete('0.0', 'end');
$CP->make(modules => $self->{MODS});
$self->{HISTORY}->insert('end', "make\t" . join(' ', @{$self->{MODS}}) . "\n");
$MW->Unbusy;
}],
[Button => 'Pod',
( run in 1.087 second using v1.01-cache-2.11-cpan-364913b4093 )