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, $module, $success) = @_[KERNEL, ARG0, ARG1];
 246     # FIXME: what if wrong
 247     # FIXME: don't submit if missing deps on bs
 248     $k->post($module, 'build_upstream');
 249 }
 250
 251
 252 sub upstream_status {
 253     my ($k, $module, $is_available) = @_[KERNEL, ARG0, ARG1];
 254     my $event = $is_available ? 'install_from_dist' : 'find_prereqs';
 255     $k->post($module, $event);
 256 }
 257
 258
 259 # -- poe inline states
 260
 261 sub _start {
 262     my ($k, $opts) = @_[KERNEL, ARG0];
 263     $k->alias_set('app');
 264
 265     # start packaging some modules
 266     my $modules = $opts->{modules};
 267     foreach my $name ( @$modules ) {
 268         my $module = App::CPAN2Pkg::Module->new( name => $name );
 269         $k->yield('package', $module);
 270     }
 271 }
 272
 273
 274 1;
 275 __END__
 276
 277 =head1 NAME
 278
 279 App::CPAN2Pkg - generating native linux packages from cpan
 280
 281
 282
 283 =head1 SYNOPSIS
 284
 285     $ cpan2pkg
 286     $ cpan2pkg Module::Foo Module::Bar ...
 287
 288
 289
 290 =head1 DESCRIPTION
 291
 292 Don't use this module directly, refer to the C<cpan2pkg> script instead.
 293
 294 C<App::CPAN2Pkg> is the controller for the C<cpan2pkg> application. It
 295 implements a POE session, responsible to schedule and advance module
 296 packagement.
 297
 298 It is spawned by the poe session responsible for the user interface.
 299
 300
 301
 302 =head1 PUBLIC PACKAGE METHODS
 303
 304 =head2 my $id = App::CPAN2Pkg->spawn( \%params )
 305
 306 This method will create a POE session responsible for coordinating the
 307 package(s) creation.
 308
 309 It will return the POE id of the session newly created.
 310
 311 You can tune the session by passing some arguments as a hash
 312 reference, where the hash keys are:
 313
 314 =over 4
 315
 316 =item * modules => \@list_of_modules
 317
 318 A list of modules to start packaging.
 319
 320
 321 =back
 322
 323
 324
 325 =head1 PUBLIC EVENTS ACCEPTED
 326
 327 The following events are the module's API.
 328
 329
 330 =head2 available_on_bs()
 331
 332 Sent when module is available on upstream build system.
 333
 334
 335 =head2 cpan2dist_status( $module, $success )
 336
 337 Sent when C<$module> has been C<cpan2dist>-ed, with C<$success> being true
 338 if everything went fine.
 339
 340
 341 =head2 local_install( $module, $success )
 342
 343 Sent when C<$module> has been installed locally, with C<$success> return value.
 344
 345
 346 =head2 local_status( $module, $is_installed )
 347
 348 Sent when C<$module> knows whether it is installed locally (C<$is_installed>
 349 set to true) or not.
 350
 351
 352 =head2 module_spawned( $module )
 353
 354 Sent when C<$module> has been spawned successfully.
 355
 356
 357 =head2 package( $module )
 358
 359 Request the application to package (if needed) a C<$module> (an
 360 C<App::CPAN2Pkg::Module> object).
 361
 362
 363 =head2 prereqs( $module, @prereqs )
 364
 365 Inform main application that C<$module> needs some C<@prereqs> (possibly
 366 empty).
 367
 368
 369 =head2 upstream_import( $module, $success )
 370
 371 Sent when C<$module> package has been imported in upstream repository.
 372
 373
 374 =head2 upstream_install( $module, $success )
 375
 376 Sent after trying to install C<$module> from upstream dist. Result is passed
 377 along with C<$success>.
 378
 379
 380 =head2 upstream_status( $module, $is_available )
 381
 382 Sent when C<$module> knows whether it is available upstream (C<$is_available>
 383 set to true) or not.
 384
 385
 386
 387 =head1 BUGS
 388
 389 Please report any bugs or feature requests to C<app-cpan2pkg at
 390 rt.cpan.org>, or through the web interface at
 391 L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=App-CPAN2Pkg>. I will
 392 be notified, and then you'll automatically be notified of progress on
 393 your bug as I make changes.
 394
 395
 396
 397 =head1 SEE ALSO
 398
 399 Our git repository is located at L<git://repo.or.cz/app-cpan2pkg.git>,
 400 and can be browsed at L<http://repo.or.cz/w/app-cpan2pkg.git>.
 401
 402
 403 You can also look for information on this module at:
 404
 405 =over 4
 406
 407 =item * AnnoCPAN: Annotated CPAN documentation
 408
 409 L<http://annocpan.org/dist/App-CPAN2Pkg>
 410
 411 =item * CPAN Ratings
 412
 413 L<http://cpanratings.perl.org/d/App-CPAN2Pkg>
 414
 415 =item * Open bugs
 416
 417 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=App-CPAN2Pkg>
 418
 419 =back
 420
 421
 422
 423 =head1 AUTHOR
 424
 425 Jerome Quelin, C<< <jquelin@cpan.org> >>
 426
 427
 428
 429 =head1 COPYRIGHT & LICENSE
 430
 431 Copyright (c) 2009 Jerome Quelin, all rights reserved.
 432
 433 This program is free software; you can redistribute it and/or modify
 434 it under the same terms as Perl itself.
 435
 436 =cut
 437