view release on metacpan or  search on metacpan

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

                                            $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{$_};
    }

    SWITCH:  {   # tried the Switch module here, but it choked on something
      if ($conf_attr->{type} eq 'a') { $conf{$_} = join ';', @{$conf->get_conf($_)}; last SWITCH }
      if ($conf_attr->{type} eq 's') { $conf{$_} = $conf->get_conf($_); last SWITCH }
      if ($conf_attr->{type} eq 'h') { my %tempconf = %{$conf->get_conf($_)};
                                       $conf{$_} = join ', ', map { "$_ => '$tempconf{$_}'"} keys %tempconf; }
    }
    $f->Label(-text => $_, -background => 'white')->grid(-column => 1, -row => $row, -sticky => 'w');
    $f->Entry(-textvariable => \$conf{$_}, -width => $conf_attr->{width} || 20)->grid(-column => 2, -row => $row, -sticky => 'w');
    $f->Label(-text => $conf_attr->{comment}, -background => 'white')->grid(-column => 3, -row => $row, -sticky => 'w');
    $row++;
  }

#---- the normal buttons
  my $ok = $f->Button(-text => 'Ok',
                  -pady     => -1,
                   -default => 'active',
                   -command => sub {
                                 $confdlg->destroy();
                                 foreach (@options) {
                                    SWITCH:  {
                                      if ($conf_attrs{$_}->{type} eq 'a') { $conf->set_conf($_ => [split /;/, $conf{$_}]); last SWITCH }
                                      if ($conf_attrs{$_}->{type} eq 's') { $conf->set_conf($_ => $conf{$_}); last SWITCH }
                                      if ($conf_attrs{$_}->{type} eq 'h') { my %tempconf = eval "($conf{$_})";
                                                                            $conf->set_conf($_ => \%tempconf); }
                                    }
                                 }
                               })->grid(-column => 1, -row => ++$row, -pady => 20);
  $f->Button(-text => 'Cancel',
                  -pady     => -1,
                   -command => sub {
                                 $confdlg->destroy();
                               })->grid(-column => 2, -row => $row, -pady => 20);
  $f->Button(-text => 'Save',
                  -pady     => -1,
                   -command => sub {
                                 $confdlg->destroy();