1#! perl -w
2
3use strict ;
4use ExtUtils::MakeMaker 5.16 ;
5use Config ;
6
7die "DB_File needs Perl 5.8.3 or better. This is $]\n"
8    if $] < 5.008003;
9
10my $VER_INFO ;
11my $LIB_DIR ;
12my $INC_DIR ;
13my $DB_NAME ;
14my $LIBS ;
15my $COMPAT185 = "" ;
16
17ParseCONFIG() ;
18
19my @files = ('DB_File.pm', glob "t/*.t") ;
20UpDowngrade(@files);
21
22if (defined $DB_NAME)
23  { $LIBS = $DB_NAME }
24else {
25    if ($^O eq 'MSWin32')
26      { $LIBS = $Config{cc} =~ /gcc/ ? '-ldb' : '-llibdb' }
27    else
28      { $LIBS = '-ldb' }
29}
30
31# Solaris is special.
32#$LIBS .= " -lthread" if $^O eq 'solaris' ;
33
34# AIX is special.
35$LIBS .= " -lpthread" if $^O eq 'aix' ;
36
37# OS2 is a special case, so check for it now.
38my $OS2 = "" ;
39$OS2 = "-DOS2" if $Config{'osname'} eq 'os2' ;
40
41my $WALL = '' ;
42#$WALL = ' -Wall ';
43
44# Only want ppport.h t to be used by DB_File.xs when not
45# building this module with the perl source distribution.
46my $CORE = $ENV{PERL_CORE} ? '' : '-D_NOT_CORE';
47
48WriteMakefile(
49        NAME            => 'DB_File',
50        LIBS            => ["-L${LIB_DIR} $LIBS"],
51        INC             => "-I$INC_DIR",
52        VERSION_FROM    => 'DB_File.pm',
53        XS_VERSION      => eval MM->parse_version('DB_File.pm'),
54        XSPROTOARG      => '-noprototypes',
55        DEFINE          => "$CORE $OS2 $VER_INFO $COMPAT185 $WALL",
56        OBJECT          => 'version$(OBJ_EXT) DB_File$(OBJ_EXT)',
57    ((ExtUtils::MakeMaker->VERSION() gt '6.30')
58        ?  ('LICENSE'  => 'perl')
59        : ()
60    ),
61    (
62    $] >= 5.005
63        ? (ABSTRACT_FROM => 'DB_File.pm',
64            AUTHOR       => 'Paul Marquess <pmqs@cpan.org>')
65        : ()
66    ),
67
68    ($] < 5.008 || $] > 5.011)
69        ? (INSTALLDIRS => 'site')
70        : (INSTALLDIRS => 'perl'),
71
72        #OPTIMIZE       => '-g',
73        'depend'        => { 'Makefile'          => 'config.in',
74                             'version$(OBJ_EXT)' => 'version.c'},
75        'clean'         => { FILES => 'constants.h constants.xs *.bak t/*.t.bak' },
76        'macro'         => { my_files => "@files" },
77        'dist'          => { COMPRESS => 'gzip', SUFFIX => 'gz',
78                             DIST_DEFAULT => 'MyDoubleCheck tardist'},
79
80     ( eval { ExtUtils::MakeMaker->VERSION(6.46) }
81        ? ( META_MERGE  => {
82
83                "meta-spec" => { version => 2 },
84
85                resources   => {
86
87                    bugtracker  => {
88                        web     => 'https://github.com/pmqs/DB_File/issues'
89                    },
90
91                    homepage    => 'https://github.com/pmqs/DB_File',
92
93                    repository  => {
94                        type    => 'git',
95                        url     => 'git://github.com/pmqs/DB_File.git',
96                        web     => 'https://github.com/pmqs/DB_File',
97                    },
98                },
99            }
100            )
101        : ()
102    ),
103
104
105        );
106
107
108my @names = qw(
109        BTREEMAGIC
110        BTREEVERSION
111        DB_LOCK
112        DB_SHMEM
113        DB_TXN
114        HASHMAGIC
115        HASHVERSION
116        MAX_PAGE_NUMBER
117        MAX_PAGE_OFFSET
118        MAX_REC_NUMBER
119        RET_ERROR
120        RET_SPECIAL
121        RET_SUCCESS
122        R_CURSOR
123        R_DUP
124        R_FIRST
125        R_FIXEDLEN
126        R_IAFTER
127        R_IBEFORE
128        R_LAST
129        R_NEXT
130        R_NOKEY
131        R_NOOVERWRITE
132        R_PREV
133        R_RECNOSYNC
134        R_SETCURSOR
135        R_SNAPSHOT
136        __R_UNUSED
137        );
138
139if (eval {require ExtUtils::Constant; 1}) {
140    # Check the constants above all appear in @EXPORT in DB_File.pm
141    my %names = map { $_, 1} @names;
142    open F, "<DB_File.pm" or die "Cannot open DB_File.pm: $!\n";
143    while (<F>)
144    {
145        last if /^\s*\@EXPORT\s+=\s+qw\(/ ;
146    }
147
148    while (<F>)
149    {
150        last if /^\s*\)/ ;
151        /(\S+)/ ;
152        delete $names{$1} if defined $1 ;
153    }
154    close F ;
155
156    if ( keys %names )
157    {
158        my $missing = join ("\n\t", sort keys %names) ;
159        die "The following names are missing from \@EXPORT in DB_File.pm\n" .
160            "\t$missing\n" ;
161    }
162
163
164    ExtUtils::Constant::WriteConstants(
165                                     NAME => 'DB_File',
166                                     NAMES => \@names,
167                                     C_FILE  => 'constants.h',
168                                     XS_FILE  => 'constants.xs',
169
170                                    );
171}
172else {
173    use File::Copy;
174    copy ('fallback.h', 'constants.h')
175      or die "Can't copy fallback.h to constants.h: $!";
176    copy ('fallback.xs', 'constants.xs')
177      or die "Can't copy fallback.xs to constants.xs: $!";
178}
179
180exit;
181
182
183sub MY::libscan
184{
185    my $self = shift ;
186    my $path = shift ;
187
188    return undef
189        if $path =~ /(~|\.bak)$/ ||
190           $path =~ /^\..*\.swp$/ ;
191
192    return $path;
193}
194
195
196sub MY::postamble { <<'EOM' } ;
197
198MyDoubleCheck:
199	@echo Checking config.in is setup for a release
200	@(grep "^LIB.*/usr/local/BerkeleyDB" config.in &&       \
201	grep "^INCLUDE.*/usr/local/BerkeleyDB" config.in &&     \
202	grep "^#DBNAME.*" config.in) >/dev/null ||              \
203	    (echo config.in needs fixing ; exit 1)
204	@echo config.in is ok
205	@echo
206	@echo Checking DB_File.xs is ok for a release.
207	@(perl -ne ' exit 1 if /^\s*#\s*define\s+TRACE/ ; ' DB_File.xs || \
208	    (echo DB_File.xs needs fixing ; exit 1))
209	@echo DB_File.xs is ok
210	@echo
211	@echo Checking for $$^W in files: $(my_files)
212	@perl -ne '                                             \
213	    exit 1 if /^\s*local\s*\(\s*\$$\^W\s*\)/;' $(my_files) ||   \
214	    (echo found unexpected $$^W ; exit 1)
215	@echo No $$^W found.
216	@echo
217	@echo Checking for 'use vars' in files: $(my_files)
218	@perl -ne '                                             \
219	    exit 0 if /^__(DATA|END)__/;                \
220	    exit 1 if /^\s*use\s+vars/;' $(my_files) || \
221	    (echo found unexpected "use vars"; exit 1)
222	@echo No 'use vars' found.
223	@echo
224	@echo All files are OK for a release.
225	@echo
226
227EOM
228
229
230
231sub ParseCONFIG
232{
233    my ($k, $v) ;
234    my @badkey = () ;
235    my %Info = () ;
236    my @Options = qw( INCLUDE LIB PREFIX HASH DBNAME COMPAT185 ) ;
237    my %ValidOption = map {$_, 1} @Options ;
238    my %Parsed = %ValidOption ;
239    my $CONFIG = 'config.in' ;
240
241    print "Parsing $CONFIG...\n" ;
242
243    # DBNAME & COMPAT185 are optional, so pretend they  have
244    # been parsed.
245    delete $Parsed{'DBNAME'} ;
246    delete $Parsed{'COMPAT185'} ;
247    $Info{COMPAT185} = "No" ;
248
249
250    open(F, "$CONFIG") or die "Cannot open file $CONFIG: $!\n" ;
251    while (<F>) {
252        s/^\s*|\s*$//g ;
253        next if /^\s*$/ or /^\s*#/ ;
254        s/\s*#\s*$// ;
255
256        ($k, $v) = split(/\s+=\s+/, $_, 2) ;
257        $k = uc $k ;
258        if ($ValidOption{$k}) {
259            delete $Parsed{$k} ;
260            $Info{$k} = $v ;
261        }
262        else {
263            push(@badkey, $k) ;
264        }
265    }
266    close F ;
267
268    print "Unknown keys in $CONFIG ignored [@badkey]\n"
269        if @badkey ;
270
271    # check parsed values
272    my @missing = () ;
273    die "The following keys are missing from $CONFIG file: [@missing]\n"
274        if @missing = keys %Parsed ;
275
276    $INC_DIR = $ENV{'DB_FILE_INCLUDE'} || $Info{'INCLUDE'} ;
277    $LIB_DIR = $ENV{'DB_FILE_LIB'} || $Info{'LIB'} ;
278    $DB_NAME = $ENV{'DB_FILE_NAME'} || $Info{'DBNAME'} ;
279    $COMPAT185 = "-DCOMPAT185 -DDB_LIBRARY_COMPATIBILITY_API"
280        if (defined $ENV{'DB_FILE_COMPAT185'} &&
281                $ENV{'DB_FILE_COMPAT185'} =~ /^\s*(on|true|1)\s*$/i) ||
282                $Info{'COMPAT185'} =~ /^\s*(on|true|1)\s*$/i ;
283    my $PREFIX  = $Info{'PREFIX'} ;
284    my $HASH    = $Info{'HASH'} ;
285
286    $VER_INFO = "-DmDB_Prefix_t=${PREFIX} -DmDB_Hash_t=${HASH}" ;
287
288    print <<EOM if 0 ;
289    INCLUDE     [$INC_DIR]
290    LIB         [$LIB_DIR]
291    HASH        [$HASH]
292    PREFIX      [$PREFIX]
293    DBNAME      [$DB_NAME]
294
295EOM
296
297    print "Looks Good.\n" ;
298
299}
300
301sub UpDowngrade
302{
303    my @files = @_ ;
304
305    # our      is stable from 5.6.0 onward
306    # warnings is stable from 5.6.1 onward
307
308    # Note: this code assumes that each statement it modifies is not
309    #       split across multiple lines.
310
311
312    my $warn_sub ;
313    my $our_sub ;
314
315    if ($] < 5.006001) {
316        # From: use|no warnings "blah"
317        # To:   local ($^W) = 1; # use|no warnings "blah"
318        #
319        # and
320        #
321        # From: warnings::warnif(x,y);
322        # To:   $^W && carp(y); # warnif -- x
323        $warn_sub = sub {
324            s/^(\s*)(no\s+warnings)/${1}local (\$^W) = 0; #$2/ ;
325            s/^(\s*)(use\s+warnings)/${1}local (\$^W) = 1; #$2/ ;
326
327            s/^(\s*)warnings::warnif\s*\((.*?)\s*,\s*(.*?)\)\s*;/${1}\$^W && carp($3); # warnif - $2/ ;
328          };
329    }
330    else {
331        # From: local ($^W) = 1; # use|no warnings "blah"
332        # To:   use|no warnings "blah"
333        #
334        # and
335        #
336        # From: $^W && carp(y); # warnif -- x
337        # To:   warnings::warnif(x,y);
338        $warn_sub = sub {
339            s/^(\s*)local\s*\(\$\^W\)\s*=\s*\d+\s*;\s*#\s*((no|use)\s+warnings.*)/$1$2/ ;
340            s/^(\s*)\$\^W\s+\&\&\s*carp\s*\((.*?)\)\s*;\s*#\s*warnif\s*-\s*(.*)/${1}warnings::warnif($3, $2);/ ;
341          };
342    }
343
344    if ($] < 5.006000) {
345        $our_sub = sub {
346            if ( /^(\s*)our\s+\(\s*([^)]+\s*)\)/ ) {
347                my $indent = $1;
348                my $vars = join ' ', split /\s*,\s*/, $2;
349                $_ = "${indent}use vars qw($vars);\n";
350            }
351          };
352    }
353    else {
354        $our_sub = sub {
355            if ( /^(\s*)use\s+vars\s+qw\((.*?)\)/ ) {
356                my $indent = $1;
357                my $vars = join ', ', split ' ', $2;
358                $_ = "${indent}our ($vars);\n";
359            }
360          };
361    }
362
363    foreach (@files)
364      { doUpDown($our_sub, $warn_sub, $_) }
365}
366
367
368sub doUpDown
369{
370    my $our_sub = shift;
371    my $warn_sub = shift;
372
373    local ($^I) = ".bak" ;
374    local (@ARGV) = shift;
375
376    while (<>)
377    {
378        print, last if /^__(END|DATA)__/ ;
379
380        &{ $our_sub }();
381        &{ $warn_sub }();
382        print ;
383    }
384
385    return if eof ;
386
387    while (<>)
388      { print }
389}
390
391# end of file Makefile.PL
392