← Back to branch summary

~ubuntu-branches/ubuntu/trusty/libtext-markdown-perl/trusty

« back to all changes in this revision

Viewing changes to inc/Module/Install.pm

  • Committer: Bazaar Package Importer
  • Author(s): Jonathan Yu, Jonathan Yu, gregor herrmann, Nathan Handler
  • Date: 2009-08-26 11:14:08 UTC
  • mfrom: (1.1.5 upstream)
  • Revision ID: james.westby@ubuntu.com-20090826111408-p5lw469iekiybf4t
Tags: 1.0.25-1
[ Jonathan Yu ]
* New upstream release
  + MultiMarkdown is now removed from upstream package; it is now
    available as a separate standalone package
* Updated copyright information
* Added myself to Uploaders and Copyright
* Updated rules to new short format
* Updated control file description
* Standards-Version 3.8.3 (remove version dependency on perl)
* Install Markdown.pl as markdown, as before, but use overrides
* Add header for pod_name patch
* Remove .manpages file, they are installed automatically
* Suggest libtext-multimarkdown-perl (since it's a separate package now)
* Add libhtml-tidy-perl to B-D-I for testing
* Add a NEWS item for the libtext-multimarkdown-perl split

[ gregor herrmann ]
* debian/control: Added: ${misc:Depends} to Depends: field.

[ Nathan Handler ]
* debian/watch: Update to ignore development releases.

Show diffs side-by-side

added added

removed removed

Lines of Context:
inc/Module/Install.pm
17
17
#     3. The ./inc/ version of Module::Install loads
18
18
# }
19
19
 
20
 
BEGIN {
21
 
        require 5.004;
22
 
}
 
20
use 5.005;
23
21
use strict 'vars';
24
22
 
25
 
use vars qw{$VERSION};
 
23
use vars qw{$VERSION $MAIN};
26
24
BEGIN {
27
25
        # All Module::Install core packages now require synchronised versions.
28
26
        # This will be used to ensure we don't accidentally load old or
30
28
        # This is not enforced yet, but will be some time in the next few
31
29
        # releases once we can make sure it won't clash with custom
32
30
        # Module::Install extensions.
33
 
        $VERSION = '0.75';
 
31
        $VERSION = '0.91';
 
32
 
 
33
        # Storage for the pseudo-singleton
 
34
        $MAIN    = undef;
34
35
 
35
36
        *inc::Module::Install::VERSION = *VERSION;
36
37
        @inc::Module::Install::ISA     = __PACKAGE__;
69
70
# again. This is bad. Rather than taking action to touch it (which
70
71
# is unreliable on some platforms and requires write permissions)
71
72
# for now we should catch this and refuse to run.
72
 
if ( -f $0 and (stat($0))[9] > time ) { die <<"END_DIE" }
73
 
 
74
 
Your installer $0 has a modification time in the future.
 
73
if ( -f $0 ) {
 
74
        my $s = (stat($0))[9];
 
75
 
 
76
        # If the modification time is only slightly in the future,
 
77
        # sleep briefly to remove the problem.
 
78
        my $a = $s - time;
 
79
        if ( $a > 0 and $a < 5 ) { sleep 5 }
 
80
 
 
81
        # Too far in the future, throw an error.
 
82
        my $t = time;
 
83
        if ( $s > $t ) { die <<"END_DIE" }
 
84
 
 
85
Your installer $0 has a modification time in the future ($s > $t).
75
86
 
76
87
This is known to create infinite loops in make.
77
88
 
78
89
Please correct this, then run $0 again.
79
90
 
80
91
END_DIE
 
92
}
81
93
 
82
94
 
83
95
 
121
133
        $sym->{$cwd} = sub {
122
134
                my $pwd = Cwd::cwd();
123
135
                if ( my $code = $sym->{$pwd} ) {
124
 
                        # delegate back to parent dirs
 
136
                        # Delegate back to parent dirs
125
137
                        goto &$code unless $cwd eq $pwd;
126
138
                }
127
139
                $$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym";
 
140
                my $method = $1;
 
141
                if ( uc($method) eq $method ) {
 
142
                        # Do nothing
 
143
                        return;
 
144
                } elsif ( $method =~ /^_/ and $self->can($method) ) {
 
145
                        # Dispatch to the root M:I class
 
146
                        return $self->$method(@_);
 
147
                }
 
148
 
 
149
                # Dispatch to the appropriate plugin
128
150
                unshift @_, ( $self, $1 );
129
 
                goto &{$self->can('call')} unless uc($1) eq $1;
 
151
                goto &{$self->can('call')};
130
152
        };
131
153
}
132
154
 
151
173
        delete $INC{"$self->{file}"};
152
174
        delete $INC{"$self->{path}.pm"};
153
175
 
 
176
        # Save to the singleton
 
177
        $MAIN = $self;
 
178
 
154
179
        return 1;
155
180
}
156
181
 
