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