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