2 # This file is part of App::CPAN2Pkg.
3 # Copyright (c) 2009 Jerome Quelin, all rights reserved.
5 # This program is free software; you can redistribute it and/or modify
6 # it under the same terms as Perl itself.
10 package App
::CPAN2Pkg
;
15 use App
::CPAN2Pkg
::Module
;
16 use App
::CPAN2Pkg
::Worker
;
18 constructor
=> '_new',
24 our $VERSION = '0.5.0';
27 my ($class, $opts) = @_;
29 # create the heap object
30 my $obj = App
::CPAN2Pkg
->_new(
31 _module
=> {}, # {name}=obj store the objects
34 # create the main session
35 my $session = POE
::Session
->create(
38 available_on_bs
=> \
&available_on_bs
,
39 cpan2dist_status
=> \
&cpan2dist_status
,
40 upstream_status
=> \
&upstream_status
,
41 local_install
=> \
&local_install
,
42 local_status
=> \
&local_status
,
43 module_spawned
=> \
&module_spawned
,
46 upstream_import
=> \
&upstream_import
,
47 upstream_install
=> \
&upstream_install
,
50 #_stop => sub { warn "stop app\n"; },
64 # if ( not available in cooker ) is_in_dist
66 # compute dependencies find_prereqs
67 # repeat with each dep
69 # install local install_from_local
70 # while ( not available locally ) is_installed
72 # prompt user to fix manually
74 # import import_local_to_dist
75 # submit (included above)
76 # ack available (manual?)
79 # urpmi --auto perl(module::to::install) install_from_dist
85 # FIXME: start submitting upstream what depends on this
89 sub cpan2dist_status
{
90 my ($k, $h, $module, $status) = @_[KERNEL
, HEAP
, ARG0
, ARG1
];
91 # FIXME: what if $status is false
93 $k->post($module, 'install_from_local');
98 my ($k, $h, $module, $success) = @_[KERNEL
, HEAP
, ARG0
, ARG1
];
100 if ( not $success ) {
101 # module has not been installed locally.
106 # module has been installed locally.
107 $k->post('ui', 'module_available', $module);
109 # module available: nothing depends on it anymore.
110 my $name = $module->name;
111 $module->is_local(1);
112 my @depends = $module->blocking_list;
113 $module->blocking_clear;
115 # update all modules that were depending on it
116 foreach my $m ( @depends ) {
117 # remove dependency on module
118 my $mobj = $h->_module->{$m};
119 $mobj->missing_del($name);
120 my @missing = $mobj->missing_list;
121 $k->post('ui', 'prereqs', $mobj, @missing);
123 if ( scalar @missing == 0 ) {
124 # huzzah! no more missing prereqs - let's create a
125 # native package for it.
126 $k->post($mobj, 'cpan2dist');
130 $k->post($module, 'import_upstream');
135 my ($k, $h, $module, $is_installed) = @_[KERNEL
, HEAP
, ARG0
, ARG1
];
137 if ( not $is_installed ) {
138 # module is not installed locally, check if
139 # it's available upstream.
140 $k->post($module, 'is_in_dist');
144 # module is already installed locally.
145 $k->post('ui', 'module_available', $module);
146 $k->post('ui', 'prereqs', $module);
148 # module available: nothing depends on it anymore.
149 my $name = $module->name;
150 $module->is_local(1);
151 my @depends = $module->blocking_list;
152 $module->blocking_clear;
154 # update all modules that were depending on it
155 foreach my $m ( @depends ) {
156 # remove dependency on module
157 my $mobj = $h->_module->{$m};
158 $mobj->missing_del($name);
159 my @missing = $mobj->missing_list;
160 $k->post('ui', 'prereqs', $mobj, @missing);
162 if ( scalar @missing == 0 ) {
163 # huzzah! no more missing prereqs - let's create a
164 # native package for it.
165 $k->post($mobj, 'cpan2dist');
171 my ($k, $h, $module) = @_[KERNEL
, HEAP
, ARG0
];
172 my $name = $module->name;
173 $h->_module->{$name} = $module;
174 $k->post($module, 'is_installed');
178 my ($k, $h, $module) = @_[KERNEL
, HEAP
, ARG0
];
179 App
::CPAN2Pkg
::Worker
->spawn($module);
183 my ($k, $h, $module, @prereqs) = @_[KERNEL
, HEAP
, ARG0
..$#_];
186 foreach my $m ( @prereqs ) {
187 # check if module is new. in which case, let's treat it.
188 if ( ! exists $h->_module->{$m} ) {
189 my $mobj = App
::CPAN2Pkg
::Module
->new( name
=> $m );
190 $k->yield('package', $mobj);
191 $h->_module->{$m} = $mobj;
194 # store missing module.
195 push @missing, $m unless $h->_module->{$m}->is_local;
198 $k->post('ui', 'prereqs', $module, @missing);
200 # module misses some prereqs - wait for them.
201 my $name = $module->name;
202 $module->missing_add($_) for @missing;
203 $h->_module->{$_}->blocking_add($name) for @missing;
206 # no prereqs, move on
207 $k->post($module, 'cpan2dist');
212 sub upstream_install
{
213 my ($k, $h, $module, $success) = @_[KERNEL
, HEAP
, ARG0
, ARG1
];
215 # FIXME: what if $success is a failure?
217 # module is already installed locally.
218 $k->post('ui', 'module_available', $module);
219 $k->post('ui', 'prereqs', $module);
221 # module available: nothing depends on it anymore.
222 my $name = $module->name;
223 $module->is_local(1);
224 my @depends = $module->blocking_list;
225 $module->blocking_clear;
227 # update all modules that were depending on it
228 foreach my $m ( @depends ) {
229 # remove dependency on module
230 my $mobj = $h->_module->{$m};
231 $mobj->missing_del($name);
232 my @missing = $mobj->missing_list;
233 $k->post('ui', 'prereqs', $mobj, @missing);
235 if ( scalar @missing == 0 ) {
236 # huzzah! no more missing prereqs - let's create a
237 # native package for it.
238 $k->post($mobj, 'cpan2dist');
244 sub upstream_import
{
245 my ($k, $h, $module, $success) = @_[KERNEL
, HEAP
, ARG0
, ARG1
];
246 # FIXME: what if wrong
247 foreach my $m ( $module->prereqs ) {
248 my $mobj = $h->_module->{$m};
249 next if $mobj->is_available_on_bs;
250 $k->delay( build_upstream
=> 30, $module, $success );
252 $k->post($module, 'build_upstream');
256 sub upstream_status
{
257 my ($k, $module, $is_available) = @_[KERNEL
, ARG0
, ARG1
];
258 my $event = $is_available ?
'install_from_dist' : 'find_prereqs';
259 $k->post($module, $event);
263 # -- poe inline states
266 my ($k, $opts) = @_[KERNEL
, ARG0
];
267 $k->alias_set('app');
269 # start packaging some modules
270 my $modules = $opts->{modules
};
271 foreach my $name ( @
$modules ) {
272 my $module = App
::CPAN2Pkg
::Module
->new( name
=> $name );
273 $k->yield('package', $module);
283 App::CPAN2Pkg - generating native linux packages from cpan
290 $ cpan2pkg Module::Foo Module::Bar ...
296 Don't use this module directly, refer to the C<cpan2pkg> script instead.
298 C<App::CPAN2Pkg> is the controller for the C<cpan2pkg> application. It
299 implements a POE session, responsible to schedule and advance module
302 It is spawned by the poe session responsible for the user interface.
306 =head1 PUBLIC PACKAGE METHODS
308 =head2 my $id = App::CPAN2Pkg->spawn( \%params )
310 This method will create a POE session responsible for coordinating the
313 It will return the POE id of the session newly created.
315 You can tune the session by passing some arguments as a hash
316 reference, where the hash keys are:
320 =item * modules => \@list_of_modules
322 A list of modules to start packaging.
329 =head1 PUBLIC EVENTS ACCEPTED
331 The following events are the module's API.
334 =head2 available_on_bs()
336 Sent when module is available on upstream build system.
339 =head2 cpan2dist_status( $module, $success )
341 Sent when C<$module> has been C<cpan2dist>-ed, with C<$success> being true
342 if everything went fine.
345 =head2 local_install( $module, $success )
347 Sent when C<$module> has been installed locally, with C<$success> return value.
350 =head2 local_status( $module, $is_installed )
352 Sent when C<$module> knows whether it is installed locally (C<$is_installed>
356 =head2 module_spawned( $module )
358 Sent when C<$module> has been spawned successfully.
361 =head2 package( $module )
363 Request the application to package (if needed) a C<$module> (an
364 C<App::CPAN2Pkg::Module> object).
367 =head2 prereqs( $module, @prereqs )
369 Inform main application that C<$module> needs some C<@prereqs> (possibly
373 =head2 upstream_import( $module, $success )
375 Sent when C<$module> package has been imported in upstream repository.
378 =head2 upstream_install( $module, $success )
380 Sent after trying to install C<$module> from upstream dist. Result is passed
381 along with C<$success>.
384 =head2 upstream_status( $module, $is_available )
386 Sent when C<$module> knows whether it is available upstream (C<$is_available>
393 Please report any bugs or feature requests to C<app-cpan2pkg at
394 rt.cpan.org>, or through the web interface at
395 L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=App-CPAN2Pkg>. I will
396 be notified, and then you'll automatically be notified of progress on
397 your bug as I make changes.
403 Our git repository is located at L<git://repo.or.cz/app-cpan2pkg.git>,
404 and can be browsed at L<http://repo.or.cz/w/app-cpan2pkg.git>.
407 You can also look for information on this module at:
411 =item * AnnoCPAN: Annotated CPAN documentation
413 L<http://annocpan.org/dist/App-CPAN2Pkg>
417 L<http://cpanratings.perl.org/d/App-CPAN2Pkg>
421 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=App-CPAN2Pkg>
429 Jerome Quelin, C<< <jquelin@cpan.org> >>
433 =head1 COPYRIGHT & LICENSE
435 Copyright (c) 2009 Jerome Quelin, all rights reserved.
437 This program is free software; you can redistribute it and/or modify
438 it under the same terms as Perl itself.