inc.pm

视频监控网络部分的协议ddns,的模块的实现代码,请大家大胆指正.

        ### it's just some dir...
        return $path;
    }

    ### just a debug method
    sub _show_cache { return \%Cache };

    sub import {
        my $pkg = shift;

        ### filter DEBUG, and toggle the global
        map { $LIMIT{$_} = 1 }  
            grep {  /DEBUG/ ? ++$DEBUG && 0 : 
                    /QUIET/ ? ++$QUIET && 0 :
                    1 
            } @_;
        
        ### only load once ###
        return 1 if $Loaded++;

        ### first, add our own private dir to the end of @INC:
        {
            push @INC,  __PACKAGE__->my_path, __PACKAGE__->inc_path,
                        __PACKAGE__->installer_path;

            ### XXX stop doing this, there's no need for it anymore;
            ### none of the shell outs need to have this set anymore
#             ### add the path to this module to PERL5OPT in case
#             ### we spawn off some programs...
#             ### then add this module to be loaded in PERL5OPT...
#             {   local $^W;
#                 $ENV{'PERL5LIB'} .= $Config::Config{'path_sep'}
#                                  . __PACKAGE__->my_path
#                                  . $Config::Config{'path_sep'}
#                                  . __PACKAGE__->inc_path;
#
#                 $ENV{'PERL5OPT'} = '-M'. __PACKAGE__ . ' '
#                                  . ($ENV{'PERL5OPT'} || '');
#             }
        }

        ### next, find the highest version of a module that
        ### we care about. very basic check, but will
        ### have to do for now.
        lib->import( sub {
            my $path    = pop();                    # path to the pm
            my $module  = $path or return;          # copy of the path, to munge
            my @parts   = split qr!\\|/!, $path;    # dirs + file name; could be
                                                    # win32 paths =/
            my $file    = pop @parts;               # just the file name
            my $map     = __PACKAGE__->interesting_modules;

            ### translate file name to module name 
            ### could contain win32 paths delimiters
            $module =~ s!/|\\!::!g; $module =~ s/\.pm//i;

            my $check_version; my $try;
            ### does it look like a module we care about?
            my ($interesting) = grep { $module =~ /^$_/ } keys %$map;
            ++$try if $interesting;

            ### do we need to check the version too?
            ++$check_version if exists $map->{$module};

            ### we don't care ###
            unless( $try ) {
                warn __PACKAGE__ .": Not interested in '$module'\n" if $DEBUG;
                return;

            ### we're not allowed
            } elsif ( $try and keys %LIMIT ) {
                unless( grep { $module =~ /^$_/ } keys %LIMIT  ) {
                    warn __PACKAGE__ .": Limits active, '$module' not allowed ".
                                        "to be loaded" if $DEBUG;
                    return;
                }
            }

            ### found filehandles + versions ###
            my @found;
            DIR: for my $dir (@INC) {
                next DIR unless -d $dir;

                ### get the full path to the module ###
                my $pm = File::Spec->catfile( $dir, @parts, $file );

                ### open the file if it exists ###
                if( -e $pm ) {
                    my $fh;
                    unless( open $fh, "$pm" ) {
                        warn __PACKAGE__ .": Could not open '$pm': $!\n"
                            if $DEBUG;
                        next DIR;
                    }

                    my $found;
                    ### XXX stolen from module::load::conditional ###
                    while (local $_ = <$fh> ) {

                        ### the following regexp comes from the
                        ### ExtUtils::MakeMaker documentation.
                        if ( /([\$*])(([\w\:\']*)\bVERSION)\b.*\=/ ) {

                            ### this will eval the version in to $VERSION if it
                            ### was declared as $VERSION in the module.
                            ### else the result will be in $res.
                            ### this is a fix on skud's Module::InstalledVersion

                            local $VERSION;
                            my $res = eval $_;

                            ### default to '0.0' if there REALLY is no version
                            ### all to satisfy warnings
                            $found = $VERSION || $res || '0.0';

                            ### found what we came for
                            last if $found;
                        }
                    }

                    ### no version defined at all? ###
                    $found ||= '0.0';

                    warn __PACKAGE__ .": Found match for '$module' in '$dir' "
                                     ."with version '$found'\n" if $DEBUG;

                    ### reset the position of the filehandle ###
                    seek $fh, 0, 0;

                    ### store the found version + filehandle it came from ###
                    push @found, [ $found, $fh, $dir, $pm ];
                }

            } # done looping over all the dirs

            ### nothing found? ###
            unless (@found) {
                warn __PACKAGE__ .": Unable to find any module named "
                                    . "'$module'\n" if $DEBUG;
                return;
            }

            ### find highest version
            ### or the one in the same dir as a base module already loaded
            ### or otherwise, the one not bundled
            ### or otherwise the newest
            my @sorted = sort {
                            _vcmp($b->[0], $a->[0])                  ||
                            ($Cache{$interesting}
                                ?($b->[2] eq $Cache{$interesting}->[0][2]) <=>
                                 ($a->[2] eq $Cache{$interesting}->[0][2])
                                : 0 )                               ||
                            (($a->[2] eq __PACKAGE__->inc_path) <=>
                             ($b->[2] eq __PACKAGE__->inc_path))    ||
                            (-M $a->[3] <=> -M $b->[3])
                          } @found;

            warn __PACKAGE__ .": Best match for '$module' is found in "
                             ."'$sorted[0][2]' with version '$sorted[0][0]'\n"
                    if $DEBUG;

            if( $check_version and 
                not (_vcmp($sorted[0][0], $map->{$module}) >= 0) 
            ) {
                warn __PACKAGE__ .": Cannot find high enough version for "
                                 ."'$module' -- need '$map->{$module}' but "
                                 ."only found '$sorted[0][0]'. Returning "
                                 ."highest found version but this may cause "
                                 ."problems\n" unless $QUIET;
            };

            ### right, so that damn )#$(*@#)(*@#@ Module::Build makes
            ### assumptions about the environment (especially its own tests)
            ### and blows up badly if it's loaded via CP::inc :(
            ### so, if we find a newer version on disk (which would happen when
            ### upgrading or having upgraded, just pretend we didn't find it,
            ### let it be loaded via the 'normal' way.
            ### can't even load the *proper* one via our CP::inc, as it will
            ### get upset just over the fact it's loaded via a non-standard way
            if( $module =~ /^Module::Build/ and
                $sorted[0][2] ne __PACKAGE__->inc_path and
                $sorted[0][2] ne __PACKAGE__->installer_path
            ) {
                warn __PACKAGE__ .": Found newer version of 'Module::Build::*' "
                                 ."elsewhere in your path. Pretending to not "
                                 ."have found it\n" if $DEBUG;
                return;
            }

            ### store what we found for this module
            $Cache{$module} = \@sorted;

            ### best matching filehandle ###
            return $sorted[0][1];
        } );
    }
}

### XXX copied from C::I::Utils, so there's no circular require here!
sub _vcmp {
    my ($x, $y) = @_;
    s/_//g foreach $x, $y;
    return $x <=> $y;
}

=pod

=head1 DEBUG

Since this module does C<Clever Things> to your search path, it might
be nice sometimes to figure out what it's doing, if things don't work
as expected. You can enable a debug trace by calling the module like
this:

    use CPANPLUS::inc 'DEBUG';

This will show you what C<CPANPLUS::inc> is doing, which might look
something like this:

    CPANPLUS::inc: Found match for 'Params::Check' in
    '/opt/lib/perl5/site_perl/5.8.3' with version '0.07'
    CPANPLUS::inc: Found match for 'Params::Check' in
    '/my/private/lib/CPANPLUS/inc' with version '0.21'
    CPANPLUS::inc: Best match for 'Params::Check' is found in
    '/my/private/lib/CPANPLUS/inc' with version '0.21'

=head1 CAVEATS

This module has 2 major caveats, that could lead to unexpected
behaviour. But currently I don't know how to fix them, Suggestions
are much welcomed.

=over 4

=item On multiple C<use lib> calls, our coderef may not be the first in @INC

If this happens, although unlikely in most situations and not happening
when calling the shell directly, this could mean that a lower (too low)
versioned module is loaded, which might cause failures in the
application.

=item Non-directories in @INC

Non-directories are right now skipped by CPANPLUS::inc. They could of
course lead us to newer versions of a module, but it's too tricky to
verify if they would. Therefor they are skipped. In the worst case
scenario we'll find the sufficing version bundled with CPANPLUS.


=cut

1;

# Local variables:
# c-indentation-style: bsd
# c-basic-offset: 4
# indent-tabs-mode: nil
# End:
# vim: expandtab shiftwidth=4: