lib/App/CPAN2Pkg/Module.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::Module;
  11
  12 use strict;
  13 use warnings;
  14
  15 use Class::XSAccessor
  16     constructor => '_new',
  17     accessors   => {
  18         name      => 'name',
  19         shortname => 'shortname',
  20         _output    => '_output',
  21         _prereqs   => '_prereqs',
  22         _wheel     => '_wheel',
  23     };
  24 use POE;
  25 use POE::Filter::Line;
  26 use POE::Wheel::Run;
  27
  28 my $PREFIX = '*';
  29
  30
  31 #
  32 # if ( not available in cooker )                is_in_dist
  33 # then
  34 #   compute dependencies                        find_prereqs
  35 #   repeat with each dep
  36 #   cpan2dist                                   cpan2dist
  37 #   install local                               install_from_local
  38 #   while ( not available locally )             is_installed
  39 #   do
  40 #       prompt user to fix manually
  41 #   done
  42 #   import                                      import_local_to_dist
  43 #   submit                                              (included above)
  44 #   ack available (manual?)
  45 #
  46 # else
  47 #   urpmi --auto perl(module::to::install)       install_from_dist
  48 # fi
  49
  50 # on debian / ubuntu
  51 # $ apt-file find Audio/MPD.pm
  52 # libaudio-mpd-perl: /usr/share/perl5/Audio/MPD.pm
  53 # status:
  54 # - find dist hosting module
  55 #  - computing dependencies
  56 #  - installing dependencies
  57 #  - check cooker availability
  58 #  - cpan2dist
  59 #  - install local
  60 #  - check local availability
  61 #  - mdvsys import
  62 #  - mdvsys submit
  63 #  - wait for kenobi build
  64 #
  65
  66
  67
  68
  69 #--
  70 # CONSTRUCTOR
  71
  72 sub spawn {
  73     my ($class, $module) = @_;
  74
  75     # creating the object
  76     my $short = $module;
  77     $short =~ s/::/:/g;
  78     $short =~ s/[[:lower:]]//g;
  79     my $obj = App::CPAN2Pkg::Module->_new(
  80         name      => $module,
  81         shortname => $short,
  82         _prereqs  => {},
  83         _wheel    => undef,
  84     );
  85
  86     # spawning the session
  87     my $session = POE::Session->create(
  88         inline_states => {
  89             # public events
  90             find_prereqs => \&find_prereqs,
  91             is_in_dist   => \&is_in_dist,
  92             # private events
  93             _find_prereqs => \&_find_prereqs,
  94             _is_in_dist   => \&_is_in_dist,
  95             _stderr       => \&_stderr,
  96             _stdout       => \&_stdout,
  97             # poe inline states
  98             _start => \&_start,
  99             _stop  => sub { warn "stop"; },
 100         },
 101         heap => $obj,
 102     );
 103     return $session->ID;
 104 }
 105
 106
 107 #--
 108 # SUBS
 109
 110 # -- public events
 111
 112 sub find_prereqs {
 113     my ($k, $self) = @_[KERNEL, HEAP];
 114
 115     # preparing command
 116     my $module = $self->name;
 117     my $cmd = "cpanp /prereqs show $module";
 118     $self->_log_new_step($k, 'Finding module prereqs',
 119         "Running command: $cmd" );
 120
 121     # running command
 122     $self->_output('');
 123     $ENV{LC_ALL} = 'C';
 124     my $wheel = POE::Wheel::Run->new(
 125         Program      => $cmd,
 126         CloseEvent   => '_find_prereqs',
 127         StdoutEvent  => '_stdout',
 128         StderrEvent  => '_stderr',
 129         StdoutFilter => POE::Filter::Line->new,
 130         StderrFilter => POE::Filter::Line->new,
 131     );
 132
 133     # need to store the wheel, otherwise the process goes woo!
 134     $self->_wheel($wheel);
 135 }
 136
 137 sub is_in_dist {
 138     my ($k, $self) = @_[KERNEL, HEAP];
 139
 140     # preparing command
 141     my $name = $self->name;
 142     my $cmd  = "urpmq --whatprovides 'perl($name)'";
 143     $self->_log_new_step($k, 'Checking if packaged upstream',
 144         "Running command: $cmd" );
 145
 146     # running command
 147     $self->_output('');
 148     $ENV{LC_ALL} = 'C';
 149     my $wheel = POE::Wheel::Run->new(
 150         Program      => $cmd,
 151         #CloseEvent   => '_is_in_dist', # FIXME: cf rt#42757
 152         StdoutEvent  => '_stdout',
 153         StderrEvent  => '_stderr',
 154         Conduit      => 'pty-pipe', # urpmq wants a pty
 155         StdoutFilter => POE::Filter::Line->new,
 156         StderrFilter => POE::Filter::Line->new,
 157     );
 158     $k->sig( CHLD => '_is_in_dist' );
 159
 160     # need to store the wheel, otherwise the process goes woo!
 161     $self->_wheel($wheel);
 162 }
 163
 164 # -- private events
 165
 166 sub _find_prereqs {
 167     my ($k, $self, $id) = @_[KERNEL, HEAP, ARG0];
 168
 169     # terminate wheel
 170     my $wheel  = $self->_wheel;
 171     $self->_wheel(undef);
 172
 173     # extract prereqs
 174     my @lines =
 175         grep { s/^\s+// }
 176         split /\n/, $self->_output;
 177     shift @lines; # remove the title line
 178     my @prereqs =
 179         map  { (split /\s+/, $_)[0] }
 180         @lines;
 181
 182     # store prereqs
 183     foreach my $prereq ( @prereqs ) {
 184         $k->post('ui', 'append', $self, "prereq found: $prereq\n");
 185         $self->_prereqs->{$prereq} = 1;
 186     }
 187
 188     $k->post('app', 'prereqs', $self, @prereqs);
 189 }
 190
 191 sub _is_in_dist {
 192     my($k, $self, $pid, $rv) = @_[KERNEL, HEAP, ARG1, ARG2];
 193
 194     # since it's a sigchld handler, it also gets called for other
 195     # spawned processes. therefore, screen out processes that are
 196     # not related to this object.
 197     return unless defined $self->_wheel;
 198     return unless $self->_wheel->PID == $pid;
 199
 200     # terminate wheel
 201     # FIXME: should be done in CloseEvent
 202     $self->_wheel(undef);
 203
 204     # check if we got a hit
 205     my $name  = $self->name;
 206     my $exval = $rv >> 8;
 207
 208     # urpmq returns 0 if found, 1 otherwise.
 209     $k->post('app', 'is_in_dist', $self, !$rv);
 210 }
 211
 212 sub _stderr {
 213     my ($k, $self, $line) = @_[KERNEL, HEAP, ARG0];
 214     $k->post('ui', 'append', $self, "stderr: $line\n");
 215 }
 216
 217 sub _stdout {
 218     my ($k, $self, $line) = @_[KERNEL, HEAP, ARG0];
 219     $line .= "\n";
 220     $self->_output( $self->_output . $line );
 221     $k->post('ui', 'append', $self, "stdout: $line");
 222 }
 223
 224
 225 # -- poe inline states
 226
 227 sub _start {
 228     my ($k, $self) = @_[KERNEL, HEAP];
 229
 230     $k->alias_set($self);
 231     $k->post('ui',  'new_module', $self);
 232     $k->post('app', 'new_module', $self);
 233 }
 234
 235
 236 #--
 237 # METHODS
 238
 239 # -- private methods
 240
 241 sub _log_empty_line {
 242     my ($self, $nb) = @_;
 243     $nb //= 1; #/ FIXME padre syntaxic color glitch
 244     POE::Kernel->post('ui', 'append', $self, "\n" x $nb);
 245 }
 246
 247 sub _log_new_step {
 248     my ($self, $k, $step, $comment) = @_;
 249
 250     my @lines =
 251         map { "$PREFIX $_\n" }
 252         ( '-' x 10, $step, '', $comment, '' );
 253     $k->post('ui', 'append', $self, $_) for @lines;
 254     $self->_log_empty_line;
 255 }
 256
 257 1;
 258 __END__
 259
 260
 261 =head1 NAME
 262
 263 App::CPAN2Pkg::Module - poe session to drive a module packaging
 264
 265
 266
 267 =head1 DESCRIPTION
 268
 269 C<App::CPAN2Pkg::Module> implements a POE session driving the whole
 270 packaging process of a given module.
 271
 272 It is spawned by C<App::CPAN2Pkg> and implements the logic related to
 273 the module availability in the distribution.
 274
 275
 276
 277 =head1 PUBLIC PACKAGE METHODS
 278
 279 =head2 my $id = App::CPAN2Pkg::Module->spawn( $module )
 280
 281 This method will create a POE session responsible for packaging &
 282 installing the wanted C<$module>.
 283
 284 It will return the POE id of the session newly created.
 285
 286
 287
 288 =head1 PUBLIC EVENTS ACCEPTED
 289
 290 =head2 find_prereqs()
 291
 292 Start looking for any other module needed by current module.
 293
 294
 295 =head2 is_in_dist()
 296
 297 Check whether the package is provided by an existing upstream package.
 298
 299
 300 =head1 METHODS
 301
 302 This package is also a class, used B<internally> to store private data
 303 needed for the packaging stuff. The following accessors are therefore
 304 available, but should not be used directly:
 305
 306 =over 4
 307
 308 =item name() - the module name
 309
 310 =item shortname() - the module shortname (only capital letters)
 311
 312 =back
 313
 314
 315
 316 =head1 SEE ALSO
 317
 318 For all related information (bug reporting, source code repository,
 319 etc.), refer to C<App::CPAN2Pkg>'s pod, section C<SEE ALSO>.
 320
 321
 322
 323 =head1 AUTHOR
 324
 325 Jerome Quelin, C<< <jquelin@cpan.org> >>
 326
 327
 328
 329 =head1 COPYRIGHT & LICENSE
 330
 331 Copyright (c) 2009 Jerome Quelin, all rights reserved.
 332
 333 This program is free software; you can redistribute it and/or modify
 334 it under the same terms as Perl itself.
 335
 336 =cut
 337