• Your recent searches
Acme-NabeAtzz
9 results

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN 

336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
        local *FH;
        open FH, "> $_[0]" or die "open($_[0]): $!";
        foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!" }
        close FH or die "close($_[0]): $!";
}
 
sub _version {
        my $s = shift || 0;
           $s =~ s/^(\d+)\.?//;
        my $l = $1 || 0;
        my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g;
           $l = $l . '.' . join '', @v if @v;
        return $l + 0;
}
 
1;
 
# Copyright 2008 Adam Kennedy.

inc/Module/Install/Makefile.pm  view on Meta::CPAN 

100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
        if ( $self->tests ) {
                die "tests_recursive will not work if tests are already defined";
        }
        my $dir = shift || 't';
        unless ( -d $dir ) {
                die "tests_recursive dir '$dir' does not exist";
        }
        %test_dir = ();
        require File::Find;
        File::Find::find( \&_wanted_t, $dir );
        $self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir );
}
 
sub write {
        my $self = shift;
        die "&Makefile->write() takes no arguments\n" if @_;
 
        # Make sure we have a new enough
        require ExtUtils::MakeMaker;
        $self->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION );

inc/Module/Install/Makefile.pm  view on Meta::CPAN 

137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) {
        $args->{SIGN} = 1;
}
unless ( $self->is_admin ) {
        delete $args->{SIGN};
}
 
# merge both kinds of requires into prereq_pm
my $prereq = ($args->{PREREQ_PM} ||= {});
%$prereq = ( %$prereq,
        map { @$_ }
        map { @$_ }
        grep $_,
        ($self->configure_requires, $self->build_requires, $self->requires)
);
 
# Remove any reference to perl, PREREQ_PM doesn't support it
delete $args->{PREREQ_PM}->{perl};
 
# merge both kinds of requires into prereq_pm
my $subdirs = ($args->{DIR} ||= []);
if ($self->bundles) {

inc/Module/Install/Makefile.pm  view on Meta::CPAN 

164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
        }
 
        if ( my $perl_version = $self->perl_version ) {
                eval "use $perl_version; 1"
                        or die "ERROR: perl: Version $] is installed, "
                        . "but we need version >= $perl_version";
        }
 
        $args->{INSTALLDIRS} = $self->installdirs;
 
        my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args;
 
        my $user_preop = delete $args{dist}->{PREOP};
        if (my $preop = $self->admin->preop($user_preop)) {
                $args{dist} = $preop;
        }
 
        my $mm = ExtUtils::MakeMaker::WriteMakefile(%args);
        $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile');
}

inc/Module/Install/Metadata.pm  view on Meta::CPAN 

207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
                # The user used ->feature like ->features by passing in the second
                # argument as a reference.  Accomodate for that.
                $mods = $_[0];
        } else {
                $mods = \@_;
        }
 
        my $count = 0;
        push @$features, (
                $name => [
                        map {
                                ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_
                        } @$mods
                ]
        );
 
        return @$features;
}
 
sub features {
        my $self = shift;

inc/Spiffy.pm  view on Meta::CPAN 

6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
use Carp;
require Exporter;
our $VERSION = '0.30';
our @EXPORT = ();
our @EXPORT_BASE = qw(field const stub super);
our @EXPORT_OK = (@EXPORT_BASE, qw(id WWW XXX YYY ZZZ));
our %EXPORT_TAGS = (XXX => [qw(WWW XXX YYY ZZZ)]);
 
my $stack_frame = 0; 
my $dump = 'yaml';
my $bases_map = {};
 
sub WWW; sub XXX; sub YYY; sub ZZZ;
 
# This line is here to convince "autouse" into believing we are autousable.
sub can {
    ($_[1] eq 'import' and caller()->isa('autouse'))
        ? \&Exporter::import        # pacify autouse's equality test
        : $_[0]->SUPER::can($_[1])  # normal case
}

inc/Spiffy.pm  view on Meta::CPAN 

94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
} ( @{"$class\::EXPORT"}, 
    ($args->{-Base} or $args->{-base})
      ? @{"$class\::EXPORT_BASE"} : (),
  );
