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