Commit | Line | Data |
5bc5f6dc |
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 |
5879cbe1 |
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 ) { |
5bc5f6dc |
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 | |