164
189
 
165
190
        my @exts = @{$self->{extensions}};
166
191
        unless ( @exts ) {
167
 
                my $admin = $self->{admin};
168
 
                @exts = $admin->load_all_extensions;
 
192
                @exts = $self->{admin}->load_all_extensions;
169
193
        }
170
194
 
171
195
        my %seen;
248
272
sub load_extensions {
249
273
        my ($self, $path, $top) = @_;
250
274
 
251
 
        unless ( grep { lc $_ eq lc $self->{prefix} } @INC ) {
 
275
        unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
252
276
                unshift @INC, $self->{prefix};
253
277
        }
254
278
 
312
336
 
313
337
 
314
338
#####################################################################
315
 
# Utility Functions
 
339
# Common Utility Functions
316
340
 
317
341
sub _caller {
318
342
        my $depth = 0;
326
350
 
327
351
sub _read {
328
352
        local *FH;
329
 
        open FH, "< $_[0]" or die "open($_[0]): $!";
330
 
        my $str = do { local $/; <FH> };
 
353
        if ( $] >= 5.006 ) {
 
354
                open( FH, '<', $_[0] ) or die "open($_[0]): $!";
 
355
        } else {
 
356
                open( FH, "< $_[0]"  ) or die "open($_[0]): $!";
 
357
        }
 
358
        my $string = do { local $/; <FH> };
331
359
        close FH or die "close($_[0]): $!";
332
 
        return $str;
 
360
        return $string;
 
361
}
 
362
 
 
363
sub _readperl {
 
364
        my $string = Module::Install::_read($_[0]);
 
365
        $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
 
366
        $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s;
 
367
        $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg;
 
368
        return $string;
 
369
}
 
370
 
 
371
sub _readpod {
 
372
        my $string = Module::Install::_read($_[0]);
 
373
        $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
 
374
        return $string if $_[0] =~ /\.pod\z/;
 
375
        $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg;
 
376
        $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg;
 
377
        $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg;
 
378
        $string =~ s/^\n+//s;
 
379
        return $string;
333
380
}
334
381
 
335
382
sub _write {
336
383
        local *FH;
337
 
        open FH, "> $_[0]" or die "open($_[0]): $!";
338
 
        foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!" }
 
384
        if ( $] >= 5.006 ) {
 
385
                open( FH, '>', $_[0] ) or die "open($_[0]): $!";
 
386
        } else {
 
387
                open( FH, "> $_[0]"  ) or die "open($_[0]): $!";
 
388
        }
 
389
        foreach ( 1 .. $#_ ) {
 
390
                print FH $_[$_] or die "print($_[0]): $!";
 
391
        }
339
392
        close FH or die "close($_[0]): $!";
340
393
}
341
394
 
342
 
sub _version {
 
395
# _version is for processing module versions (eg, 1.03_05) not
 
396
# Perl versions (eg, 5.8.1).
 
397
sub _version ($) {
343
398
        my $s = shift || 0;
344
 
           $s =~ s/^(\d+)\.?//;
 
399
        my $d =()= $s =~ /(\.)/g;
 
400
        if ( $d >= 2 ) {
 
401
                # Normalise multipart versions
 
402
                $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
 
403
        }
 
404
        $s =~ s/^(\d+)\.?//;
345
405
        my $l = $1 || 0;
346
 
        my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g;
347
 
           $l = $l . '.' . join '', @v if @v;
 
406
        my @v = map {
 
407
                $_ . '0' x (3 - length $_)
 
408
        } $s =~ /(\d{1,3})\D?/g;
 
409
        $l = $l . '.' . join '', @v if @v;
348
410
        return $l + 0;
349
411
}
350
412
 
 
413
sub _cmp ($$) {
 
414
        _version($_[0]) <=> _version($_[1]);
 
415
}
 
416
 
 
417
# Cloned from Params::Util::_CLASS
 
418
sub _CLASS ($) {
 
419
        (
 
420
                defined $_[0]
 
421
                and
 
422
                ! ref $_[0]
 
423
                and
 
424
                $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s
 
425
        ) ? $_[0] : undef;
 
426
}
 
427
 
351
428
1;
352
429
 
353
 
# Copyright 2008 Adam Kennedy.
 
430
# Copyright 2008 - 2009 Adam Kennedy.