view release on metacpan or  search on metacpan

DynaGlue.pm  view on Meta::CPAN

package ExtUtils::DynaGlue;

use strict;
use vars qw($VERSION @xs_sections @pm_sections);

use IO::File ();
use Config;

#$Id: DynaGlue.pm,v 1.10 1996/11/27 19:31:16 dougm Exp $
$VERSION = (qw$Revision: 1.10 $)[1] . "a";

sub new {
    my $class = shift;
    my $self = bless {
	TEMPLATE_VERSION => '0.01',
	EXT => (-d 'ext' ? 'ext/' : '') ,
	AUTHOR => _author(),
	EMAIL => _email(),
	PREFIX => undef,
	CONST_XSUBS => undef,
	CONST_XSUBS_HASH => {},
	CONST_NAMES => [],
	PREFIX_NAMES => {},
	XS_SECTIONS => [],
	PM_SECTIONS => [],
	NAME => "",
	FULLPATH => undef,
	FLAGS => undef,
	PATH_H => undef,
	SCAN => {
	},
	DO_SCAN => 0,
	@_,
    } => $class;

    $self->path_h($self->{PATH_H}, $self->{DO_SCAN})
	if $self->{PATH_H};
    $self->name($self->{NAME} || $self->{PATH_H});
    $self->module($self->name);
    $self->modparts($self->name);
    $self;
}

sub _author {
    my $name = (getpwuid($>))[6] || $ENV{NAME} || "A. U. Thor";
    $name =~ s/,.*//;
    while($name =~ s/\([^\(]*\)//) { 1; } 
    $name;
}

{
    no strict;
    eval { use Mail::Util qw(mailaddress); };
    *mailaddress = sub {'a.u.thor@a.galaxy.far.far.away'} if $@;
}

sub _email {
    return mailaddress();
}

sub author { shift->_elem('AUTHOR', @_) }
sub email  { shift->_elem('EMAIL', @_) }
sub do_scan { shift->_elem('DO_SCAN', @_) }
sub no_xs { shift->_elem('NO_XS', @_) }
sub no_const { shift->_elem('NO_CONST', @_) }
sub no_auto { shift->_elem('NO_AUTO', @_) }
sub no_pod { shift->_elem('NO_POD', @_) }
sub module { shift->_elem('MODULE', @_) }
sub prefix { shift->_elem('PREFIX', @_) }
sub modfname { shift->_elem('modfname', @_) }
sub fullpath { shift->_elem('FULLPATH', @_) }
sub flags { shift->_elem('FLAGS', @_) }
sub extralibs { shift->_elem('EXTRALIBS', @_) }
sub ext { shift->_elem('EXT', @_) }
sub template_version { shift->_elem('TEMPLATE_VERSION', $_[0] || '0.01') }

sub const_xsubs {
    my $self = shift;
    my $subs = $_[0] || $self->{CONST_XSUBS};
    if($subs) {
	unless(ref $subs) {
	    $subs = [split /,+/, $subs];
	}
	$self->{CONST_XSUBS_HASH} = { map {$_,1} @$subs };
    }
    $self->{CONST_XSUBS_HASH};
}

sub path_h {
    my $self = shift;
    my($path_h, $do_scan) = @_;
    $do_scan ||= $self->{DO_SCAN};
    my(@idx) = ('PATH_H');
    push @idx, 'FULLPATH' if wantarray;
    return (@{$self}{@idx}) unless $path_h;
    $path_h .= ".h" unless $path_h =~ /\.h$/;

    my $fullpath = $path_h;
    $path_h =~ s/,.*$// if $do_scan;
    if ($^O eq 'VMS') {  # Consider overrides of default location
	if ($path_h !~ m![:>\[]!) {
	    my($hadsys) = ($path_h =~ s!^sys/!!i);
	    if ($ENV{'DECC$System_Include'})     { $path_h = "DECC\$System_Include:$path_h";    }
	    elsif ($ENV{'DECC$Library_Include'}) { $path_h = "DECC\$Library_Include:$path_h";   }
	    elsif ($ENV{'GNU_CC_Include'})       { $path_h = 'GNU_CC_Include:' .