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     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     $k->post('ui', 'prereqs', $module, @missing);
 119     if ( @missing ) {
 120         # module misses some prereqs - wait for them.
 121         my $name = $module->name;
 122         $h->_missing->{$name}{$_} = 1 for @missing;
 123         $h->_prereq->{$_}{$name}  = 1 for @missing;
 124
 125     } else {
 126         # no prereqs, move on
 127         $k->yield('prereqs_completed', $module);
 128         return;
 129     }
 130 }
 131
 132 sub upstream_install {
 133     my ($k, $module, $success) = @_[KERNEL, ARG0, ARG1];
 134     #update prereqs
 135 }
 136
 137 sub upstream_status {
 138     my ($k, $module, $is_available) = @_[KERNEL, ARG0, ARG1];
 139     my $event = $is_available ? 'install_from_dist' : 'find_prereqs';
 140     $k->post($module, $event);
 141 }
 142
 143
 144 # -- poe inline states
 145
 146 sub _start {
 147     my ($k, $opts) = @_[KERNEL, ARG0];
 148     $k->alias_set('app');
 149
 150     # start packaging some modules
 151     my $modules = $opts->{modules};
 152     $k->yield('package', $_) for @$modules;
 153 }
 154
 155
 156 1;
 157 __END__
 158
 159 =head1 NAME
 160
 161 App::CPAN2Pkg - generating native linux packages from cpan
 162
 163
 164
 165 =head1 SYNOPSIS
 166
 167     $ cpan2pkg
 168     $ cpan2pkg Module::Foo Module::Bar ...
 169
 170
 171
 172 =head1 DESCRIPTION
 173
 174 Don't use this module directly, refer to the C<cpan2pkg> script instead.
 175
 176 C<App::CPAN2Pkg> is the controller for the C<cpan2pkg> application. It
 177 implements a POE session, responsible to schedule and advance module
 178 packagement.
 179
 180 It is spawned by the poe session responsible for the user interface.
 181
 182
 183
 184 =head1 PUBLIC PACKAGE METHODS
 185
 186 =head2 my $id = App::CPAN2Pkg->spawn( \%params )
 187
 188 This method will create a POE session responsible for coordinating the
 189 package(s) creation.
 190
 191 It will return the POE id of the session newly created.
 192
 193 You can tune the session by passing some arguments as a hash
 194 reference, where the hash keys are:
 195
 196 =over 4
 197
 198 =item * modules => \@list_of_modules
 199
 200 A list of modules to start packaging.
 201
 202
 203 =back
 204
 205
 206
 207 =head1 PUBLIC EVENTS ACCEPTED
 208
 209 The following events are the module's API.
 210
 211
 212 =head2 install_status( $module, $is_installed )
 213
 214 Sent when C<$module> knows whether it is installed locally (C<$is_installed>
 215 set to true) or not.
 216
 217
 218 =head2 module_spawned( $module )
 219
 220 Sent when C<$module> has been spawned successfully.
 221
 222
 223 =head2 package( $module )
 224
 225 Request the application to package (if needed) the perl C<$module>. Note
 226 that the module can be either the top-most module of a distribution or
 227 deep inside said distribution.
 228
 229
 230 =head2 prereqs( $module, @prereqs )
 231
 232 Inform main application that C<$module> needs some C<@prereqs> (possibly
 233 empty).
 234
 235
 236 =head2 upstream_install( $module, $success )
 237
 238 Sent after trying to install C<$module> from upstream dist. Result is passed
 239 along with C<$success>.
 240
 241
 242 =head2 upstream_status( $module, $is_available )
 243
 244 Sent when C<$module> knows whether it is available upstream (C<$is_available>
 245 set to true) or not.
 246
 247
 248
 249 =head1 BUGS
 250
 251 Please report any bugs or feature requests to C<app-cpan2pkg at
 252 rt.cpan.org>, or through the web interface at
 253 L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=App-CPAN2Pkg>. I will
 254 be notified, and then you'll automatically be notified of progress on
 255 your bug as I make changes.
 256
 257
 258
 259 =head1 SEE ALSO
 260
 261 Our git repository is located at L<git://repo.or.cz/app-cpan2pkg.git>,
 262 and can be browsed at L<http://repo.or.cz/w/app-cpan2pkg.git>.
 263
 264
 265 You can also look for information on this module at:
 266
 267 =over 4
 268
 269 =item * AnnoCPAN: Annotated CPAN documentation
 270
 271 L<http://annocpan.org/dist/App-CPAN2Pkg>
 272
 273 =item * CPAN Ratings
 274
 275 L<http://cpanratings.perl.org/d/App-CPAN2Pkg>
 276
 277 =item * Open bugs
 278
 279 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=App-CPAN2Pkg>
 280
 281 =back
 282
 283
 284
 285 =head1 AUTHOR
 286
 287 Jerome Quelin, C<< <jquelin@cpan.org> >>
 288
 289
 290
 291 =head1 COPYRIGHT & LICENSE
 292
 293 Copyright (c) 2009 Jerome Quelin, all rights reserved.
 294
 295 This program is free software; you can redistribute it and/or modify
 296 it under the same terms as Perl itself.
 297
 298 =cut
 299