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