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.3.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_status         => \&local_status,
  46             module_spawned       => \&module_spawned,
  47             package              => \&package,
  48             prereqs              => \&prereqs,
  49             upstream_install     => \&upstream_install,
  50             # poe inline states
  51             _start => \&_start,
  52             #_stop  => sub { warn "stop app\n"; },
  53         },
  54         args => $opts,
  55         heap => $obj,
  56     );
  57     return $session->ID;
  58 }
  59
  60
  61
  62 #--
  63 # SUBS
  64
  65 #
  66 # if ( not available in cooker )                is_in_dist
  67 # then
  68 #   compute dependencies                        find_prereqs
  69 #   repeat with each dep
  70 #   cpan2dist                                   cpan2dist
  71 #   install local                               install_from_local
  72 #   while ( not available locally )             is_installed
  73 #   do
  74 #       prompt user to fix manually
  75 #   done
  76 #   import                                      import_local_to_dist
  77 #   submit                                              (included above)
  78 #   ack available (manual?)
  79 #
  80 # else
  81 #   urpmi --auto perl(module::to::install)       install_from_dist
  82 # fi
  83
  84 # -- public events
  85
  86 sub cpan2dist_status {
  87     my ($k, $h, $module, $status) = @_[KERNEL, HEAP, ARG0, ARG1];
  88     # FIXME: what if $status is false
  89
  90     $k->post($module, 'install_from_local');
  91 }
  92
  93
  94 sub local_status {
  95     my ($k, $h, $module, $is_installed) = @_[KERNEL, HEAP, ARG0, ARG1];
  96
  97     if ( not $is_installed ) {
  98         # module is not installed locally, check if
  99         # it's available upstream.
 100         $k->post($module, 'is_in_dist');
 101         return;
 102     }
 103
 104     # module is already installed locally.
 105     $k->post('ui', 'module_available', $module);
 106     $k->post('ui', 'prereqs', $module);
 107
 108     # module available: nothing depends on it anymore.
 109     my $name = $module->name;
 110     my $depends = delete $h->_prereq->{$name};
 111     my @depends = keys %$depends;
 112
 113     # update all modules that were depending on it
 114     my $missing = $h->_missing;
 115     foreach my $m ( @depends ) {
 116         # remove dependency on module
 117         my $mobj = $h->_module->{$m};
 118         my $missed = $missing->{$m};
 119         delete $missed->{$name};
 120         $k->post('ui', 'prereqs', $mobj, keys %$missed);
 121
 122         if ( scalar keys %$missed == 0 ) {
 123             # huzzah! no more missing prereqs - let's create a
 124             # native package for it.
 125             $k->post($mobj, 'cpan2dist');
 126         }
 127     }
 128 }
 129
 130 sub module_spawned {
 131     my ($k, $h, $module) = @_[KERNEL, HEAP, ARG0];
 132     my $name = $module->name;
 133     $h->_module->{$name} = $module;
 134     $k->post($module, 'is_installed');
 135 }
 136
 137 sub package {
 138     my ($k, $h, $module) = @_[KERNEL, HEAP, ARG0];
 139     App::CPAN2Pkg::Module->spawn($module);
 140 }
 141
 142 sub prereqs {
 143     my ($k, $h, $module, @prereqs) = @_[KERNEL, HEAP, ARG0..$#_];
 144
 145     my @missing;
 146     foreach my $m ( @prereqs ) {
 147         # check if module is new. in which case, let's treat it.
 148         $k->yield('package', $m) unless exists $h->_module->{$m};
 149
 150         # store missing module.
 151         push @missing, $m unless exists $h->_complete->{$m};
 152     }
 153
 154     $k->post('ui', 'prereqs', $module, @missing);
 155     if ( @missing ) {
 156         # module misses some prereqs - wait for them.
 157         my $name = $module->name;
 158         $h->_missing->{$name}{$_} = 1 for @missing;
 159         $h->_prereq->{$_}{$name}  = 1 for @missing;
 160
 161     } else {
 162         # no prereqs, move on
 163         $k->post($module, 'cpan2dist');
 164         return;
 165     }
 166 }
 167
 168 sub upstream_install {
 169     my ($k, $module, $success) = @_[KERNEL, ARG0, ARG1];
 170     #FIXME: update prereqs
 171 }
 172
 173 sub upstream_status {
 174     my ($k, $module, $is_available) = @_[KERNEL, ARG0, ARG1];
 175     my $event = $is_available ? 'install_from_dist' : 'find_prereqs';
 176     $k->post($module, $event);
 177 }
 178
 179
 180 # -- poe inline states
 181
 182 sub _start {
 183     my ($k, $opts) = @_[KERNEL, ARG0];
 184     $k->alias_set('app');
 185
 186     # start packaging some modules
 187     my $modules = $opts->{modules};
 188     $k->yield('package', $_) for @$modules;
 189 }
 190
 191
 192 1;
 193 __END__
 194
 195 =head1 NAME
 196
 197 App::CPAN2Pkg - generating native linux packages from cpan
 198
 199
 200
 201 =head1 SYNOPSIS
 202
 203     $ cpan2pkg
 204     $ cpan2pkg Module::Foo Module::Bar ...
 205
 206
 207
 208 =head1 DESCRIPTION
 209
 210 Don't use this module directly, refer to the C<cpan2pkg> script instead.
 211
 212 C<App::CPAN2Pkg> is the controller for the C<cpan2pkg> application. It
 213 implements a POE session, responsible to schedule and advance module
 214 packagement.
 215
 216 It is spawned by the poe session responsible for the user interface.
 217
 218
 219
 220 =head1 PUBLIC PACKAGE METHODS
 221
 222 =head2 my $id = App::CPAN2Pkg->spawn( \%params )
 223
 224 This method will create a POE session responsible for coordinating the
 225 package(s) creation.
 226
 227 It will return the POE id of the session newly created.
 228
 229 You can tune the session by passing some arguments as a hash
 230 reference, where the hash keys are:
 231
 232 =over 4
 233
 234 =item * modules => \@list_of_modules
 235
 236 A list of modules to start packaging.
 237
 238
 239 =back
 240
 241
 242
 243 =head1 PUBLIC EVENTS ACCEPTED
 244
 245 The following events are the module's API.
 246
 247
 248 =head2 cpan2dist_status( $module, $success )
 249
 250 Sent when C<$module> has been C<cpan2dist>-ed, with C<$success> being true
 251 if everything went fine.
 252
 253
 254 =head2 local_status( $module, $is_installed )
 255
 256 Sent when C<$module> knows whether it is installed locally (C<$is_installed>
 257 set to true) or not.
 258
 259
 260 =head2 module_spawned( $module )
 261
 262 Sent when C<$module> has been spawned successfully.
 263
 264
 265 =head2 package( $module )
 266
 267 Request the application to package (if needed) the perl C<$module>. Note
 268 that the module can be either the top-most module of a distribution or
 269 deep inside said distribution.
 270
 271
 272 =head2 prereqs( $module, @prereqs )
 273
 274 Inform main application that C<$module> needs some C<@prereqs> (possibly
 275 empty).
 276
 277
 278 =head2 upstream_install( $module, $success )
 279
 280 Sent after trying to install C<$module> from upstream dist. Result is passed
 281 along with C<$success>.
 282
 283
 284 =head2 upstream_status( $module, $is_available )
 285
 286 Sent when C<$module> knows whether it is available upstream (C<$is_available>
 287 set to true) or not.
 288
 289
 290
 291 =head1 BUGS
 292
 293 Please report any bugs or feature requests to C<app-cpan2pkg at
 294 rt.cpan.org>, or through the web interface at
 295 L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=App-CPAN2Pkg>. I will
 296 be notified, and then you'll automatically be notified of progress on
 297 your bug as I make changes.
 298
 299
 300
 301 =head1 SEE ALSO
 302
 303 Our git repository is located at L<git://repo.or.cz/app-cpan2pkg.git>,
 304 and can be browsed at L<http://repo.or.cz/w/app-cpan2pkg.git>.
 305
 306
 307 You can also look for information on this module at:
 308
 309 =over 4
 310
 311 =item * AnnoCPAN: Annotated CPAN documentation
 312
 313 L<http://annocpan.org/dist/App-CPAN2Pkg>
 314
 315 =item * CPAN Ratings
 316
 317 L<http://cpanratings.perl.org/d/App-CPAN2Pkg>
 318
 319 =item * Open bugs
 320
 321 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=App-CPAN2Pkg>
 322
 323 =back
 324
 325
 326
 327 =head1 AUTHOR
 328
 329 Jerome Quelin, C<< <jquelin@cpan.org> >>
 330
 331
 332
 333 =head1 COPYRIGHT & LICENSE
 334
 335 Copyright (c) 2009 Jerome Quelin, all rights reserved.
 336
 337 This program is free software; you can redistribute it and/or modify
 338 it under the same terms as Perl itself.
 339
 340 =cut
 341