build.pm

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

    my $self = shift;
    my $requested_version = shift;

    my $has_version = $self->perl_config('gccversion');

    return 0 unless $has_version;

    #Only interested in leading version digits
    $has_version =~ s/^([0-9.]+).*/$1/;

    my @tuples = split /\./, $has_version, 3;
    my @r_tuples = split /\./, $requested_version, 3;
    
    return cmp_tuples(\@tuples, \@r_tuples) == 1;
}

sub cmp_tuples {
    my ($num_a, $num_b) = @_;

    while (@$num_a && @$num_b) {
        my $cmp = shift @$num_a <=> shift @$num_b;
        return $cmp if $cmp;
    }

    return @$num_a <=> @$num_b;
}
    
sub perl_ccopts {
    my $self = shift;

    my $cflags = $self->strip_lfs(" $Config{ccflags} ");

    my $fixup = \&{"ccopts_$^O"};
    if (defined &$fixup) {
        $fixup->(\$cflags);
    }

    if (WIN32 and $self->{MP_DEBUG}) {
        #only win32 has -DDEBUGGING in both optimize and ccflags
        my $optim = $Config{optimize};

        unless ($optim =~ /-DDEBUGGING/) {
            $cflags =~ s/$optim//;
       }
    }

    if (CYGWIN) {
        $cflags .= " -DCYGWIN ";
    }

    $cflags;
}

sub ccopts_hpux {
    my $cflags = shift;
    return if $Config{cc} eq 'gcc'; #XXX?
    return if $$cflags =~ /(-Ae|\+e)/;
    $$cflags .= " -Ae ";
}

# XXX: there could be more, but this is just for cosmetics
my %cflags_dups = map { $_ => 1 } qw(-D_GNU_SOURCE -D_REENTRANT);
sub ccopts {
    my ($self) = @_;

    my $cflags = $self->perl_ccopts . ExtUtils::Embed::perl_inc() .
                 $self->ap_ccopts;

    # remove duplicates of certain cflags coming from perl and ap/apr
    my @cflags = ();
    my %dups    = ();
    for (split /\s+/, $cflags) {
        if ($cflags_dups{$_}) {
            next if $dups{$_};
            $dups{$_}++;
        }
        push @cflags, $_;
    }
    $cflags = "@cflags";

    $cflags;
}

sub ldopts_prefix {
    my $self = shift;
    $self->perl_config('ld') eq 'ld' ? '' : "-Wl,";
}

sub perl_config_optimize {
    my ($self, $val) = @_;

    $val ||= $Config{optimize};

    if ($self->{MP_DEBUG}) {
        return ' ' unless $Config{ccflags} =~ /-DDEBUGGING/;
    }

    $val;
}

sub perl_config_ld {
    my ($self, $val) = @_;

    $val ||= $Config{ld};

    basename $val; #bleedperl hpux value is /usr/bin/ld !
}

sub perl_config_lddlflags {
    my ($self, $val) = @_;

    if ($self->{MP_DEBUG}) {
        if (MSVC) {
            unless ($val =~ s/-release/-debug/) {
                $val .= ' -debug';
            }
        }
    }

    if (AIX) {
        my $Wl = $self->ldopts_prefix;

        # it's useless to import symbols from libperl.so this way,
        # because perl.exp is incomplete. a better way is to link
        # against -lperl which has all the symbols
        $val =~ s|${Wl}-bI:\$\(PERL_INC\)/perl\.exp||;
        # also in the case of Makefile.modperl PERL_INC is defined

        # this works with at least ld(1) on powerpc-ibm-aix5.1.0.0:
        # -berok ignores symbols resolution problems (they will be
        #        resolved at run-time
        # -brtl prepares the object for run-time loading
        # LDFLAGS already inserts -brtl
        $val .= " ${Wl}-berok";
        # XXX: instead of -berok, could make sure that we have:
        #   -Lpath/to/CORE -lperl
        #   -bI:$path/apr.exp -bI:$path/aprutil.exp -bI:$path/httpd.exp
        #   -bI:$path/modperl_*.exp 
        # - don't import modperl_*.exp in Makefile.modperl which
        #   exports -bE:$path/modperl_*.exp
        # - can't rely on -bI:$path/perl.exp, because it's incomplete,
        #   use -lperl instead
        # - the issue with using apr/aprutil/httpd.exp is to pick the
        #   right path if httpd wasn't yet installed
    }

    $val;
}

sub perl_config {
    my ($self, $key) = @_;

    my $val = $Config{$key} || '';

    my $method = \&{"perl_config_$key"};
    if (defined &$method) {
        return $method->($self, $val);
    }

    return $val;
}

sub find_in_inc {
    my $name = shift;
    for (@INC) {
        my $file;
        if (-e ($file = "$_/auto/Apache2/$name")) {
            return $file;
        }
    }
}

sub libpth {
    my $self = shift;
    $self->{libpth} ||= [split /\s+/, $Config{libpth}];
    return wantarray ? @{ $self->{libpth} } : $self->{libpth};
}