my @export_ok = grep {
    not defined &{"$caller_package\::$_"};
} @{"$class\::EXPORT_OK"};
 
# Avoid calling the expensive Exporter::export 
# if there is nothing to do (optimization)
my %exportable = map { ($_, 1) } @export, @export_ok;
next unless keys %exportable;
 
my @export_save = @{"$class\::EXPORT"};
my @export_ok_save = @{"$class\::EXPORT_OK"};
@{"$class\::EXPORT"} = @export;
@{"$class\::EXPORT_OK"} = @export_ok;
my @list = grep {
    (my $v = $_) =~ s/^[\!\:]//;
    $exportable{$v} or ${"$class\::EXPORT_TAGS"}{$v};
} @export_list;

inc/Spiffy.pm  view on Meta::CPAN 

137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
            $_ = $data;
            my @my_subs;
            s[^(sub\s+\w+\s+\{)(.*\n)]
             [${1}my \$self = shift;$2]gm;
            s[^(sub\s+\w+)\s*\(\s*\)(\s+\{.*\n)]
             [${1}${2}]gm;
            s[^my\s+sub\s+(\w+)(\s+\{)(.*)((?s:.*?\n))\}\n]
             [push @my_subs, $1; "\$$1 = sub$2my \$self = shift;$3$4\};\n"]gem;
            my $preclare = '';
            if (@my_subs) {
                $preclare = join ',', map "\$$_", @my_subs;
                $preclare = "my($preclare);";
            }
            $_ = "use strict;use warnings;$preclare${_};1;\n$end";
            if ($filter_dump) { print; exit }
            if ($filter_save) { $filter_result = $_; $_ = $filter_result; }
            $done = 1;
        }
    );
}
 
sub base {
    push @_, -base;
    goto &import;
}
 
sub all_my_bases {
    my $class = shift;
 
    return $bases_map->{$class} 
      if defined $bases_map->{$class};
 
    my @bases = ($class);
    no strict 'refs';
    for my $base_class (@{"${class}::ISA"}) {
        push @bases, @{all_my_bases($base_class)};
    }
    my $used = {};
    $bases_map->{$class} = [grep {not $used->{$_}++} @bases];
}
 
my %code = ( 
    sub_start => 
      "sub {\n",
    set_default => 
      "  \$_[0]->{%s} = %s\n    unless exists \$_[0]->{%s};\n",
    init =>
      "  return \$_[0]->{%s} = do { my \$self = \$_[0]; %s }\n" .
      "    unless \$#_ > 0 or defined \$_[0]->{%s};\n",

inc/Spiffy.pm  view on Meta::CPAN 

278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
    sub { 
        require Carp;
        Carp::confess 
          "Method $field in package $package must be subclassed";
    }
}
 
