ext/CPANPLUS/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     ### VMS can lower case all files, so make sure we check that too
  80     my $local = $files{ $uri };
  81        $local = $files{ lc $uri } if !$local && ON_VMS;
  82
  83     if( $local ) {
  84         return wantarray
  85             ? ($uri, $local)
  86             : $uri;
  87     }
  88
  89     ### couldn't resolve the input
  90     error(loc("Unknown URI/index: '%1'", $input));
  91     return;
  92 }
  93
  94 sub _list_custom_sources {
  95     my $class = shift;
  96
  97     my %files = $Cb->list_custom_sources;
  98
  99     $Shell->__print( loc("Your remote sources:"), $/ ) if keys %files;
 100
 101     my $i = 0;
 102     while(my($local,$remote) = each %files) {
 103         $Shell->__printf( "   [%2d] %s\n", ++$i, $remote );
 104
 105         ### remember, off by 1!
 106         push @Index, $remote;
 107     }
 108
 109     $Shell->__print( $/ );
 110 }
 111
 112 sub _list_contents {
 113     my $class = shift;
 114     my $input = shift;
 115
 116     my ($uri,$local) = $class->_uri_from_cache( $input );
 117     unless( $uri ) {
 118         error(loc("--contents needs URI parameter"));
 119         return;
 120     }
 121
 122     my $fh = OPEN_FILE->( $local ) or return;
 123
 124     $Shell->__printf( "   %s", $_ ) for sort <$fh>;
 125     $Shell->__print( $/ );
 126 }
 127
 128 sub custom_source {
 129     my $class   = shift;
 130     my $shell   = shift;    $Shell  = $shell;   # available to all methods now
 131     my $cb      = shift;    $Cb     = $cb;      # available to all methods now
 132     my $cmd     = shift;
 133     my $input   = shift || '';
 134     my $opts    = shift || {};
 135
 136     ### show a list
 137     if( $opts->{'list'} ) {
 138         $class->_list_custom_sources;
 139
 140     } elsif ( $opts->{'contents'} ) {
 141         $class->_list_contents( $input );
 142
 143     } elsif ( $opts->{'add'} ) {
 144         unless( $input ) {
 145             error(loc("--add needs URI parameter"));
 146             return;
 147         }
 148
 149         $cb->add_custom_source( uri => $input )
 150             and $shell->__print(loc("Added remote source '%1'", $input), $/);
 151
 152         $Shell->__print($/, loc("Remote source contains:"), $/, $/);
 153         $class->_list_contents( $input );
 154
 155     } elsif ( $opts->{'remove'} ) {
 156         my($uri,$local) = $class->_uri_from_cache( $input );
 157         unless( $uri ) {
 158             error(loc("--remove needs URI parameter"));
 159             return;
 160         }
 161
 162         1 while unlink $local;
 163
 164         $shell->__print( loc("Removed remote source '%1'", $uri), $/ );
 165
 166     } elsif ( $opts->{'update'} ) {
 167         ### did we get input? if so, it's a remote part
 168         my $uri = $class->_uri_from_cache( $input );
 169
 170         $cb->update_custom_source( $uri ? ( remote => $uri ) : () )
 171             and do { $shell->__print( loc("Updated remote sources"), $/ ) };
 172
 173     } elsif ( $opts->{'write'} ) {
 174         $cb->write_custom_source_index( path => $input ) and
 175             $shell->__print( loc("Wrote remote source index for '%1'", $input), $/);
 176
 177     } else {
 178         error(loc("Unrecognized command, see '%1' for help", '/? cs'));
 179     }
 180
 181     return;
 182 }
 183
 184 sub custom_source_help {
 185     return loc(
 186                                                                           $/ .
 187         '    # Plugin to manage custom sources from the default shell'  . $/ .
 188         "    # See the 'CUSTOM MODULE SOURCES' section in the "         . $/ .
 189         '    # CPANPLUS::Backend documentation for details.'            . $/ .
 190         '    /cs --list                     # list available sources'   . $/ .
 191         '    /cs --add       URI            # add source'               . $/ .
 192         '    /cs --remove    URI | INDEX    # remove source'            . $/ .
 193         '    /cs --contents  URI | INDEX    # show packages from source'. $/ .
 194         '    /cs --update   [URI | INDEX]   # update source index'      . $/ .
 195         '    /cs --write     PATH           # write source index'       . $/
 196     );
 197
 198 }
 199
 200 1;
 201