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