sub find_dlfile {
    my ($self, $name) = (shift, shift);

    require DynaLoader;
    require AutoLoader; #eek

    my $found = 0;
    my $loc = "";
    my (@path) = ($self->libpth, @_);

    for (@path) {
        if ($found = DynaLoader::dl_findfile($_, "-l$name")) {
            $loc = $_;
            last;
        }
    }

    return wantarray ? ($loc, $found) : $found;
}

sub find_dlfile_maybe {
    my ($self, $name) = @_;

    my $path = $self->libpth;

    my @maybe;
    my $lib = 'lib' . $name;

    for (@$path) {
        push @maybe, grep { ! -l $_ } <$_/$lib.*>;
    }

    return \@maybe;
}

sub lib_check {
    my ($self, $name) = @_;
    return unless $self->perl_config('libs') =~ /$name/;

    return if $self->find_dlfile($name);

    my $maybe = $self->find_dlfile_maybe($name);
    my $suggest = @$maybe ? 
        "You could just symlink it to $maybe->[0]" :
        'You might need to install Perl from source';
    $self->phat_warn(<<EOF);
Your Perl is configured to link against lib$name,
  but lib$name.so was not found.
  $suggest
EOF
}

#--- user interaction ---

sub prompt {
    my ($self, $q, $default) = @_;
    return $default if $self->{MP_PROMPT_DEFAULT};
    require ExtUtils::MakeMaker;
    ExtUtils::MakeMaker::prompt($q, $default);
}

sub prompt_y {
    my ($self, $q) = @_;
    $self->prompt($q, 'y') =~ /^y/i;
}

sub prompt_n {
    my ($self, $q) = @_;
    $self->prompt($q, 'n') =~ /^n/i;
}

sub phat_warn {
    my ($self, $msg, $abort) = @_;
    my $level = $abort ? 'ERROR' : 'WARNING';
    warn <<EOF;
************* $level *************

  $msg

************* $level *************
EOF
    if ($abort) {
        exit 1;
    }
    else {
        sleep 5;
    }
}

#--- constructors ---

my $bpm = 'Apache2/BuildConfig.pm';

sub build_config {
    my $self = shift;
    my $bpm_mtime = 0;

    $bpm_mtime = (stat _)[9] if $INC{$bpm} && -e $INC{$bpm};

    if (-e "lib/$bpm" and (stat _)[9] > $bpm_mtime) {
        #reload if Makefile.PL has regenerated
        unshift @INC, 'lib';
        delete $INC{$bpm};
        eval { require Apache2::BuildConfig; };
        shift @INC;
    }
    else {
        eval { require Apache2::BuildConfig; };
    }

    return bless {}, (ref($self) || $self) if $@;
    return Apache2::BuildConfig->new;
}

sub new {
    my $class = shift;

    my $self = bless {
        cwd        => Cwd::fastcwd(),
        MP_LIBNAME => 'mod_perl',
        @_,
    }, $class;

    $self->{MP_APR_LIB} = 'aprext';

    ModPerl::BuildOptions->init($self) if delete $self->{init};

    $self;
}

sub DESTROY {}

my %default_files = (
    'build_config' => 'lib/Apache2/BuildConfig.pm',
    'ldopts'       => 'src/modules/perl/ldopts',
    'makefile'     => 'src/modules/perl/Makefile',
);

sub clean_files {
    my $self = shift;
    [map { $self->default_file($_) } keys %default_files];
}

sub default_file {
    my ($self, $name, $override) = @_;
    my $key = join '_', 'file', $name;
    $self->{$key} ||= ($override || $default_files{$name});
}

sub file_path {
    my $self = shift;
    my @files = map { m:^/: ? $_ : join('/', $self->{cwd}, $_) } @_;
    return wantarray ? @files : $files[0];
}

sub freeze {
    require Data::Dumper;
    local $Data::Dumper::Terse    = 1;
    local $Data::Dumper::Sortkeys = 1;
    my $data = Data::Dumper::Dumper(shift);
    chomp $data;
    $data;
}

sub save_ldopts {
    my ($self, $file) = @_;

    $file ||= $self->default_file('ldopts', $file);
    my $ldopts = $self->ldopts;

    open my $fh, '>', $file or die "open $file: $!";
    print $fh "#!/bin/sh\n\necho $ldopts\n";
    close $fh;
    chmod 0755, $file;
}

sub noedit_warning_hash {
    ModPerl::Code::noedit_warning_hash(__PACKAGE__);
}

sub save {
    my ($self, $file) = @_;

    delete $INC{$bpm};

    $file ||= $self->default_file('build_config');
    $file = $self->file_path($file);

    my $obj = $self->freeze;
    $obj =~ s/^\s{9}//mg;
    $obj =~ s/^/    /;

    open my $fh, '>', $file or die "open $file: $!";

    #work around autosplit braindeadness
    my $package = 'package Apache2::BuildConfig';

    print $fh noedit_warning_hash();

    print $fh <<EOF;
$package;

use Apache2::Build ();

sub new {
$obj;
}

1;
EOF

    close $fh or die "failed to write $file: $!";
}

