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 Class::XSAccessor
  17     constructor => '_new',
  18     accessors   => {
  19         _complete  => '_complete',
  20         _missing   => '_missing',
  21         _module    => '_module',
  22         _prereq    => '_prereq',
  23     };
  24 use POE;
  25
  26 our $VERSION = '0.4.1';
  27
  28 sub spawn {
  29     my ($class, $opts) = @_;
  30
  31     # create the heap object
  32     my $obj = App::CPAN2Pkg->_new(
  33         _complete => {},
  34         _missing  => {}, # hoh: {a}{b}=1   mod a needs b
  35         _module   => {}, #      {name}=obj store the objects
  36         _prereq   => {}, # hoh: {a}{b}=1   mod a is a prereq of b
  37     );
  38
  39     # create the main session
  40     my $session = POE::Session->create(
  41         inline_states => {
  42             # public events
  43             cpan2dist_status     => \&cpan2dist_status,
  44             upstream_status      => \&upstream_status,
  45             local_install        => \&local_install,
  46             local_status         => \&local_status,
  47             module_spawned       => \&module_spawned,
  48             package              => \&package,
  49             prereqs              => \&prereqs,
  50             upstream_import      => \&upstream_import,
  51             upstream_install     => \&upstream_install,
  52             # poe inline states
  53             _start => \&_start,
  54             #_stop  => sub { warn "stop app\n"; },
  55         },
  56         args => $opts,
  57         heap => $obj,
  58     );
  59     return $session->ID;
  60 }
  61
  62
  63
  64 #--
  65 # SUBS
  66
  67 #
  68 # if ( not available in cooker )                is_in_dist
  69 # then
  70 #   compute dependencies                        find_prereqs
  71 #   repeat with each dep
  72 #   cpan2dist                                   cpan2dist
  73 #   install local                               install_from_local
  74 #   while ( not available locally )             is_installed
  75 #   do
  76 #       prompt user to fix manually
  77 #   done
  78 #   import                                      import_local_to_dist
  79 #   submit                                              (included above)
  80 #   ack available (manual?)
  81 #
  82 # else
  83 #   urpmi --auto perl(module::to::install)       install_from_dist
  84 # fi
  85
  86 # -- public events
  87
  88 sub cpan2dist_status {
  89     my ($k, $h, $module, $status) = @_[KERNEL, HEAP, ARG0, ARG1];
  90     # FIXME: what if $status is false
  91
  92     $k->post($module, 'install_from_local');
  93 }
  94
  95
  96 sub local_install {
  97     my ($k, $h, $module, $success) = @_[KERNEL, HEAP, ARG0, ARG1];
  98
  99     if ( not $success ) {
 100         # module has not been installed locally.
 101         # FIXME: ask user
 102         return;
 103     }
 104
 105     # module has been installed locally.
 106     $k->post('ui', 'module_available', $module);
 107
 108     # module available: nothing depends on it anymore.
 109     my $name = $module->name;
 110     $h->_complete->{$name} = 1;
 111     my $depends = delete $h->_prereq->{$name};
 112     my @depends = keys %$depends;
 113
 114     # update all modules that were depending on it
 115     my $missing = $h->_missing;
 116     foreach my $m ( @depends ) {
 117         # remove dependency on module
 118         my $mobj = $h->_module->{$m};
 119         my $missed = $missing->{$m};
 120         delete $missed->{$name};
 121         $k->post('ui', 'prereqs', $mobj, keys %$missed);
 122
 123         if ( scalar keys %$missed == 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     $h->_complete->{$name} = 1;
 151     my $depends = delete $h->_prereq->{$name};
 152     my @depends = keys %$depends;
 153
 154     # update all modules that were depending on it
 155     my $missing = $h->_missing;
 156     foreach my $m ( @depends ) {
 157         # remove dependency on module
 158         my $mobj = $h->_module->{$m};
 159         my $missed = $missing->{$m};
 160         delete $missed->{$name};
 161         $k->post('ui', 'prereqs', $mobj, keys %$missed);
 162
 163         if ( scalar keys %$missed == 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::Module->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         $k->yield('package', $m) unless exists $h->_module->{$m};
 190
 191         # store missing module.
 192         push @missing, $m unless exists $h->_complete->{$m};
 193     }
 194
 195     $k->post('ui', 'prereqs', $module, @missing);
 196     if ( @missing ) {
 197         # module misses some prereqs - wait for them.
 198         my $name = $module->name;
 199         $h->_missing->{$name}{$_} = 1 for @missing;
 200         $h->_prereq->{$_}{$name}  = 1 for @missing;
 201
 202     } else {
 203         # no prereqs, move on
 204         $k->post($module, 'cpan2dist');
 205         return;
 206     }
 207 }
 208
 209 sub upstream_install {
 210     my ($k, $module, $success) = @_[KERNEL, ARG0, ARG1];
 211     #$h->_complete->{$name} = 1;
 212     #FIXME: update prereqs
 213 }
 214
 215
 216 sub upstream_import {
 217     my ($k, $module, $success) = @_[KERNEL, ARG0, ARG1];
 218     #FIXME: what if wrong
 219     $k->post($module, 'build_upstream');
 220 }
 221
 222
 223 sub upstream_status {
 224     my ($k, $module, $is_available) = @_[KERNEL, ARG0, ARG1];
 225     my $event = $is_available ? 'install_from_dist' : 'find_prereqs';
 226     $k->post($module, $event);
 227 }
 228
 229
 230 # -- poe inline states
 231
 232 sub _start {
 233     my ($k, $opts) = @_[KERNEL, ARG0];
 234     $k->alias_set('app');
 235
 236     # start packaging some modules
 237     my $modules = $opts->{modules};
 238     $k->yield('package', $_) for @$modules;
 239 }
 240
 241
 242 1;
 243 __END__
 244
 245 =head1 NAME
 246
 247 App::CPAN2Pkg - generating native linux packages from cpan
 248
 249
 250
 251 =head1 SYNOPSIS
 252
 253     $ cpan2pkg
 254     $ cpan2pkg Module::Foo Module::Bar ...
 255
 256
 257
 258 =head1 DESCRIPTION
 259
 260 Don't use this module directly, refer to the C<cpan2pkg> script instead.
 261
 262 C<App::CPAN2Pkg> is the controller for the C<cpan2pkg> application. It
 263 implements a POE session, responsible to schedule and advance module
 264 packagement.
 265
 266 It is spawned by the poe session responsible for the user interface.
 267
 268
 269
 270 =head1 PUBLIC PACKAGE METHODS
 271
 272 =head2 my $id = App::CPAN2Pkg->spawn( \%params )
 273
 274 This method will create a POE session responsible for coordinating the
 275 package(s) creation.
 276
 277 It will return the POE id of the session newly created.
 278
 279 You can tune the session by passing some arguments as a hash
 280 reference, where the hash keys are:
 281
 282 =over 4
 283
 284 =item * modules => \@list_of_modules
 285
 286 A list of modules to start packaging.
 287
 288
 289 =back
 290
 291
 292
 293 =head1 PUBLIC EVENTS ACCEPTED
 294
 295 The following events are the module's API.
 296
 297
 298 =head2 cpan2dist_status( $module, $success )
 299
 300 Sent when C<$module> has been C<cpan2dist>-ed, with C<$success> being true
 301 if everything went fine.
 302
 303
 304 =head2 local_install( $module, $success )
 305
 306 Sent when C<$module> has been installed locally, with C<$success> return value.
 307
 308
 309 =head2 local_status( $module, $is_installed )
 310
 311 Sent when C<$module> knows whether it is installed locally (C<$is_installed>
 312 set to true) or not.
 313
 314
 315 =head2 module_spawned( $module )
 316
 317 Sent when C<$module> has been spawned successfully.
 318
 319
 320 =head2 package( $module )
 321
 322 Request the application to package (if needed) the perl C<$module>. Note
 323 that the module can be either the top-most module of a distribution or
 324 deep inside said distribution.
 325
 326
 327 =head2 prereqs( $module, @prereqs )
 328
 329 Inform main application that C<$module> needs some C<@prereqs> (possibly
 330 empty).
 331
 332
 333 =head2 upstream_import( $module, $success )
 334
 335 Sent when C<$module> package has been imported in upstream repository.
 336
 337
 338 =head2 upstream_install( $module, $success )
 339
 340 Sent after trying to install C<$module> from upstream dist. Result is passed
 341 along with C<$success>.
 342
 343
 344 =head2 upstream_status( $module, $is_available )
 345
 346 Sent when C<$module> knows whether it is available upstream (C<$is_available>
 347 set to true) or not.
 348
 349
 350
 351 =head1 BUGS
 352
 353 Please report any bugs or feature requests to C<app-cpan2pkg at
 354 rt.cpan.org>, or through the web interface at
 355 L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=App-CPAN2Pkg>. I will
 356 be notified, and then you'll automatically be notified of progress on
 357 your bug as I make changes.
 358
 359
 360
 361 =head1 SEE ALSO
 362
 363 Our git repository is located at L<git://repo.or.cz/app-cpan2pkg.git>,
 364 and can be browsed at L<http://repo.or.cz/w/app-cpan2pkg.git>.
 365
 366
 367 You can also look for information on this module at:
 368
 369 =over 4
 370
 371 =item * AnnoCPAN: Annotated CPAN documentation
 372
 373 L<http://annocpan.org/dist/App-CPAN2Pkg>
 374
 375 =item * CPAN Ratings
 376
 377 L<http://cpanratings.perl.org/d/App-CPAN2Pkg>
 378
 379 =item * Open bugs
 380
 381 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=App-CPAN2Pkg>
 382
 383 =back
 384
 385
 386
 387 =head1 AUTHOR
 388
 389 Jerome Quelin, C<< <jquelin@cpan.org> >>
 390
 391
 392
 393 =head1 COPYRIGHT & LICENSE
 394
 395 Copyright (c) 2009 Jerome Quelin, all rights reserved.
 396
 397 This program is free software; you can redistribute it and/or modify
 398 it under the same terms as Perl itself.
 399
 400 =cut
 401