view release on metacpan or  search on metacpan

infra/h2ph  view on Meta::CPAN

}


# Handle recursive subdirectories without getting a grotesquely big stack.
# Could this be implemented using File::Find?
sub next_file
{
    my $file;

    while (@ARGV) {
        $file = shift @ARGV;

        if ($file eq '-' or -f $file or -l $file) {
            return $file;
        } elsif (-d $file) {
            if ($opt_r) {
                expand_glob($file);
            } else {
                print STDERR "Skipping directory `$file'\n";
            }
        } elsif ($opt_a) {
            return $file;
        } else {
            print STDERR "Skipping `$file':  not a file or directory\n";
        }
    }

    return undef;
}


# Put all the files in $directory into @ARGV for processing.
sub expand_glob
{
    my ($directory)  = @_;

    $directory =~ s:/$::;

    opendir DIR, $directory;
        foreach (readdir DIR) {
            next if ($_ eq '.' or $_ eq '..');

            # expand_glob() is going to be called until $ARGV[0] isn't a
            # directory; so push directories, and unshift everything else.
            if (-d "$directory/$_") { push    @ARGV, "$directory/$_" }
            else                    { unshift @ARGV, "$directory/$_" }
        }
    closedir DIR;
}


# Given $file, a symbolic link to a directory in the C include directory,
# make an equivalent symbolic link in $Dest_dir, if we can figure out how.
# Otherwise, just duplicate the file or directory.
sub link_if_possible
{
    my ($dirlink)  = @_;
    my $target  = eval 'readlink($dirlink)';

    if ($target =~ m:^\.\./: or $target =~ m:^/:) {
        # The target of a parent or absolute link could leave the $Dest_dir
        # hierarchy, so let's put all of the contents of $dirlink (actually,
        # the contents of $target) into @ARGV; as a side effect down the
        # line, $dirlink will get created as an _actual_ directory.
        expand_glob($dirlink);
    } else {
        if (-l "$Dest_dir/$dirlink") {
            unlink "$Dest_dir/$dirlink" or
                print STDERR "Could not remove link $Dest_dir/$dirlink:  $!\n";
        }

        if (eval 'symlink($target, "$Dest_dir/$dirlink")') {
            print "Linking $target -> $Dest_dir/$dirlink\n";

            # Make sure that the link _links_ to something:
            if (! -e "$Dest_dir/$target") {
                mkpath("$Dest_dir/$target", 0755) or
                    print STDERR "Could not create $Dest_dir/$target/\n";
            }
        } else {
            print STDERR "Could not symlink $target -> $Dest_dir/$dirlink:  $!\n";
        }
    }
}


# Push all #included files in $file onto our stack, except for STDIN
# and files we've already processed.
sub queue_includes_from
{
    my ($file)    = @_;
    my $line;

    return if ($file eq "-");

    open HEADER, $file or return;
        while (defined($line = <HEADER>)) {
            while (/\\$/) { # Handle continuation lines
                chop $line;
                $line .= <HEADER>;
            }

            if ($line =~ /^#\s*include\s+<(.*?)>/) {
                push(@ARGV, $1) unless $Is_converted{$1};
            }
        }
    close HEADER;
}


# Determine include directories; $Config{usrinc} should be enough for (all
# non-GCC?) C compilers, but gcc uses an additional include directory.
sub inc_dirs
{
    my $from_gcc    = `$Config{cc} -v 2>&1`;
    $from_gcc       =~ s:^Reading specs from (.*?)/specs\b.*:$1/include:s;

    length($from_gcc) ? ($from_gcc, $Config{usrinc}) : ($Config{usrinc});
}