sub rebuild {
    my $self = __PACKAGE__->build_config;
    my @opts = map { qq[$_='$self->{$_}'] } sort grep /^MP_/,  keys %$self;
    my $command = "perl Makefile.PL @opts";
    print "Running: $command\n";
    system $command;
}
# % perl -MApache2::Build -e rebuild
*main::rebuild = \&rebuild if $0 eq '-e';

#--- attribute access ---

sub is_dynamic { shift->{MP_USE_DSO} }

sub default_dir {
    my $build = shift->build_config;

    return $build->dir || '../apache_x.x/src';
}

sub dir {
    my ($self, $dir) = @_;

    if ($dir) {
        for (qw(ap_includedir)) {
            delete $self->{$_};
        }
        if ($dir =~ m:^\.\.[/\\]:) {
            $dir = "$self->{cwd}/$dir";
        }
        $self->{dir} = $dir;
    }

    return $self->{dir} if $self->{dir};

    # be careful with the guesswork, or may pick up some wrong headers
    if (IS_MOD_PERL_BUILD && $self->{MP_AP_PREFIX}) {
        my $build = $self->build_config;

        if (my $bdir = $build->{'dir'}) {
            for ($bdir, "../$bdir", "../../$bdir") {
                if (-d $_) {
                    $dir = $_;
                    last;
                }
            }
        }
    }

    $dir ||= $self->{MP_AP_PREFIX};

# we no longer install Apache headers, so don't bother looking in @INC
# might end up finding 1.x headers anyhow
#    unless ($dir and -d $dir) {
#        for (@INC) {
#            last if -d ($dir = "$_/auto/Apache2/include");
#        }
#    }
    return $self->{dir} = $dir ? canonpath(rel2abs $dir) : undef;
}

#--- finding apache *.h files ---

sub find {
    my $self = shift;
    my %seen = ();
    my @dirs = ();

    for my $src_dir ($self->dir,
                     $self->default_dir,
                     '../httpd-2.0')
      {
          next unless $src_dir;
          next unless (-d $src_dir || -l $src_dir);
          next if $seen{$src_dir}++;
          push @dirs, $src_dir;
          #$modified{$src_dir} = (stat($src_dir))[9];
      }

    return @dirs;
}

sub ap_includedir  {
    my ($self, $d) = @_;

    return $self->{ap_includedir}
      if $self->{ap_includedir} and -d $self->{ap_includedir};

    return unless $d ||= $self->apxs('-q' => 'INCLUDEDIR') || $self->dir;

    if (-e "$d/include/ap_release.h") {
        return $self->{ap_includedir} = "$d/include";
    }

    $self->{ap_includedir} = $d;
}

# This is necessary for static builds that needs to make a
# difference between where the apache headers are (to build
# against) and where they will be installed (to install our
# own headers alongside)
#
# ap_exp_includedir is where apache is going to install its
# headers to
sub ap_exp_includedir {
    my ($self) = @_;

    return $self->{ap_exp_includedir} if $self->{ap_exp_includedir};

    my $build_vars = File::Spec->catfile($self->{MP_AP_PREFIX}, 
                                         qw(build config_vars.mk));
    open my $vars, "<$build_vars" or die "Couldn't open $build_vars $!";
    my $ap_exp_includedir;
    while (<$vars>) {
        if (/exp_includedir\s*=\s*(.*)/) {
            $ap_exp_includedir = $1;
            last;
        }
    }

    $self->{ap_exp_includedir} = $ap_exp_includedir;
}

sub install_headers_dir {
    my ($self) = @_;
    if ($self->should_build_apache) {
        return $self->ap_exp_includedir();
    }
    else {
        return $self->ap_includedir();
    }
}


# where apr-config and apu-config reside
sub apr_bindir {
    my ($self) = @_;

    $self->apr_config_path unless $self->{apr_bindir};
    $self->{apr_bindir};
}

sub apr_generation {
    my ($self) = @_;
    return $self->httpd_version_as_int =~ m/2[1-9]\d+/ ? 1 : 0;
}

# returns an array of apr/apu linking flags (--link-ld --libs) if found
# an empty array otherwise
my @apru_link_flags = ();
sub apru_link_flags {
    my ($self) = @_;

    return @apru_link_flags if @apru_link_flags;

    # first use apu_config_path and then apr_config_path in order to
    # resolve the symbols right during linking
    for ($self->apu_config_path, $self->apr_config_path) {
        if (my $link = $_ && -x $_ && qx{$_ --link-ld --libs}) {
            chomp $link;

            # Change '/path/to/libanything.la' to '-L/path/to -lanything'
            if (CYGWIN) {
                $link =~ s|(\S*)/lib([^.\s]+)\.\S+|-L$1 -l$2|g;
            }

            if ($self->httpd_is_source_tree) {
                my @libs;
                while ($link =~ m/-L(\S+)/g) {
                    my $dir = File::Spec->catfile($1, '.libs');
                    push @libs, $dir if -d $dir;
                }
                push @apru_link_flags, join ' ', map { "-L$_" } @libs;
            }
            push @apru_link_flags, $link;
        }