sub parse_arguments {
    my $class = shift;
    my ($args, @values) = ({}, ());
    my %booleans = map { ($_, 1) } $class->boolean_arguments;
    my %pairs = map { ($_, 1) } $class->paired_arguments;
    while (@_) {
        my $elem = shift;
        if (defined $elem and defined $booleans{$elem}) {
            $args->{$elem} = (@_ and $_[0] =~ /^[01]$/)
            ? shift
            : 1;
        }
        elsif (defined $elem and defined $pairs{$elem} and @_) {
            $args->{$elem} = shift;
        }

inc/Spiffy.pm  view on Meta::CPAN 

428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
    @{"$target_class\::ISA"} = ($pseudo_class);
    for (keys %methods) {
        *{"$pseudo_class\::$_"} = $methods{$_};
    }
}
 
sub spiffy_mixin_methods {
    my $mixin_class = shift;
    no strict 'refs';
    my %methods = spiffy_all_methods($mixin_class);
    map {
        $methods{$_}
          ? ($_, \ &{"$methods{$_}\::$_"})
          : ($_, \ &{"$mixin_class\::$_"})
    } @_
      ? (get_roles($mixin_class, @_))
      : (keys %methods);
}
 
sub get_roles {
    my $mixin_class = shift;
    my @roles = @_;
    while (grep /^!*:/, @roles) {
        @roles = map {
            s/!!//g;
            /^!:(.*)/ ? do { 
                my $m = "_role_$1"; 
                map("!$_", $mixin_class->$m);
            } :
            /^:(.*)/ ? do {
                my $m = "_role_$1"; 
                ($mixin_class->$m);
            } :
            ($_)
        } @roles;
    }
    if (@roles and $roles[0] =~ /^!/) {
        my %methods = spiffy_all_methods($mixin_class);

inc/Spiffy.pm  view on Meta::CPAN 

472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
          if /^!(.*)/;
        $roles{$_} = 1;
    }
    keys %roles;
}
 
sub spiffy_all_methods {
    no strict 'refs';
    my $class = shift;
    return if $class eq 'Spiffy';
    my %methods = map {
        ($_, $class)
    } grep {
        defined &{"$class\::$_"} and not /^_/
    } keys %{"$class\::"};
    my %super_methods;
    %super_methods = spiffy_all_methods(${"$class\::ISA"}[0])
      if @{"$class\::ISA"};
    %{{%super_methods, %methods}};
}

inc/Test/Base.pm  view on Meta::CPAN 

33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
    tie_output
 
    find_my_self default_object
 
    croak carp cluck confess
));
 
field '_spec_file';
field '_spec_string';
field _filters => [qw(norm trim)];
field _filters_map => {};
field spec =>
      -init => '$self->_spec_init';
field block_list =>
      -init => '$self->_block_list_init';
field _next_list => [];
field block_delim =>
      -init => '$self->block_delim_default';
field data_delim =>
      -init => '$self->data_delim_default';
field _filters_delay => 0;

inc/Test/Base.pm  view on Meta::CPAN 

211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
sub spec_string() {
    (my ($self), @_) = find_my_self(@_);
    $self->check_late;
    $self->_spec_string(shift);
    return $self;
}
 
sub filters() {
    (my ($self), @_) = find_my_self(@_);
    if (ref($_[0]) eq 'HASH') {
        $self->_filters_map(shift);
    }
    else {    
        my $filters = $self->_filters;
        push @$filters, @_;
    }
    return $self;
}
 
sub filter_arguments() {
    $Test::Base::Filter::arguments;

inc/Test/Base.pm  view on Meta::CPAN 

421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
    my $name = $1;
    my @parts = split /^\Q${dd}\E +\(?(\w+)\)? *(.*)?\n/m, $hunk;
    my $description = shift @parts;
    $description ||= '';
    unless ($description =~ /\S/) {
        $description = $name;
    }
    $description =~ s/\s*\z//;
    $block->set_value(description => $description);
     
    my $section_map = {};
    my $section_order = [];
    while (@parts) {
        my ($type, $filters, $value) = splice(@parts, 0, 3);
        $self->_check_reserved($type);
        $value = '' unless defined $value;
        $filters = '' unless defined $filters;
        if ($filters =~ /:(\s|\z)/) {
            croak "Extra lines not allowed in '$type' section"
              if $value =~ /\S/;
            ($filters, $value) = split /\s*:(?:\s+|\z)/, $filters, 2;
            $value = '' unless defined $value;
            $value =~ s/^\s*(.*?)\s*$/$1/;
        }
        $section_map->{$type} = {
            filters => $filters,
        };
        push @$section_order, $type;
        $block->set_value($type, $value);
    }
    $block->set_value(name => $name);
    $block->set_value(_section_map => $section_map);
    $block->set_value(_section_order => $section_order);
    return $block;
}
 
