File Coverage

blib/lib/Module/Install/AssertOS.pm
Criterion Covered Total %
statement 15 62 24.1
branch 0 16 0.0
condition n/a
subroutine 5 7 71.4
pod 1 1 100.0
total 21 86 24.4


line stmt bran cond sub pod time code
1             package Module::Install::AssertOS;
2              
3 1     1   14325 use strict;
  1         1  
  1         25  
4 1     1   2 use warnings;
  1         2  
  1         25  
5 1     1   3 use base qw(Module::Install::Base);
  1         4  
  1         380  
6 1     1   5 use File::Spec;
  1         2  
  1         17  
7 1     1   2 use vars qw($VERSION);
  1         1  
  1         512  
8              
9             $VERSION = '0.12';
10              
11             sub assertos {
12 0     0 1   my $self = shift;
13 0           my @oses = @_;
14 0 0         return unless scalar @oses;
15              
16 0 0         unless ( $Module::Install::AUTHOR ) {
17 0           require Devel::AssertOS;
18 0           Devel::AssertOS->import( @oses );
19 0           return;
20             }
21              
22 0           _author_side( @oses );
23             }
24              
25             sub _author_side {
26 0     0     my @oses = @_;
27              
28 0           require Data::Compare;
29              
30 0           foreach my $os (@oses) {
31 0           my $oldinc = { map { $_ => $INC{$_} } keys %INC }; # clone
  0            
32 0           eval "use Devel::AssertOS qw($os)";
33 0 0         if(Data::Compare::Compare(\%INC, $oldinc)) {
34 0           print STDERR "Couldn't find a module for $os\n";
35 0           exit(1);
36             }
37             }
38 0 0         my @modulefiles = keys %{{map { $_ => $INC{$_} } grep { /Devel/i && /(Check|Assert)OS/i } keys %INC}};
  0            
  0            
  0            
39              
40 0           mkdir 'inc';
41 0           mkdir 'inc/Devel';
42 0           mkdir 'inc/Devel/AssertOS';
43 0           print "Extra directories created under inc/\n";
44              
45 0           foreach my $modulefile (@modulefiles) {
46 0           my $fullfilename = '';
47 0           SEARCHINC: foreach (@INC) {
48 0 0         if(-e File::Spec->catfile($_, $modulefile)) {
49 0           $fullfilename = File::Spec->catfile($_, $modulefile);
50 0           last SEARCHINC;
51             }
52             }
53 0 0         die("Can't find a file for $modulefile\n") unless(-e $fullfilename);
54              
55 0           (my $module = join('::', split(/\W+/, $modulefile))) =~ s/::pm/.pm/;
56 0           my @dircomponents = ('inc', (split(/::/, $module)));
57 0           my $file = pop @dircomponents;
58              
59 0           mkdir File::Spec->catdir(@dircomponents);
60              
61 0 0         open(PM, $fullfilename) ||
62             die("Can't read $fullfilename: $!");
63 0           my $lsep = $/;
64 0           $/ = undef;
65 0           (my $pm = ) =~ s/package Devel::/package #\nDevel::/;
66 0           close(PM);
67 0           $/ = $lsep;
68 0 0         open(PM, '>'.File::Spec->catfile(@dircomponents, $file)) ||
69             die("Can't write ".File::Spec->catfile(@dircomponents, $file).": $!");
70 0           print PM $pm;
71 0           print "Copied $fullfilename to\n ".File::Spec->catfile(@dircomponents, $file)."\n";
72 0           close(PM);
73              
74             }
75 0           return 1;
76             }
77              
78             'Assert this';
79              
80             __END__