view release on metacpan or  search on metacpan

lib/CPANPLUS/Shell/Tk.pm  view on Meta::CPAN

  $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',
                              -command => sub {
                                            $self->{$_}->packForget foreach qw(HISTORY POD INFO);
                                            $self->{POD}->configure(-file => $self->{MODS}->[0]);
                                            print $self->{MODS}->[0], "\n";
                                            $self->{POD}->pack(-fill => 'both', -expand => 1);
                                          }],
                            ],
                          );
  return $menu;
}

#------------------------------------------------------------------------
# configure CPANPLUS
#
sub _config_cpanplus {
  my $self = shift;
  my $MW = $self->{MW};
  my $CP = $self->{CP};

  my $conf = $CP->configure_object();
  my @options = $conf->subtypes('conf');
  my %conf;

#---- attributes of config values, should be moved to CPANPLUS::Configure
  my %conf_attrs = (cpantest       => { type => 's', width => 1,  comment => 'Send testreport to CPAN testers'},
                    debug          => { type => 's', width => 1,  comment => 'Output debug messages'},
                    flush          => { type => 's', width => 1,  comment => 'Flush cache automatically'},
                    force          => { type => 's', width => 1,  comment => 'Install even if tests fail'},
                    lib            => { type => 'a', width => 20, comment => 'additional INC directories'},
                    makeflags      => { type => 'h', width => 20, comment => 'Flags for the make command'},
                    makemakerflags => { type => 'h', width => 20, comment => 'Flags for makemaker'},
                    prereqs        => { type => 's', width => 1,  comment => 'Handle prerequesites'},
                    storable       => { type => 's', width => 1,  comment => 'Use Storable'},
                    verbose        => { type => 's', width => 1,  comment => 'Be verbose'},
                    md5            => { type => 's', width => 1,  comment => 'Check md5 checksums'},
                    signature      => { type => 's', width => 1,  comment => 'Check gpg signature'},
                    shell          => { type => 's', width => 25, comment => 'Default CPANPLUS shell'},
                    dist_type      => { type => 's', width => 20, comment => 'Distribution type'},
                    skiptest       => { type => 's', width => 1,  comment => 'Skip tests'},
                   );

#---- window
  my $confdlg = $MW->Toplevel(-title => 'CPANPLUS Configuration', -background => 'white');
  $confdlg->geometry('500x500+200+100');

  my $row = 0;
  $confdlg->Label(-text => 'CPANPLUS Configuration', -background => 'white', -font => '{Helvetica} -20 {bold}')->pack(-side => 'top', -pady => 10);
  $row++;
  my $f = $confdlg->Frame(-background => 'white')->pack(-side => 'top');

#---- one line for each option
  foreach (sort @options) {
    $conf_attrs{$_} ||= { type => 's', width => 20,  comment => 'unknown/new option'};
    my $conf_attr;
    if ($conf->can('conf_attr')) {
      $conf_attr = $conf->conf_attr('conf', $_) || {type => 's', width => 20,  comment => 'unknown/new option'};
    } else {
      $conf_attr = $conf_attrs{$_};