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 = '0.5.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     my @depends = $module->blocking_list;
 152     $module->blocking_clear;
 153
 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);
 161
 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');
 166         }
 167     }
 168 }
 169
 170 sub module_spawned {
 171     my ($k, $h, $module) = @_[KERNEL, HEAP, ARG0];
 172     my $name = $module->name;
 173     $h->_module->{$name} = $module;
 174     $k->post($module, 'is_installed');
 175 }
 176
 177 sub package {
 178     my ($k, $h, $module) = @_[KERNEL, HEAP, ARG0];
 179     App::CPAN2Pkg::Worker->spawn($module);
 180 }
 181
 182 sub prereqs {
 183     my ($k, $h, $module, @prereqs) = @_[KERNEL, HEAP, ARG0..$#_];
 184
 185     my @missing;
 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;
 192         }
 193
 194         # store missing module.
 195         push @missing, $m unless $h->_module->{$m}->is_local;
 196     }
 197
 198     $k->post('ui', 'prereqs', $module, @missing);
 199     if ( @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;
 204
 205     } else {
 206         # no prereqs, move on
 207         $k->post($module, 'cpan2dist');
 208         return;
 209     }
 210 }
 211
 212 sub upstream_install {
 213     my ($k, $h, $module, $success) = @_[KERNEL, HEAP, ARG0, ARG1];
 214
 215     # FIXME: what if $success is a failure?
 216
 217     # module is already installed locally.
 218     $k->post('ui', 'module_available', $module);
 219     $k->post('ui', 'prereqs', $module);
 220
 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;
 226
 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);
 234
 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');
 239         }
 240     }
 241 }
 242
 243
 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 );
 251     }
 252     $k->post($module, 'build_upstream');
 253 }
 254
 255
 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);
 260 }
 261
 262
 263 # -- poe inline states
 264
 265 sub _start {
 266     my ($k, $opts) = @_[KERNEL, ARG0];
 267     $k->alias_set('app');
 268
 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);
 274     }
 275 }
 276
 277
 278 1;
 279 __END__
 280
 281 =head1 NAME
 282
 283 App::CPAN2Pkg - generating native linux packages from cpan
 284
 285
 286
 287 =head1 SYNOPSIS
 288
 289     $ cpan2pkg
 290     $ cpan2pkg Module::Foo Module::Bar ...
 291
 292
 293
 294 =head1 DESCRIPTION
 295
 296 Don't use this module directly, refer to the C<cpan2pkg> script instead.
 297
 298 C<App::CPAN2Pkg> is the controller for the C<cpan2pkg> application. It
 299 implements a POE session, responsible to schedule and advance module
 300 packagement.
 301
 302 It is spawned by the poe session responsible for the user interface.
 303
 304
 305
 306 =head1 PUBLIC PACKAGE METHODS
 307
 308 =head2 my $id = App::CPAN2Pkg->spawn( \%params )
 309
 310 This method will create a POE session responsible for coordinating the
 311 package(s) creation.
 312
 313 It will return the POE id of the session newly created.
 314
 315 You can tune the session by passing some arguments as a hash
 316 reference, where the hash keys are:
 317
 318 =over 4
 319
 320 =item * modules => \@list_of_modules
 321
 322 A list of modules to start packaging.
 323
 324
 325 =back
 326
 327
 328
 329 =head1 PUBLIC EVENTS ACCEPTED
 330
 331 The following events are the module's API.
 332
 333
 334 =head2 available_on_bs()
 335
 336 Sent when module is available on upstream build system.
 337
 338
 339 =head2 cpan2dist_status( $module, $success )
 340
 341 Sent when C<$module> has been C<cpan2dist>-ed, with C<$success> being true
 342 if everything went fine.
 343
 344
 345 =head2 local_install( $module, $success )
 346
 347 Sent when C<$module> has been installed locally, with C<$success> return value.
 348
 349
 350 =head2 local_status( $module, $is_installed )
 351
 352 Sent when C<$module> knows whether it is installed locally (C<$is_installed>
 353 set to true) or not.
 354
 355
 356 =head2 module_spawned( $module )
 357
 358 Sent when C<$module> has been spawned successfully.
 359
 360
 361 =head2 package( $module )
 362
 363 Request the application to package (if needed) a C<$module> (an
 364 C<App::CPAN2Pkg::Module> object).
 365
 366
 367 =head2 prereqs( $module, @prereqs )
 368
 369 Inform main application that C<$module> needs some C<@prereqs> (possibly
 370 empty).
 371
 372
 373 =head2 upstream_import( $module, $success )
 374
 375 Sent when C<$module> package has been imported in upstream repository.
 376
 377
 378 =head2 upstream_install( $module, $success )
 379
 380 Sent after trying to install C<$module> from upstream dist. Result is passed
 381 along with C<$success>.
 382
 383
 384 =head2 upstream_status( $module, $is_available )
 385
 386 Sent when C<$module> knows whether it is available upstream (C<$is_available>
 387 set to true) or not.
 388
 389
 390
 391 =head1 BUGS
 392
 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.
 398
 399
 400
 401 =head1 SEE ALSO
 402
 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>.
 405
 406
 407 You can also look for information on this module at:
 408
 409 =over 4
 410
 411 =item * AnnoCPAN: Annotated CPAN documentation
 412
 413 L<http://annocpan.org/dist/App-CPAN2Pkg>
 414
 415 =item * CPAN Ratings
 416
 417 L<http://cpanratings.perl.org/d/App-CPAN2Pkg>
 418
 419 =item * Open bugs
 420
 421 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=App-CPAN2Pkg>
 422
 423 =back
 424
 425
 426
 427 =head1 AUTHOR
 428
 429 Jerome Quelin, C<< <jquelin@cpan.org> >>
 430
 431
 432
 433 =head1 COPYRIGHT & LICENSE
 434
 435 Copyright (c) 2009 Jerome Quelin, all rights reserved.
 436
 437 This program is free software; you can redistribute it and/or modify
 438 it under the same terms as Perl itself.
 439
 440 =cut
 441