# Copyright (c) 1995-1999 Nick Ing-Simmons. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
$VERSION = '3.050'; # $Id: //depot/Tk8/Tk/MMutil.pm#50 $
use Tk::Config qw(!$VERSION);
*IsWin32 = \$main::IsWin32;
$IsWin32 = ($^O eq 'MSWin32' || $Config{'ccflags'} =~ /-D_?WIN32_?/)
@MYEXPORT = qw(perldepend cflags const_config constants installbin c_o xs_o makefile manifypods);
delete $hash->{$_} if /Win[A-Z0-9]/ or /OS2/ or /ImgUtil/ or /^x/;
elsif ($win_arch eq 'open32')
delete $hash->{$_} if /Unix|Mwm/ and not /tclUnix/;
delete $hash->{$_} if /winMain|dllMain/;
elsif ($win_arch eq 'pm')
/tclUnix|Unix(3d|Button|Dialog|Color|Embed|Focus|Font|Menu|Scrlbr|Send|Int\.|Scale)/;
delete $hash->{$_} if /os2Main|dllMain|tkOS2Dll|^x(colors\.c|gc\.)/;
delete $hash->{$_} if /ImgUtil|tkWin[A-Z0-9]/ and not /OS2/;
elsif ($win_arch eq 'MSWin32')
delete $hash->{$_} if /Mwm/ and not /tclUnix/;
delete $hash->{$_} if /winMain|dllMain/;
# delete $hash->{$_} if /^Xrm/;
my $dep = "config :: \$(C_FILES) \$(H_FILES)\n\t$self->{NOECHO}\$(NOOP)\n";
my $mTk = $self->{'MTK'};
$dep .= "# Begin Munging dependancies\n";
foreach my $file (sort keys %$mTk)
$dep .= "$file : ".$mTk->{$file}." \$(TKDIR)/pTk/Tcl-pTk\n";
$dep .= "\t\$(PERL) \$(TKDIR)/pTk/Tcl-pTk ".$mTk->{$file}." $file\n";
$dep .= "# End Munging dependancies\n\n";
foreach (@
{$self->{H
}}) { $h{$_} = 1 }
foreach (@
{$self->{C
}}) { $c{$_} = 1 }
carp
("No $name") unless (exists $c{$name});
$self->{'H'} = [sort keys %h];
$self->{'C'} = [sort keys %c];
my(@o_files) = @
{$self->{C
}};
$self->{O_FILES
} = [grep s/\.c(pp|xx|c)?$/$self->{OBJ_EXT}/i, @o_files] ;
my $perl = $self->{'PERL'};
if ($IsWin32 && !-f
$perl && -f
"$perl.exe")
print "perl=$perl X=$^X\n";
foreach my $file (sort keys %$mTk)
warn "Extracting $file\n";
system($perl,"$tk/pTk/Tcl-pTk",$mTk->{$file},$file);
my $here = getcwd
() || die "Cannot get current directory:$!";
chdir($here) || die "Cannot cd back to $here:$!";
$dir = (-d
$path) ?
$path : dirname
($path);
if (defined $dir and -d
$dir)
if ($path =~ m
#^\Q$dir\E([/\\]?.*)$#)
if ($here =~ m
#^\Q$dir\E([/\\]?.*)#)
$depth =~ s
,[^/\\]+,..,g
;
$depth .= "/$base" if ($base);
# print "$path is $depth from $here\n";
warn "Cannot find $depth\n";
unless(exists $visited{$here})
warn "$here does not start with $dir\n";
warn "i.e. building outside Tk itself\n";
die "'$path' not under '$dir'\n";
die "Cannot get directory for $path\n";
die 'upgrade_pic is obsolete';
my $str = $self->MM::perldepend
;
foreach my $file (@
{$self->{'C'}})
foreach my $file (keys %{$self->{'XS'}})
delete $c{$self->{'XS'}{$file}};
my @files = grep(-f
$_,sort(keys %c));
my @inc = split(/\s+/,$self->{'INC'});
my @def = split(/\s+/,$self->{'DEFINE'});
push(@def,qw(-DWIN32 -D__WIN32__)) if ($IsWin32);
push(@def,qw(-D__CYGWIN__));
if ($win_arch eq 'MSWin32')
push(@def,qw(-D__WIN32__)) unless $self->{'DEFINE'} =~ /-D__WIN32__/;
push(@def,qw(-DWIN32)) if $self->{'NAME'} eq 'Tk::pTk';
$str .= Tk
::MakeDepend
::command_line
(@inc,@def,@files) unless ($ENV{'TKNOMAKEDEPEND'});
foreach $name (grep /(%|\.(old|bak|q4|orig|rej))$/,keys %{$self->{PM
}})
delete $self->{PM
}->{$name};
my $flags = $self->{'CCCDLFLAGS'};
$flags =~ s/(-[fK]?\s*)pic\b/${1}PIC/;
$self->{'CCCDLFLAGS'} = $flags;
if ($^O
eq 'MSWin32' && $Config{'ccflags'} =~ /-DPERL_OBJECT/)
$self->{'LDFLAGS'} =~ s/-(debug|pdb:\w+)\s+//g;
$self->{'LDDLFLAGS'} =~ s/-(debug|pdb:\w+)\s+//g;
elsif ($^O
=~ /(openbsd)/i)
# -Bforcearchive is bad news for Tk - we don't want all of libpTk.a in all .so-s.
$self->{'LDDLFLAGS'} =~ s/-Bforcearchive\s*//g;
return $self->MM::const_config
;
local $_ = $self->MM::constants
;
$_ .= "\nGCCOPT = $Tk::Config::gccopt\n";
local $_ = $self->MM::cflags
;
if ($Config::Config
{cc
} =~ /^bcc/i) {
s/(CCFLAGS\s*=)/$1 \$(cflags) \$(cvarsdll)/;
s/(OPTIMIZE\s*=).*/$1 \$(cdebug)/;
local $_ = $self->MM::c_o
;
s/\$\(DEFINE\)/\$(DEFINE) \$(GCCOPT)/g;
local $_ = $self->MM::xs_o
;
s/\$\(DEFINE\)/\$(DEFINE) \$(GCCOPT)/g;
# Maybe always call UNIX version - we HTMLize them later
local $_ = $self->MM::manifypods
;
s/(POD2MAN_EXE.*pod2man)/$1 --center "perl\/Tk Documentation
" --release "Tk\
$(VERSION
)"/;
s/(POD2MAN_EXE.*pod2man)/$1 -center "perl\/Tk Documentation" -release
"Tk\$(VERSION)"/;
s/(POD2MAN_EXE.*pod2man)/$1 -center \\"perl\/Tk Documentation
\\" -release \\"Tk\
$(VERSION
)\\"/;
return $try if (-f $try);
die "Cannot find
$file in \
@INC\n";
my $str = $self->MM::makefile;
my $mm = findINC('Tk/MMutil.pm');
my $cf = findINC('Tk/Config.pm');
$str =~ s/(\$\(CONFIGDEP\))/$1 $cf $mm/;
$str =~ s/\$\(OBJECT\)\s*:.*\n//;
$tk = relpath($try,$dir);
die "Cannot find perl
/Tk include files
\n" unless (defined $tk);
my $str = $self->MM::installbin;
my $prog = 'perl'; # $self->{'MAP_TARGET'} || 'perl';
my $inc = findINC('Tk/MMutil.pm');
$inc =~ s,/Tk/MMutil.pm$,,;
$str =~ s/^\tcp\s/\t\$(PERL) -I$inc -MTk::install -e installbin $prog /mg;
foreach $dir (map(abspath($_),@_),@INC)
if (-d $try && (-f "$try/Lang.h" || -f "$try/libpTk\
$(LIB_EXT
)"))
$ptk = relpath($try,$dir);
confess "Cannot locate pTk
\n" unless (defined $ptk);
opendir(DIR,'.') || die "Cannot
opendir:$!";
foreach my $dir (readdir(DIR))
next if $dir =~ /^\.\.?$/;
if (-f "$dir/Makefile
.PL
")
my $exc = ($win_arch eq 'x') ? 'Unix' : 'Win';
if (-f "$dir/Not
${exc
}.exc
")
warn "Skip
$dir on
$win_arch\n"
if ($Config{'ccflags'} =~ /-DPERL_OBJECT/)
$att{'CAPI'} = 'TRUE' unless exists $att{'CAPI'};
unless (exists $att{'DIR'})
$att{'DIR'} = [sort(keys %$dir)];
unless (exists $att{'NAME'})
my ($pack) = $dir =~ m#/([^/]+)$#;
$att{NAME} = 'Tk::'.$pack;
warn "No Name
and cannot deduce from
'$dir'";
$att{'macro'} = {} unless (exists $att{'macro'});
$att{'macro'}{'TKDIR'} = $tk;
my @opt = ('VERSION' => $Tk::Config::VERSION,
'XS_VERSION' => $Tk::Config::VERSION);
push(@opt,'clean' => {} ) unless (exists $att{'clean'});
$att{'clean'}->{FILES} = '' unless (exists $att{'clean'}->{FILES});
$att{'clean'}->{FILES} .= ' *.bak';
unless (exists($att{'linkext'}) && $att{linkext}{LINKTYPE} eq '')
my @tm = (findINC('Tk/typemap'));
unshift(@tm,@{$att{'TYPEMAPS'}}) if (exists $att{'TYPEMAPS'});
my $i = delete ($att{'INC'});
$i = (defined $i) ? "$i $inc" : $inc;
if (delete $att{'dynamic_ptk'})
'MYEXTLIB' => "$ptk/libpTk\
$(LIB_EXT
)",
# 'dynamic_lib' => { INST_DYNAMIC_DEP => "$ptk/libpTk\
$(LIB_EXT
)" }
if ($IsWin32 && $Config{'cc'} =~ /^bcc/)
# Borland compiler is very dumb at finding files
if ($IsWin32 && $Config{'cc'} =~ /^gcc/i)
my $base = $Config{'libpth'};
$base =~ s#lib$#i386-mingw32/lib#;
my $extra = "-L
$base -lcomdlg32
-lgdi32
";
my $libs = $att{'LIBS'}->[0];
$att{'LIBS'}->[0] = "$extra $libs";
# NOTE: use gcc -shared instead of dllwrap (ld2),
# dllwrap tries to resolve all symbols, even those
# that are brought in from libraries like libpTk.a
push(@opt,'LD' => 'gcc -shared');
if ($win_arch eq 'MSWin32')
my $extra = "-lcomdlg32
-lgdi32
";
my $libs = $att{'LIBS'}->[0];
$att{'LIBS'}->[0] = "$extra $libs";
$att{'DEFINE'} .= ' -D__WIN32__';
$att{'DEFINE'} .= ' -DWIN32' if($att{'NAME'} eq 'Tk::pTk');
$att{'DEFINE'} .= ' -U_WIN32';
if (delete $att{'ptk_include'})
$i = "-I
$ptk $i" unless ($ptk eq '.');
$i = "-I
$tk $i" unless ($tk eq '.');
push(@opt,'DEFINE' => $define, 'INC' => $i);
WriteMakefile(@opt, %att);
my @list = (@_) ? @_ : @{"${class}::MYEXPORT
"};
*{"MY
::$name"} = \&{"$name"};