sub _spec_init {
    return $self->_spec_string
      if $self->_spec_string;
    local $/;
    my $spec;
    if (my $spec_file = $self->_spec_file) {

inc/Test/Base.pm  view on Meta::CPAN 

556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
 
sub set_value {
    no strict 'refs';
    my $accessor = shift;
    block_accessor $accessor
      unless defined &$accessor;
    $self->{$accessor} = [@_];
}
 
sub run_filters {
    my $map = $self->_section_map;
    my $order = $self->_section_order;
    Carp::croak "Attempt to filter a block twice"
      if $self->is_filtered;
    for my $type (@$order) {
        my $filters = $map->{$type}{filters};
        my @value = $self->$type;
        $self->original_values->{$type} = $value[0];
        for my $filter ($self->_get_filters($type, $filters)) {
            $Test::Base::Filter::arguments =
              $filter =~ s/=(.*)$// ? $1 : undef;
            my $function = "main::$filter";
            no strict 'refs';
            if (defined &$function) {
                $_ = join '', @value;
                @value = &$function(@value);

inc/Test/Base.pm  view on Meta::CPAN 

598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
        }
    }
    $self->is_filtered(1);
}
 
sub _get_filters {
    my $type = shift;
    my $string = shift || '';
    $string =~ s/\s*(.*?)\s*/$1/;
    my @filters = ();
    my $map_filters = $self->blocks_object->_filters_map->{$type} || [];
    $map_filters = [ $map_filters ] unless ref $map_filters;
    my @append = ();
    for (
        @{$self->blocks_object->_filters}, 
        @$map_filters,
        split(/\s+/, $string),
    ) {
        my $filter = $_;
        last unless length $filter;
        if ($filter =~ s/^-//) {
            @filters = grep { $_ ne $filter } @filters;
        }
        elsif ($filter =~ s/^\+//) {
            push @append, $filter;
        }
        else {
            push @filters, $filter;
        }
    }
    return @filters, @append;
}
 
{
    %$reserved_section_names = map {
        ($_, 1);
    } keys(%Test::Base::Block::), qw( new DESTROY );
}
 
__DATA__
 
#line 1298

inc/Test/Base/Filter.pm  view on Meta::CPAN 

34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
    if (ref $_[0] eq 'ARRAY') {
        for my $aref (@_) {
            @$aref = $self->_apply_deepest($method, @$aref);
        }
        return @_;
    }
    $self->$method(@_);
}
 
sub _split_array {
    map {
        [$self->split($_)];
    } @_;
}
 
sub _peel_deepest {
    return () unless @_;
    if (ref $_[0] eq 'ARRAY') {
        if (ref $_[0]->[0] eq 'ARRAY') {
            for my $aref (@_) {
                @$aref = $self->_peel_deepest(@$aref);
            }
            return @_;
        }
        return map { $_->[0] } @_;
    }
    return @_;
}
 
#===============================================================================
# these filters work on the leaves of nested arrays
#===============================================================================
sub Join { $self->_peel_deepest($self->_apply_deepest(join => @_)) }
sub Reverse { $self->_apply_deepest(reverse => @_) }
sub Split { $self->_apply_deepest(_split_array => @_) }
sub Sort { $self->_apply_deepest(sort => @_) }
 
 
sub append {
    my $suffix = $self->current_arguments;
    map { $_ . $suffix } @_;
}
 
sub array {
    return [@_];
}
 
sub base64_decode {
    $self->assert_scalar(@_);
    require MIME::Base64;
    MIME::Base64::decode_base64(shift);
}
 
sub base64_encode {
    $self->assert_scalar(@_);
    require MIME::Base64;
    MIME::Base64::encode_base64(shift);
}
 
sub chomp {
    map { CORE::chomp; $_ } @_;
}
 
sub chop {
    map { CORE::chop; $_ } @_;
}
 
sub dumper {
    no warnings 'once';
    require Data::Dumper;
    local $Data::Dumper::Sortkeys = 1;
    local $Data::Dumper::Indent = 1;
    local $Data::Dumper::Terse = 1;
    Data::Dumper::Dumper(@_);
}

inc/Test/Base/Filter.pm  view on Meta::CPAN 

164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
    close $execution;
    unlink($tmpfile)
      or die "Couldn't unlink $tmpfile: $!\n";
    return $output;
}
 
sub flatten {
    $self->assert_scalar(@_);
    my $ref = shift;
    if (ref($ref) eq 'HASH') {
        return map {
            ($_, $ref->{$_});
        } sort keys %$ref;
    }
    if (ref($ref) eq 'ARRAY') {
        return @$ref;
    }
    die "Can only flatten a hash or array ref";
}
 
sub get_url {

inc/Test/Base/Filter.pm  view on Meta::CPAN 

215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
sub norm {
    $self->assert_scalar(@_);
    my $text = shift || '';
    $text =~ s/\015\012/\n/g;
    $text =~ s/\r/\n/g;
    return $text;
}
 
sub prepend {
    my $prefix = $self->current_arguments;
    map { $prefix . $_ } @_;
}
 
sub read_file {
    $self->assert_scalar(@_);
    my $file = shift;
    CORE::chomp $file;
    open my $fh, $file
      or die "Can't open '$file' for input:\n$!";
    CORE::join '', <$fh>;
}

inc/Test/Base/Filter.pm  view on Meta::CPAN 

287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
use warnings;
...
}
 
sub tail {
    my $size = $self->current_arguments || 1;
    return splice(@_, @_ - $size, $size);
}
 
sub trim {
    map {
        s/\A([ \t]*\n)+//;
        s/(?<=\n)\s*\z//g;
        $_;
    } @_;
}
 
sub unchomp {
    map { $_ . "\n" } @_;
}
 
sub write_file {
    my $file = $self->current_arguments
      or die "No file specified for write_file filter";
    if ($file =~ /(.*)[\\\/]/) {
        my $dir = $1;
        if (not -e $dir) {
            require File::Path;
            File::Path::mkpath($dir)

inc/Test/Builder.pm  view on Meta::CPAN 

475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
    my($self, $this, $regex, $name) = @_;
 
    local $Level = $Level + 1;
    $self->_regex_ok($this, $regex, '!~', $name);
}
 
 
#line 677
 
 
my %numeric_cmps = map { ($_, 1) } 
                       ("<",  "<=", ">",  ">=", "==", "!=", "<=>");
 
sub cmp_ok {
    my($self, $got, $type, $expect, $name) = @_;
 
    # Treat overloaded objects as numbers if we're asked to do a
    # numeric comparison.
    my $unoverload = $numeric_cmps{$type} ? '_unoverload_num'
                                          : '_unoverload_str';

inc/Test/Builder.pm  view on Meta::CPAN 

788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
my($self, @msgs) = @_;
 
return if $self->no_diag;
return unless @msgs;
 
# Prevent printing headers when compiling (i.e. -c)
return if $^C;
 
# Smash args together like print does.
# Convert undef to 'undef' so its readable.
my $msg = join '', map { defined($_) ? $_ : 'undef' } @msgs;
 
# Escape each line with a #.
$msg =~ s/^/# /gm;
 
# Stick a newline on the end if it needs it.
$msg .= "\n" unless $msg =~ /\n\Z/;
 
local $Level = $Level + 1;
$self->_print_diag($msg);

inc/Test/Builder.pm  view on Meta::CPAN 

936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
}
 
 
sub _copy_io_layers {
    my($self, $src, $dst) = @_;
     
    $self->_try(sub {
        require PerlIO;
        my @src_layers = PerlIO::get_layers($src);
 
        binmode $dst, join " ", map ":$_", @src_layers if @src_layers;
    });
}
 
#line 1423
 
sub _message_at_caller {
    my $self = shift;
 
    local $Level = $Level + 1;
    my($pack, $file, $line) = $self->caller;

inc/Test/Builder.pm  view on Meta::CPAN 

1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
    }
    return $self->{Curr_Test};
}
 
 
#line 1516
 
sub summary {
    my($self) = shift;
 
    return map { $_->{'ok'} } @{ $self->{Test_Results} };
}
 
#line 1571
 
sub details {
    my $self = shift;
    return @{ $self->{Test_Results} };
}
 
#line 1597

inc/Test/More.pm  view on Meta::CPAN 

145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
    foreach my $method (@methods) {
        $tb->_try(sub { $proto->can($method) }) or push @nok, $method;
    }
 
    my $name;
    $name = @methods == 1 ? "$class->can('$methods[0]')"
                          : "$class->can(...)";
 
    my $ok = $tb->ok( !@nok, $name );
 
    $tb->diag(map "    $class->can('$_') failed\n", @nok);
 
    return $ok;
}
 
#line 522
 
sub isa_ok ($$;$) {
    my($object, $class, $obj_name) = @_;
    my $tb = Test::More->builder;

ppport.h  view on Meta::CPAN 

63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
/* To verify whether ppport.h is needed for your module, and whether any
 * special defines should be used, ppport.h can be run through Perl to check
 * your source code. Simply say:
 * 
 *      perl -x ppport.h *.c *.h *.xs foo/bar*.c [etc]
 * 
 * The result will be a list of patches suggesting changes that should at
 * least be acceptable, if not necessarily the most efficient solution, or a
 * fix for all possible problems. It won't catch where dTHR is needed, and
 * doesn't attempt to account for global macro or function definitions,
 * nested includes, typemaps, etc.
 * 
 * In order to test for the need of dTHR, please try your module under a
 * recent version of Perl that has threading compiled-in.
 *
 */ 
 
 
/*
#!/usr/bin/perl
@ARGV = ("*.xs") if !@ARGV;
%badmacros = %funcs = %macros = (); $replace = 0;
foreach (<DATA>) {
        $funcs{$1} = 1 if /Provide:\s+(\S+)/;
        $macros{$1} = 1 if /^#\s*define\s+([a-zA-Z0-9_]+)/;
        $replace = $1 if /Replace:\s+(\d+)/;
        $badmacros{$2}=$1 if $replace and /^#\s*define\s+([a-zA-Z0-9_]+).*?\s+([a-zA-Z0-9_]+)/;
        $badmacros{$1}=$2 if /Replace (\S+) with (\S+)/;
}
foreach $filename (map(glob($_),@ARGV)) {
        unless (open(IN, "<$filename")) {
                warn "Unable to read from $file: $!\n";
                next;
        }
        print "Scanning $filename...\n";
        $c = ""; while (<IN>) { $c .= $_; } close(IN);
        $need_include = 0; %add_func = (); $changes = 0;
        $has_include = ($c =~ /#.*include.*ppport/m);
 
        foreach $func (keys %funcs) {

ppport.h  view on Meta::CPAN 

129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
foreach $badmacro (keys %badmacros) {
        if ($c =~ /\b$badmacro\b/m) {
                $changes += ($c =~ s/\b$badmacro\b/$badmacros{$badmacro}/gm);
                print "Uses $badmacros{$badmacro} (instead of $badmacro)\n";
                $need_include = 1;
        }
}
 
if (scalar(keys %add_func) or $need_include != $has_include) {
        if (!$has_include) {
                $inc = join('',map("#define NEED_$_\n", sort keys %add_func)).
                       "#include \"ppport.h\"\n";
                $c = "$inc$c" unless $c =~ s/#.*include.*XSUB.*\n/$&$inc/m;
        } elsif (keys %add_func) {
                $inc = join('',map("#define NEED_$_\n", sort keys %add_func));
                $c = "$inc$c" unless $c =~ s/^.*#.*include.*ppport.*$/$inc$&/m;
        }
        if (!$need_include) {
                print "Doesn't seem to need ppport.h.\n";
                $c =~ s/^.*#.*include.*ppport.*\n//m;
        }
        $changes++;
}
 
if ($changes) {



( run in 1.311 second using v1.01-cache-2.11-cpan-94b05bcf43c )