[ Index ]

PHP Cross Reference of Unnamed Project

title

Body

[close]

/se3-unattended/var/se3/unattended/install/linuxaux/opt/perl/lib/5.10.0/CPANPLUS/Shell/Default/Plugins/ -> CustomSource.pm (source)

   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      


Generated: Tue Mar 17 22:47:18 2015 Cross-referenced by PHPXref 0.7.1