lib/CPANPLUS/Shell/Default/Plugins/CustomSource.pm

   1 package CPANPLUS::Shell::Default::Plugins::CustomSource;
   2
   3 use strict;
   4 use CPANPLUS::Error                 qw[error msg];
   5 use CPANPLUS::Internals::Constants;
   6
   7 use Data::Dumper;
   8 use Locale::Maketext::Simple        Class => 'CPANPLUS', Style => 'gettext';
   9
  10 =head1 NAME
  11
  12 CPANPLUS::Shell::Default::Plugins::CustomSource
  13
  14 =head1 SYNOPSIS
  15
  16     ### elaborate help text
  17     CPAN Terminal> /? cs
  18
  19     ### add a new custom source
  20     CPAN Terminal> /cs --add file:///path/to/releases
  21
  22     ### list all your custom sources by
  23     CPAN Terminal> /cs --list
  24
  25     ### display the contents of a custom source by URI or ID
  26     CPAN Terminal> /cs --contents file:///path/to/releases
  27     CPAN Terminal> /cs --contents 1
  28
  29     ### Update a custom source by URI or ID
  30     CPAN Terminal> /cs --update file:///path/to/releases
  31     CPAN Terminal> /cs --update 1
  32
  33     ### Remove a custom source by URI or ID
  34     CPAN Terminal> /cs --remove file:///path/to/releases
  35     CPAN Terminal> /cs --remove 1
  36
  37     ### Write an index file for a custom source, to share
  38     ### with 3rd parties or remote users
  39     CPAN Terminal> /cs --write file:///path/to/releases
  40
  41     ### Make sure to save your sources when adding/removing
  42     ### sources, so your changes are reflected in the cache:
  43     CPAN Terminal> x
  44
  45 =head1 DESCRIPTION
  46
  47 This is a C<CPANPLUS::Shell::Default> plugin that can add
  48 custom sources to your CPANPLUS installation. This is a
  49 wrapper around the C<custom module sources> code as outlined
  50 in L<CPANPLUS::Backend/CUSTOM MODULE SOURCES>.
  51
  52 This allows you to extend your index of available modules
  53 beyond what's available on C<CPAN> with your own local
  54 distributions, or ones offered by third parties.
  55
  56 =cut
  57
  58
  59 sub plugins {
  60     return ( cs => 'custom_source' )
  61 }
  62
  63 my $Cb;
  64 my $Shell;
  65 my @Index   = ();
  66
  67 sub _uri_from_cache {
  68     my $self    = shift;
  69     my $input   = shift or return;
  70
  71     ### you gave us a search number
  72     my $uri = $input =~ /^\d+$/
  73                 ? $Index[ $input - 1 ] # remember, off by 1!
  74                 : $input;
  75
  76     my %files = reverse $Cb->list_custom_sources;
  77
  78     ### it's an URI we know
  79     if( my $local = $files{ $uri } ) {
  80         return wantarray
  81             ? ($uri, $local)
  82             : $uri;
  83     }
  84
  85     ### couldn't resolve the input
  86     error(loc("Unknown URI/index: '%1'", $input));
  87     return;
  88 }
  89
  90 sub _list_custom_sources {
  91     my $class = shift;
  92
  93     my %files = $Cb->list_custom_sources;
  94
  95     $Shell->__print( loc("Your remote sources:"), $/ ) if keys %files;
  96
  97     my $i = 0;
  98     while(my($local,$remote) = each %files) {
  99         $Shell->__printf( "   [%2d] %s\n", ++$i, $remote );
 100
 101         ### remember, off by 1!
 102         push @Index, $remote;
 103     }
 104
 105     $Shell->__print( $/ );
 106 }
 107
 108 sub _list_contents {
 109     my $class = shift;
 110     my $input = shift;
 111
 112     my ($uri,$local) = $class->_uri_from_cache( $input );
 113     unless( $uri ) {
 114         error(loc("--contents needs URI parameter"));
 115         return;
 116     }
 117
 118     my $fh = OPEN_FILE->( $local ) or return;
 119
 120     $Shell->__printf( "   %s", $_ ) for sort <$fh>;
 121     $Shell->__print( $/ );
 122 }
 123
 124 sub custom_source {
 125     my $class   = shift;
 126     my $shell   = shift;    $Shell  = $shell;   # available to all methods now
 127     my $cb      = shift;    $Cb     = $cb;      # available to all methods now
 128     my $cmd     = shift;
 129     my $input   = shift || '';
 130     my $opts    = shift || {};
 131
 132     ### show a list
 133     if( $opts->{'list'} ) {
 134         $class->_list_custom_sources;
 135
 136     } elsif ( $opts->{'contents'} ) {
 137         $class->_list_contents( $input );
 138
 139     } elsif ( $opts->{'add'} ) {
 140         unless( $input ) {
 141             error(loc("--add needs URI parameter"));
 142             return;
 143         }
 144
 145         $cb->add_custom_source( uri => $input )
 146             and $shell->__print(loc("Added remote source '%1'", $input), $/);
 147
 148         $Shell->__print($/, loc("Remote source contains:"), $/, $/);
 149         $class->_list_contents( $input );
 150
 151     } elsif ( $opts->{'remove'} ) {
 152         my($uri,$local) = $class->_uri_from_cache( $input );
 153         unless( $uri ) {
 154             error(loc("--remove needs URI parameter"));
 155             return;
 156         }
 157
 158         1 while unlink $local;
 159
 160         $shell->__print( loc("Removed remote source '%1'", $uri), $/ );
 161
 162     } elsif ( $opts->{'update'} ) {
 163         ### did we get input? if so, it's a remote part
 164         my $uri = $class->_uri_from_cache( $input );
 165
 166         $cb->update_custom_source( $uri ? ( remote => $uri ) : () )
 167             and do { $shell->__print( loc("Updated remote sources"), $/ ) };
 168
 169     } elsif ( $opts->{'write'} ) {
 170         $cb->write_custom_source_index( path => $input ) and
 171             $shell->__print( loc("Wrote remote source index for '%1'", $input), $/);
 172
 173     } else {
 174         error(loc("Unrecognized command, see '%1' for help", '/? cs'));
 175     }
 176
 177     return;
 178 }
 179
 180 sub custom_source_help {
 181     return loc(
 182                                                                           $/ .
 183         '    # Plugin to manage custom sources from the default shell'  . $/ .
 184         "    # See the 'CUSTOM MODULE SOURCES' section in the "         . $/ .
 185         '    # CPANPLUS::Backend documentation for details.'            . $/ .
 186         '    /cs --list                     # list available sources'   . $/ .
 187         '    /cs --add       URI            # add source'               . $/ .
 188         '    /cs --remove    URI | INDEX    # remove source'            . $/ .
 189         '    /cs --contents  URI | INDEX    # show packages from source'. $/ .
 190         '    /cs --update   [URI | INDEX]   # update source index'      . $/ .
 191         '    /cs --write     PATH           # write source index'       . $/
 192     );
 193
 194 }
 195
 196 1;
 197