← Back to branch summary

~ubuntu-branches/ubuntu/quantal/nginx/quantal-updates

« back to all changes in this revision

Viewing changes to modules/nginx-echo/test/inc/Module/Install.pm

  • Committer: Bazaar Package Importer
  • Author(s): Michael Lustfield, Micheal Lustfield, Kartik Mistry
  • Date: 2011-03-03 23:39:07 UTC
  • mfrom: (4.2.29 sid)
  • Revision ID: james.westby@ubuntu.com-20110303233907-y48yifhfnn5qjuxz
Tags: 0.8.54-4
http://bugs.debian.org/610946
https://launchpad.net/bugs/699736
http://bugs.debian.org/609343
http://bugs.debian.org/608983
http://bugs.debian.org/610289
http://bugs.debian.org/610290
http://bugs.debian.org/609797
http://bugs.debian.org/610983
http://bugs.debian.org/612832
http://bugs.debian.org/613175
http://bugs.debian.org/613355
http://bugs.debian.org/613851
http://bugs.debian.org/614987
http://bugs.debian.org/614980
[Micheal Lustfield]
* debian/nginx-{full,light,extras}.default:
  + Added comment about alternative to ULIMIT.
* debian/nginx-{full,light,extras}.init.d:
  + Added quotes around a test variable. (Closes: #610946, LP: #699736)
* debian/patches/609343-log-time-iso8601.diff:
  + Added patch to add $time_iso8601 variable to logs. (Closes: #609343)
* Clean up old logrotate files. (Closes: #608983, Closes: #610289)
  + Added Files:
    - debian/nginx-common.preinst
  + Modified Files:
    - debian/rules
  + Moved debian/nginx-common.logrotate to debian/logrotate.
* Added common files to nginx-common package. (Closes: #610290)
  + Removed Files:
    - debian/nginx-full.dirs
    - debian/nginx-light.dirs
    - debian/nginx-full.install
    - debian/nginx-light.install
    - debian/nginx-extras.install
    - debian/nginx.*
  + Added Files:
    - debian/nginx-common.default
    - debian/nginx-common.dirs
    - debian/nginx-common.init.d
    - debian/nginx-common.install
    - debian/nginx-common.manpages
    - debian/logrotate
  + Modified Files:
    - debian/nginx-extras.dirs
    - debian/control
    - debian/rules
* debian/nginx-*.install: (Closes: #609797)
  + Removed NEWS.Debian from nginx-{full,light,extras}.install.
  + Added NEWS.Debian to nginx-common.install.
* nginx-common.postinst:
  + Enforce /var/log/nginx mode and user:group. (Closes: #610983)
  + Enforce /var/log/nginx/*.log mode and user:group. (Closes: #612832)
* debian/rules:
  + Added --with-file-aio to nginx-extras. (Closes: #613175)
  + Removed split clients and user id modules from nginx-light.
* debian/conf/sites-available/default:
  + Fixed a minor typo ( s/Quickstart/QuickStart/ ). (Closes: #613355)
* debian/conf/mime.types:
  + Changed xml type to application/xhtml+xml. (Closes: #613851)
* debian/help/docs/fcgiwrap:
  + Removed Ubuntu specific line in docs. (Closes: #614987)
* debian/conf/sites-available/default:
  + Fixed a pointer to a file. (Closes: #614980)

[Kartik Mistry]
* debian/*.lintian-overrides:
  + Add Lintian overrides for nginx man page. We've manpage in nginx-common
    binary

Show diffs side-by-side

added added

removed removed

Lines of Context:
modules/nginx-echo/test/inc/Module/Install.pm
1
 
#line 1
2
 
package Module::Install;
3
 
 
4
 
# For any maintainers:
5
 
# The load order for Module::Install is a bit magic.
6
 
# It goes something like this...
7
 
#
8
 
# IF ( host has Module::Install installed, creating author mode ) {
9
 
#     1. Makefile.PL calls "use inc::Module::Install"
10
 
#     2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install
11
 
#     3. The installed version of inc::Module::Install loads
12
 
#     4. inc::Module::Install calls "require Module::Install"
13
 
#     5. The ./inc/ version of Module::Install loads
14
 
# } ELSE {
15
 
#     1. Makefile.PL calls "use inc::Module::Install"
16
 
#     2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install
17
 
#     3. The ./inc/ version of Module::Install loads
18
 
# }
19
 
 
20
 
use 5.005;
21
 
use strict 'vars';
22
 
use Cwd        ();
23
 
use File::Find ();
24
 
use File::Path ();
25
 
 
26
 
use vars qw{$VERSION $MAIN};
27
 
BEGIN {
28
 
        # All Module::Install core packages now require synchronised versions.
29
 
        # This will be used to ensure we don't accidentally load old or
30
 
        # different versions of modules.
31
 
        # This is not enforced yet, but will be some time in the next few
32
 
        # releases once we can make sure it won't clash with custom
33
 
        # Module::Install extensions.
34
 
        $VERSION = '0.99';
35
 
 
36
 
        # Storage for the pseudo-singleton
37
 
        $MAIN    = undef;
38
 
 
39
 
        *inc::Module::Install::VERSION = *VERSION;
40
 
        @inc::Module::Install::ISA     = __PACKAGE__;
41
 
 
42
 
}
43
 
 
44
 
sub import {
45
 
        my $class = shift;
46
 
        my $self  = $class->new(@_);
47
 
        my $who   = $self->_caller;
48
 
 
49
 
        #-------------------------------------------------------------
50
 
        # all of the following checks should be included in import(),
51
 
        # to allow "eval 'require Module::Install; 1' to test
52
 
        # installation of Module::Install. (RT #51267)
53
 
        #-------------------------------------------------------------
54
 
 
55
 
        # Whether or not inc::Module::Install is actually loaded, the
56
 
        # $INC{inc/Module/Install.pm} is what will still get set as long as
57
 
        # the caller loaded module this in the documented manner.
58
 
        # If not set, the caller may NOT have loaded the bundled version, and thus
59
 
        # they may not have a MI version that works with the Makefile.PL. This would
60
 
        # result in false errors or unexpected behaviour. And we don't want that.
61
 
        my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
62
 
        unless ( $INC{$file} ) { die <<"END_DIE" }
63
 
 
64
 
Please invoke ${\__PACKAGE__} with:
65
 
 
66
 
        use inc::${\__PACKAGE__};
67
 
 
68
 
not:
69
 
 
70
 
        use ${\__PACKAGE__};
71
 
 
72
 
END_DIE
73
 
 
74
 
        # This reportedly fixes a rare Win32 UTC file time issue, but
75
 
        # as this is a non-cross-platform XS module not in the core,
76
 
        # we shouldn't really depend on it. See RT #24194 for detail.
77
 
        # (Also, this module only supports Perl 5.6 and above).
78
 
        eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006;
79
 
 
80
 
        # If the script that is loading Module::Install is from the future,
81
 
        # then make will detect this and cause it to re-run over and over
82
 
        # again. This is bad. Rather than taking action to touch it (which
83
 
        # is unreliable on some platforms and requires write permissions)
84
 
        # for now we should catch this and refuse to run.
85
 
        if ( -f $0 ) {
86
 
                my $s = (stat($0))[9];
87
 
 
88
 
                # If the modification time is only slightly in the future,
89
 
                # sleep briefly to remove the problem.
90
 
                my $a = $s - time;
91
 
                if ( $a > 0 and $a < 5 ) { sleep 5 }
92
 
 
93
 
                # Too far in the future, throw an error.
94
 
                my $t = time;
95
 
                if ( $s > $t ) { die <<"END_DIE" }
96
 
 
97
 
Your installer $0 has a modification time in the future ($s > $t).
98
 
 
99
 
This is known to create infinite loops in make.
100
 
 
101
 
Please correct this, then run $0 again.
102
 
 
103
 
END_DIE
104
 
        }
105
 
 
106
 
 
107
 
        # Build.PL was formerly supported, but no longer is due to excessive
108
 
        # difficulty in implementing every single feature twice.
109
 
        if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" }
110
 
 
111
 
Module::Install no longer supports Build.PL.
112
 
 
113
 
It was impossible to maintain duel backends, and has been deprecated.
114
 
 
115
 
Please remove all Build.PL files and only use the Makefile.PL installer.
116
 
 
117
 
END_DIE
118
 
 
119
 
        #-------------------------------------------------------------
120
 
 
121
 
        # To save some more typing in Module::Install installers, every...
122
 
        # use inc::Module::Install
123
 
        # ...also acts as an implicit use strict.
124
 
        $^H |= strict::bits(qw(refs subs vars));
125
 
 
126
 
        #-------------------------------------------------------------
127
 
 
128
 
        unless ( -f $self->{file} ) {
129
 
                foreach my $key (keys %INC) {
130
 
                        delete $INC{$key} if $key =~ /Module\/Install/;
131
 
                }
132
 
 
133
 
                local $^W;
134
 
                require "$self->{path}/$self->{dispatch}.pm";
135
 
                File::Path::mkpath("$self->{prefix}/$self->{author}");
136
 
                $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
137
 
                $self->{admin}->init;
138
 
                @_ = ($class, _self => $self);
139
 
                goto &{"$self->{name}::import"};
140
 
        }
141
 
 
142
 
        local $^W;
143
 
        *{"${who}::AUTOLOAD"} = $self->autoload;
144
 
        $self->preload;
145
 
 
146
 
        # Unregister loader and worker packages so subdirs can use them again
147
 
        delete $INC{'inc/Module/Install.pm'};
148
 
        delete $INC{'Module/Install.pm'};
149
 
 
150
 
        # Save to the singleton
151
 
        $MAIN = $self;
152
 
 
153
 
        return 1;
154
 
}
155
 
 
156
 
sub autoload {
157
 
        my $self = shift;
158
 
        my $who  = $self->_caller;
159
 
        my $cwd  = Cwd::cwd();
160
 
        my $sym  = "${who}::AUTOLOAD";
161
 
        $sym->{$cwd} = sub {
162
 
                my $pwd = Cwd::cwd();
163
 
                if ( my $code = $sym->{$pwd} ) {
164
 
                        # Delegate back to parent dirs
165
 
                        goto &$code unless $cwd eq $pwd;
166
 
                }
167
 
                unless ($$sym =~ s/([^:]+)$//) {
168
 
                        # XXX: it looks like we can't retrieve the missing function
169
 
                        # via $$sym (usually $main::AUTOLOAD) in this case.
170
 
                        # I'm still wondering if we should slurp Makefile.PL to
171
 
                        # get some context or not ...
172
 
                        my ($package, $file, $line) = caller;
173
 
                        die <<"EOT";
174
 
Unknown function is found at $file line $line.
175
 
Execution of $file aborted due to runtime errors.
176
 
 
177
 
If you're a contributor to a project, you may need to install
178
 
some Module::Install extensions from CPAN (or other repository).
179
 
If you're a user of a module, please contact the author.
180
 
EOT
181
 
                }
182
 
                my $method = $1;
183
 
                if ( uc($method) eq $method ) {
184
 
                        # Do nothing
185
 
                        return;
186
 
                } elsif ( $method =~ /^_/ and $self->can($method) ) {
187
 
                        # Dispatch to the root M:I class
188
 
                        return $self->$method(@_);
189
 
                }
190
 
 
191
 
                # Dispatch to the appropriate plugin
192
 
                unshift @_, ( $self, $1 );
193
 
                goto &{$self->can('call')};
194
 
        };
195
 
}
196
 
 
197
 
sub preload {
198
 
        my $self = shift;
199
 
        unless ( $self->{extensions} ) {
200
 
                $self->load_extensions(
201
 
                        "$self->{prefix}/$self->{path}", $self
202
 
                );
203
 
        }
204
 
 
205
 
        my @exts = @{$self->{extensions}};
206
 
        unless ( @exts ) {
207
 
                @exts = $self->{admin}->load_all_extensions;
208
 
        }
209
 
 
210
 
        my %seen;
211
 
        foreach my $obj ( @exts ) {
212
 
                while (my ($method, $glob) = each %{ref($obj) . '::'}) {
213
 
                        next unless $obj->can($method);
214
 
                        next if $method =~ /^_/;
215
 
                        next if $method eq uc($method);
216
 
                        $seen{$method}++;
217
 
                }
218
 
        }
219
 
 
220
 
        my $who = $self->_caller;
221
 
        foreach my $name ( sort keys %seen ) {
222
 
                local $^W;
223
 
                *{"${who}::$name"} = sub {
224
 
                        ${"${who}::AUTOLOAD"} = "${who}::$name";
225
 
                        goto &{"${who}::AUTOLOAD"};
226
 
                };
227
 
        }
228
 
}
229
 
 
230
 
sub new {
231
 
        my ($class, %args) = @_;
232
 
 
233
 
    delete $INC{'FindBin.pm'};
234
 
    require FindBin;
235
 
 
236
 
        # ignore the prefix on extension modules built from top level.
237
 
        my $base_path = Cwd::abs_path($FindBin::Bin);
238
 
        unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) {
239
 
                delete $args{prefix};
240
 
        }
241
 
        return $args{_self} if $args{_self};
242
 
 
243
 
        $args{dispatch} ||= 'Admin';
244
 
        $args{prefix}   ||= 'inc';
245
 
        $args{author}   ||= ($^O eq 'VMS' ? '_author' : '.author');
246
 
        $args{bundle}   ||= 'inc/BUNDLES';
247
 
        $args{base}     ||= $base_path;
248
 
        $class =~ s/^\Q$args{prefix}\E:://;
249
 
        $args{name}     ||= $class;
250
 
        $args{version}  ||= $class->VERSION;
251
 
        unless ( $args{path} ) {
252
 
                $args{path}  = $args{name};
253
 
                $args{path}  =~ s!::!/!g;
254
 
        }
255
 
        $args{file}     ||= "$args{base}/$args{prefix}/$args{path}.pm";
256
 
        $args{wrote}      = 0;
257
 
 
258
 
        bless( \%args, $class );
259
 
}
260
 
 
261
 
sub call {
262
 
        my ($self, $method) = @_;
263
 
        my $obj = $self->load($method) or return;
264
 
        splice(@_, 0, 2, $obj);
265
 
        goto &{$obj->can($method)};
266
 
}
267
 
 
268
 
sub load {
269
 
        my ($self, $method) = @_;
270
 
 
271
 
        $self->load_extensions(
272
 
                "$self->{prefix}/$self->{path}", $self
273
 
        ) unless $self->{extensions};
274
 
 
275
 
        foreach my $obj (@{$self->{extensions}}) {
276
 
                return $obj if $obj->can($method);
277
 
        }
278
 
 
279
 
        my $admin = $self->{admin} or die <<"END_DIE";
280
 
The '$method' method does not exist in the '$self->{prefix}' path!
281
 
Please remove the '$self->{prefix}' directory and run $0 again to load it.
282
 
END_DIE
283
 
 
284
 
        my $obj = $admin->load($method, 1);
285
 
        push @{$self->{extensions}}, $obj;
286
 
 
287
 
        $obj;
288
 
}
289
 
 
290
 
sub load_extensions {
291
 
        my ($self, $path, $top) = @_;
292
 
 
293
 
        my $should_reload = 0;
294
 
        unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
295
 
                unshift @INC, $self->{prefix};
296
 
                $should_reload = 1;
297
 
        }
298
 
 
299
 
        foreach my $rv ( $self->find_extensions($path) ) {
300
 
                my ($file, $pkg) = @{$rv};
301
 
                next if $self->{pathnames}{$pkg};
302
 
 
303
 
                local $@;
304
 
                my $new = eval { local $^W; require $file; $pkg->can('new') };
305
 
                unless ( $new ) {
306
 
                        warn $@ if $@;
307
 
                        next;
308
 
                }
309
 
                $self->{pathnames}{$pkg} =
310
 
                        $should_reload ? delete $INC{$file} : $INC{$file};
311
 
                push @{$self->{extensions}}, &{$new}($pkg, _top => $top );
312
 
        }
313
 
 
314
 
        $self->{extensions} ||= [];
315
 
}
316
 
 
317
 
sub find_extensions {
318
 
        my ($self, $path) = @_;
319
 
 
320
 
        my @found;
321
 
        File::Find::find( sub {
322
 
                my $file = $File::Find::name;
323
 
                return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
324
 
                my $subpath = $1;
325
 
                return if lc($subpath) eq lc($self->{dispatch});
326
 
 
327
 
                $file = "$self->{path}/$subpath.pm";
328
 
                my $pkg = "$self->{name}::$subpath";
329
 
                $pkg =~ s!/!::!g;
330
 
 
331
 
                # If we have a mixed-case package name, assume case has been preserved
332
 
                # correctly.  Otherwise, root through the file to locate the case-preserved
333
 
                # version of the package name.
334
 
                if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) {
335
 
                        my $content = Module::Install::_read($subpath . '.pm');
336
 
                        my $in_pod  = 0;
337
 
                        foreach ( split //, $content ) {
338
 
                                $in_pod = 1 if /^=\w/;
339
 
                                $in_pod = 0 if /^=cut/;
340
 
                                next if ($in_pod || /^=cut/);  # skip pod text
341
 
                                next if /^\s*#/;               # and comments
342
 
                                if ( m/^\s*package\s+($pkg)\s*;/i ) {
343
 
                                        $pkg = $1;
344
 
                                        last;
345
 
                                }
346
 
                        }
347
 
                }
348
 
 
349
 
                push @found, [ $file, $pkg ];
350
 
        }, $path ) if -d $path;
351
 
 
352
 
        @found;
353
 
}
354
 
 
355
 
 
356
 
 
357
 
 
358
 
 
359
 
#####################################################################
360
 
# Common Utility Functions
361
 
 
362
 
sub _caller {
363
 
        my $depth = 0;
364
 
        my $call  = caller($depth);
365
 
        while ( $call eq __PACKAGE__ ) {
366
 
                $depth++;
367
 
                $call = caller($depth);
368
 
        }
369
 
        return $call;
370
 
}
371
 
 
372
 
# Done in evals to avoid confusing Perl::MinimumVersion
373
 
eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
374
 
sub _read {
375
 
        local *FH;
376
 
        open( FH, '<', $_[0] ) or die "open($_[0]): $!";
377
 
        my $string = do { local $/; <FH> };
378
 
        close FH or die "close($_[0]): $!";
379
 
        return $string;
380
 
}
381
 
END_NEW
382
 
sub _read {
383
 
        local *FH;
384
 
        open( FH, "< $_[0]"  ) or die "open($_[0]): $!";
385
 
        my $string = do { local $/; <FH> };
386
 
        close FH or die "close($_[0]): $!";
387
 
        return $string;
388
 
}
389
 
END_OLD
390
 
 
391
 
sub _readperl {
392
 
        my $string = Module::Install::_read($_[0]);
393
 
        $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
394
 
        $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s;
395
 
        $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg;
396
 
        return $string;
397
 
}
398
 
 
399
 
sub _readpod {
400
 
        my $string = Module::Install::_read($_[0]);
401
 
        $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
402
 
        return $string if $_[0] =~ /\.pod\z/;
403
 
        $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg;
404
 
        $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg;
405
 
        $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg;
406
 
        $string =~ s/^\n+//s;
407
 
        return $string;
408
 
}
409
 
 
410
 
# Done in evals to avoid confusing Perl::MinimumVersion
411
 
eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
412
 
sub _write {
413
 
        local *FH;
414
 
        open( FH, '>', $_[0] ) or die "open($_[0]): $!";
415
 
        foreach ( 1 .. $#_ ) {
416
 
                print FH $_[$_] or die "print($_[0]): $!";
417
 
        }
418
 
        close FH or die "close($_[0]): $!";
419
 
}
420
 
END_NEW
421
 
sub _write {
422
 
        local *FH;
423
 
        open( FH, "> $_[0]"  ) or die "open($_[0]): $!";
424
 
        foreach ( 1 .. $#_ ) {
425
 
                print FH $_[$_] or die "print($_[0]): $!";
426
 
        }
427
 
        close FH or die "close($_[0]): $!";
428
 
}
429
 
END_OLD
430
 
 
431
 
# _version is for processing module versions (eg, 1.03_05) not
432
 
# Perl versions (eg, 5.8.1).
433
 
sub _version ($) {
434
 
        my $s = shift || 0;
435
 
        my $d =()= $s =~ /(\.)/g;
436
 
        if ( $d >= 2 ) {
437
 
                # Normalise multipart versions
438
 
                $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
439
 
        }
440
 
        $s =~ s/^(\d+)\.?//;
441
 
        my $l = $1 || 0;
442
 
        my @v = map {
443
 
                $_ . '0' x (3 - length $_)
444
 
        } $s =~ /(\d{1,3})\D?/g;
445
 
        $l = $l . '.' . join '', @v if @v;
446
 
        return $l + 0;
447
 
}
448
 
 
449
 
sub _cmp ($$) {
450
 
        _version($_[0]) <=> _version($_[1]);
451
 
}
452
 
 
453
 
# Cloned from Params::Util::_CLASS
454
 
sub _CLASS ($) {
455
 
        (
456
 
                defined $_[0]
457
 
                and
458
 
                ! ref $_[0]
459
 
                and
460
 
                $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s
461
 
        ) ? $_[0] : undef;
462
 
}
463
 
 
464
 
1;
465
 
 
466
 
# Copyright 2008 - 2010 Adam Kennedy.