lib/App/CPAN2Pkg.pm

   1 #
   2 # This file is part of App::CPAN2Pkg.
   3 # Copyright (c) 2009 Jerome Quelin, all rights reserved.
   4 #
   5 # This program is free software; you can redistribute it and/or modify
   6 # it under the same terms as Perl itself.
   7 #
   8 #
   9
  10 package App::CPAN2Pkg;
  11
  12 use strict;
  13 use warnings;
  14
  15 use App::CPAN2Pkg::Module;
  16 use App::CPAN2Pkg::Worker;
  17 use Class::XSAccessor
  18     constructor => '_new',
  19     accessors   => {
  20         _module    => '_module',
  21     };
  22 use POE;
  23
  24 our $VERSION = '1.1.0';
  25
  26 sub spawn {
  27     my ($class, $opts) = @_;
  28
  29     # create the heap object
  30     my $obj = App::CPAN2Pkg->_new(
  31         _module   => {}, #      {name}=obj store the objects
  32     );
  33
  34     # create the main session
  35     my $session = POE::Session->create(
  36         inline_states => {
  37             # public events
  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,
  44             package              => \&package,
  45             prereqs              => \&prereqs,
  46             upstream_import      => \&upstream_import,
  47             upstream_install     => \&upstream_install,
  48             # poe inline states
  49             _start => \&_start,
  50             #_stop  => sub { warn "stop app\n"; },
  51         },
  52         args => $opts,
  53         heap => $obj,
  54     );
  55     return $session->ID;
  56 }
  57
  58
  59
  60 #--
  61 # SUBS
  62
  63 #
  64 # if ( not available in cooker )                is_in_dist
  65 # then
  66 #   compute dependencies                        find_prereqs
  67 #   repeat with each dep
  68 #   cpan2dist                                   cpan2dist
  69 #   install local                               install_from_local
  70 #   while ( not available locally )             is_installed
  71 #   do
  72 #       prompt user to fix manually
  73 #   done
  74 #   import                                      import_local_to_dist
  75 #   submit                                              (included above)
  76 #   ack available (manual?)
  77 #
  78 # else
  79 #   urpmi --auto perl(module::to::install)       install_from_dist
  80 # fi
  81
  82 # -- public events
  83
  84 sub available_on_bs {
  85     # FIXME: start submitting upstream what depends on this
  86 }
  87
  88
  89 sub cpan2dist_status {
  90     my ($k, $h, $module, $status) = @_[KERNEL, HEAP, ARG0, ARG1];
  91     # FIXME: what if $status is false
  92
  93     $k->post($module, 'install_from_local');
  94 }
  95
  96
  97 sub local_install {
  98     my ($k, $h, $module, $success) = @_[KERNEL, HEAP, ARG0, ARG1];
  99
 100     if ( not $success ) {
 101         # module has not been installed locally.
 102         # FIXME: ask user
 103         return;
 104     }
 105
 106     # module has been installed locally.
 107     $k->post('ui', 'module_available', $module);
 108
 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;
 114
 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);
 122
 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');
 127         }
 128     }
 129
 130     $k->post($module, 'import_upstream');
 131 }
 132
 133
 134 sub local_status {
 135     my ($k, $h, $module, $is_installed) = @_[KERNEL, HEAP, ARG0, ARG1];
 136
 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');
 141         return;
 142     }
 143
 144     # module is already installed locally.
 145     $k->post('ui', 'module_available', $module);
 146     $k->post('ui', 'prereqs', $module);
 147
 148     # module available: nothing depends on it anymore.
 149     my $name = $module->name;
 150     $module->is_local(1);
 151     $module->is_avail_on_bs(1);
 152     my @depends = $module->blocking_list;
 153     $module->blocking_clear;
 154
 155     # update all modules that were depending on it
 156     foreach my $m ( @depends ) {
 157         # remove dependency on module
 158         my $mobj = $h->_module->{$m};
 159         $mobj->missing_del($name);
 160         my @missing = $mobj->missing_list;
 161         $k->post('ui', 'prereqs', $mobj, @missing);
 162
 163         if ( scalar @missing == 0 ) {
 164             # huzzah! no more missing prereqs - let's create a
 165             # native package for it.
 166             $k->post($mobj, 'cpan2dist');
 167         }
 168     }
 169 }
 170
 171 sub module_spawned {
 172     my ($k, $h, $module) = @_[KERNEL, HEAP, ARG0];
 173     my $name = $module->name;
 174     $h->_module->{$name} = $module;
 175     $k->post($module, 'is_installed');
 176 }
 177
 178 sub package {
 179     my ($k, $h, $module) = @_[KERNEL, HEAP, ARG0];
 180     App::CPAN2Pkg::Worker->spawn($module);
 181 }
 182
 183 sub prereqs {
 184     my ($k, $h, $module, @prereqs) = @_[KERNEL, HEAP, ARG0..$#_];
 185
 186     my @missing;
 187     foreach my $m ( @prereqs ) {
 188         # check if module is new. in which case, let's treat it.
 189         if ( ! exists $h->_module->{$m} ) {
 190             my $mobj = App::CPAN2Pkg::Module->new( name => $m );
 191             $k->yield('package', $mobj);
 192             $h->_module->{$m} = $mobj;
 193         }
 194
 195         # store missing module.
 196         push @missing, $m unless $h->_module->{$m}->is_local;
 197     }
 198
 199     $k->post('ui', 'prereqs', $module, @missing);
 200     if ( @missing ) {
 201         # module misses some prereqs - wait for them.
 202         my $name = $module->name;
 203         $module->missing_add($_)               for @missing;
 204         $h->_module->{$_}->blocking_add($name) for @missing;
 205
 206     } else {
 207         # no prereqs, move on
 208         $k->post($module, 'cpan2dist');
 209         return;
 210     }
 211 }
 212
 213 sub upstream_install {
 214     my ($k, $h, $module, $success) = @_[KERNEL, HEAP, ARG0, ARG1];
 215
 216     # FIXME: what if $success is a failure?
 217
 218     # module is already installed locally.
 219     $k->post('ui', 'module_available', $module);
 220     $k->post('ui', 'prereqs', $module);
 221
 222     # module available: nothing depends on it anymore.
 223     my $name = $module->name;
 224     $module->is_local(1);
 225     my @depends = $module->blocking_list;
 226     $module->blocking_clear;
 227
 228     # update all modules that were depending on it
 229     foreach my $m ( @depends ) {
 230         # remove dependency on module
 231         my $mobj = $h->_module->{$m};
 232         $mobj->missing_del($name);
 233         my @missing = $mobj->missing_list;
 234         $k->post('ui', 'prereqs', $mobj, @missing);
 235
 236         if ( scalar @missing == 0 ) {
 237             # huzzah! no more missing prereqs - let's create a
 238             # native package for it.
 239             $k->post($mobj, 'cpan2dist');
 240         }
 241     }
 242 }
 243
 244
 245 sub upstream_import {
 246     my ($k, $h, $module, $success) = @_[KERNEL, HEAP, ARG0, ARG1];
 247     # FIXME: what if wrong
 248     my $prereqs = $module->prereqs;
 249     foreach my $m ( @$prereqs ) {
 250         my $mobj = $h->_module->{$m};
 251         next if $mobj->is_avail_on_bs;
 252         $k->delay( upstream_import => 30, $module, $success );
 253         return;
 254     }
 255     $k->post($module, 'build_upstream');
 256 }
 257
 258
 259 sub upstream_status {
 260     my ($k, $module, $is_available) = @_[KERNEL, ARG0, ARG1];
 261     my $event = $is_available ? 'install_from_dist' : 'find_prereqs';
 262     $k->post($module, $event);
 263 }
 264
 265
 266 # -- poe inline states
 267
 268 sub _start {
 269     my ($k, $opts) = @_[KERNEL, ARG0];
 270     $k->alias_set('app');
 271
 272     # start packaging some modules
 273     my $modules = $opts->{modules};
 274     foreach my $name ( @$modules ) {
 275         my $module = App::CPAN2Pkg::Module->new( name => $name );
 276         $k->yield('package', $module);
 277     }
 278 }
 279
 280
 281 1;
 282 __END__
 283
 284 =head1 NAME
 285
 286 App::CPAN2Pkg - generating native linux packages from cpan
 287
 288
 289
 290 =head1 SYNOPSIS
 291
 292     $ cpan2pkg
 293     $ cpan2pkg Module::Foo Module::Bar ...
 294
 295
 296
 297 =head1 DESCRIPTION
 298
 299 Don't use this module directly, refer to the C<cpan2pkg> script instead.
 300
 301 C<App::CPAN2Pkg> is the controller for the C<cpan2pkg> application. It
 302 implements a POE session, responsible to schedule and advance module
 303 packagement.
 304
 305 It is spawned by the poe session responsible for the user interface.
 306
 307
 308
 309 =head1 PUBLIC PACKAGE METHODS
 310
 311 =head2 my $id = App::CPAN2Pkg->spawn( \%params )
 312
 313 This method will create a POE session responsible for coordinating the
 314 package(s) creation.
 315
 316 It will return the POE id of the session newly created.
 317
 318 You can tune the session by passing some arguments as a hash
 319 reference, where the hash keys are:
 320
 321 =over 4
 322
 323 =item * modules => \@list_of_modules
 324
 325 A list of modules to start packaging.
 326
 327
 328 =back
 329
 330
 331
 332 =head1 PUBLIC EVENTS ACCEPTED
 333
 334 The following events are the module's API.
 335
 336
 337 =head2 available_on_bs()
 338
 339 Sent when module is available on upstream build system.
 340
 341
 342 =head2 cpan2dist_status( $module, $success )
 343
 344 Sent when C<$module> has been C<cpan2dist>-ed, with C<$success> being true
 345 if everything went fine.
 346
 347
 348 =head2 local_install( $module, $success )
 349
 350 Sent when C<$module> has been installed locally, with C<$success> return value.
 351
 352
 353 =head2 local_status( $module, $is_installed )
 354
 355 Sent when C<$module> knows whether it is installed locally (C<$is_installed>
 356 set to true) or not.
 357
 358
 359 =head2 module_spawned( $module )
 360
 361 Sent when C<$module> has been spawned successfully.
 362
 363
 364 =head2 package( $module )
 365
 366 Request the application to package (if needed) a C<$module> (an
 367 C<App::CPAN2Pkg::Module> object).
 368
 369
 370 =head2 prereqs( $module, @prereqs )
 371
 372 Inform main application that C<$module> needs some C<@prereqs> (possibly
 373 empty).
 374
 375
 376 =head2 upstream_import( $module, $success )
 377
 378 Sent when C<$module> package has been imported in upstream repository.
 379
 380
 381 =head2 upstream_install( $module, $success )
 382
 383 Sent after trying to install C<$module> from upstream dist. Result is passed
 384 along with C<$success>.
 385
 386
 387 =head2 upstream_status( $module, $is_available )
 388
 389 Sent when C<$module> knows whether it is available upstream (C<$is_available>
 390 set to true) or not.
 391
 392
 393
 394 =head1 BUGS
 395
 396 Please report any bugs or feature requests to C<app-cpan2pkg at
 397 rt.cpan.org>, or through the web interface at
 398 L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=App-CPAN2Pkg>. I will
 399 be notified, and then you'll automatically be notified of progress on
 400 your bug as I make changes.
 401
 402
 403
 404 =head1 SEE ALSO
 405
 406 Our git repository is located at L<git://repo.or.cz/app-cpan2pkg.git>,
 407 and can be browsed at L<http://repo.or.cz/w/app-cpan2pkg.git>.
 408
 409
 410 You can also look for information on this module at:
 411
 412 =over 4
 413
 414 =item * AnnoCPAN: Annotated CPAN documentation
 415
 416 L<http://annocpan.org/dist/App-CPAN2Pkg>
 417
 418 =item * CPAN Ratings
 419
 420 L<http://cpanratings.perl.org/d/App-CPAN2Pkg>
 421
 422 =item * Open bugs
 423
 424 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=App-CPAN2Pkg>
 425
 426 =back
 427
 428
 429
 430 =head1 AUTHOR
 431
 432 Jerome Quelin, C<< <jquelin@cpan.org> >>
 433
 434
 435
 436 =head1 COPYRIGHT & LICENSE
 437
 438 Copyright (c) 2009 Jerome Quelin, all rights reserved.
 439
 440 This program is free software; you can redistribute it and/or modify
 441 it under the same terms as Perl itself.
 442
 443 =cut
 444