#!/usr/bin/perl -w
# $Id: ncu-mapsyms,v 1.79 2015/07/11 19:32:48 tom Exp $
# -----------------------------------------------------------------------------
# Copyright 2014,2015 by Thomas E. Dickey
#
#                         All Rights Reserved
#
# Permission is hereby granted, free of charge, to any person obtaining a
# copy of this software and associated documentation files (the
# "Software"), to deal in the Software without restriction, including
# without limitation the rights to use, copy, modify, merge, publish,
# distribute, sublicense, and/or sell copies of the Software, and to
# permit persons to whom the Software is furnished to do so, subject to
# the following conditions:
#
# The above copyright notice and this permission notice shall be included
# in all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
# OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
# IN NO EVENT SHALL THE ABOVE LISTED COPYRIGHT HOLDER(S) BE LIABLE FOR ANY
# CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
# TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
# SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
#
# Except as contained in this notice, the name(s) of the above copyright
# holders shall not be used in advertising or otherwise to promote the
# sale, use or other dealings in this Software without prior written
# authorization.
# -----------------------------------------------------------------------------
# Using "needed-symbols", construct ".map" and ".sym" files for the current
# build-tree's configuration of ncurses.
#
# The ".sym" files are trivial - a comment header telling what options were
# used to generate the configuration, and a sorted list of symbols.
#
# The ".map" files require special effort, because they are constructed as
# a series of version-nodes.  So... to generate a new one requires us to
# read the existing ".map" file to relate the symbols' version and scope to
# the previous version.
#
# To allow for symbols being in termlib/ticlib/ncurses, always generate the
# names as if they were in the separate library.  Doing this allows splitting
# the map-file into parts and (possibly) making it work with Solaris, which
# does not accept a map-file declaring a symbol not in the library.
# -----------------------------------------------------------------------------
# TODO: implement -r option to remove "local: _*"
# TODO: generalize a little, to reuse with dialog and cdk

use strict;

$| = 1;

use File::Basename;
use Getopt::Std;
use Cwd;

our $program = basename($0);

our ( $opt_d, $opt_m, $opt_p, $opt_r, $opt_s, $opt_t, $opt_v );

our $PROGRAM_ALIAS = "?";
our $PROGRAM_MAJOR = "?";
our $PROGRAM_MINOR = "?";
our $PROGRAM_PATCH = "?";

our %tack_symbols = qw(
  _nc_copy_termtype	tinfo
  _nc_fallback		tinfo
  _nc_find_entry	tinfo
  _nc_find_type_entry   tinfo
  _nc_free_termtype	tinfo
  _nc_free_tic		tic
  _nc_freeall        	tinfo
  _nc_get_alias_table   tinfo
  _nc_get_curterm	tinfo
  _nc_get_hash_table	tinfo
  _nc_get_table         tinfo
  _nc_get_tty_mode	tinfo
  _nc_init_acs		tinfo
  _nc_leaks_tinfo       tinfo
  _nc_read_entry	tinfo
  _nc_reset_input	tic
  _nc_strstr		tinfo
  _nc_tic_expand	tic
  _nc_trans_string	tic
);

our %deprecated_symbols = qw(
  _nc_Default_Field     6
  _nc_Default_Form      6
  _nc_has_mouse         6
);

our $this_lib;

sub open_file($) {
    my $path = shift;
    printf ".. open %s\n", $path if ( $opt_m or $opt_v );
    open FP, "$path" || die "cannot open $path";
}

sub input_file($) {
    my $suffix = shift;
    return sprintf "package/%s%s", $this_lib, $suffix;
}

sub backup_file($) {
    my $suffix = shift;
    my $path   = &output_file($suffix);
    if ($opt_m) {
        if ( -f $path ) {
            for my $n ( 0 .. 99 ) {
                my $test = sprintf "package/%s-%d-%s%s", $PROGRAM_PATCH, $n,
                  $this_lib, $suffix;
                if ( !-f $test ) {
                    system "cp -vf $path $test";
                    last;
                }
            }
        }
    }
}

sub output_file($) {
    my $suffix = shift;
    return sprintf "package/%s-%s%s", $PROGRAM_PATCH, $this_lib, $suffix;
}

sub no_version() {
    die "cannot determine version";
}

# determine the version of ncurses which is built.
sub read_version() {
    my @data;
    if ( -f "dist.mk" and &open_file("dist.mk") ) {
        (@data) = <FP>;
        close FP;
        for my $n ( 0 .. $#data ) {
            chomp( $data[$n] );
            next unless ( $data[$n] =~ /^[[:alnum:]_]+\s*=\s*\d+/ );
            my $name = $data[$n];
            $name =~ s/\s*=.*//;
            my $value = $data[$n];
            $value =~ s/^[^=]+=\s*//;
            $value =~ s/\s.*//;
            $PROGRAM_ALIAS = "ncurses";
            $PROGRAM_MAJOR = $value if ( $name eq "NCURSES_MAJOR" );
            $PROGRAM_MINOR = $value if ( $name eq "NCURSES_MINOR" );
            $PROGRAM_PATCH = $value if ( $name eq "NCURSES_PATCH" );
        }
    }
    elsif ( -f "VERSION" and &open_file("VERSION") ) {
        (@data) = <FP>;
        close FP;

        # VERSION has 3 fields: libtool-version, major.minor, patch-date
        &no_version if ( $#data < 0 );
        my @fields = split /\s+/, $data[0];
        &no_version if ( $#fields != 2 );
        $PROGRAM_MAJOR = $fields[1];
        $PROGRAM_MAJOR =~ s/\..*//;
        $PROGRAM_MINOR = $fields[1];
        $PROGRAM_MINOR =~ s/^[^.]*\.//;
        $PROGRAM_PATCH = $fields[2];

        $PROGRAM_ALIAS = basename(getcwd);
        $PROGRAM_ALIAS =~ s/-.*//;
        $PROGRAM_ALIAS = "cdk"    if ( $PROGRAM_ALIAS =~ /cdk/ );
        $PROGRAM_ALIAS = "dialog" if ( $PROGRAM_ALIAS =~ /dialog/ );
    }
    else {
        &no_version;
    }
    printf "** %s %d.%d.%d\n", $PROGRAM_ALIAS, $PROGRAM_MAJOR, $PROGRAM_MINOR,
      $PROGRAM_PATCH;
}

# read the options used for building from config.status
sub read_config() {
    my %result;
    my @data;
    my $result;
    my $retry = 0;

    &open_file("./config.status --version|");
    @data = <FP>;

    for my $n ( 0 .. $#data ) {
        chomp( $data[$n] );
        if ( $data[$n] =~ /^\s+with\s+options\s+"/ ) {
            $result = $data[$n];
            $result =~ s/^[^"]*"//;
            $result =~ s/"[^"]*$//;
            $result =~ s/\s+'$/'/;
            $result =~ s/\s+--/\t--/g;
            $result =~ s/ '/\t'/;
            last;
        }
        elsif ( $data[$n] =~ /2\.13\./ ) {
            $retry = 1;
            last;
        }
    }
    if ( $retry == 1 ) {
        &open_file("./config.status");
        @data = <FP>;
        for my $n ( 0 .. $#data ) {
            chomp( $data[$n] );
            if ( $data[$n] =~ /^#\s+\.\/configure\s/ ) {
                $result = $data[$n];
                $result =~ s/^#\s+\.\/configure\s+//;
                $result =~ s/\s+$//;
                $result =~ s/\s+--/\t--/g;
                last;
            }
            elsif ( $data[$n] !~ /^#/ ) {
                last;
            }
        }
    }
    if ($result) {
        my @result = split /\t/, $result;
        my %options;
        for my $r ( 0 .. $#result ) {

            # filter out options which do not affect ABI
            next unless ( $result[$r] =~ /^--/ );
            next
              if ( $result[$r] =~
                /^--with(out)?-(ada|normal|debug|shared|libtool)$/ );
            next if ( $result[$r] =~ /^--.*-(echo|rpath|warnings)$/ );
            next if ( $result[$r] eq "--verbose" );

            # record the remaining options in a hash, so we can sort it
            printf "RECORD(%s) = %s\n", $result[$r], $r if ($opt_d);
            $options{ $result[$r] } = $r;
        }
        my $options;
        for my $r ( sort keys %options ) {
            $options .= " " if ($options);
            $options .= $r;
        }
        my $build = sprintf "# Configure options (%s.%s.%s)", $PROGRAM_MAJOR,
          $PROGRAM_MINOR, $PROGRAM_PATCH;
        my %build;
        $build{$options} = $options;
        $result{$build}  = \%build;
    }
    else {
        printf STDERR "cannot find configure options\n";
        exit 1;
    }
    return %result;
}

sub trim($) {
    my $value = shift;
    chomp($value);
    $value =~ s/^\s+//;
    $value =~ s/\s+$//;
    return $value;
}

# read configure options from an existing map/sym file
sub read_options($) {
    my $path = shift;
    my %data;
    my $skip = 0;

    &open_file("$path");
    my (@data) = <FP>;
    close FP;
    for my $n ( 0 .. $#data ) {
        my $item = &trim( $data[$n] );
        if ( $item !~ /^#/ ) {
            last;
        }
        elsif ( $item =~ /^# Configure options.*$/ ) {
            my %item;
            $skip = 0;
            for my $p ( $n + 1 .. $#data ) {
                last unless ( $data[$p] =~ /^#\t/ );
                my $value = &trim( $data[$p] );
                $value =~ s/^#\s//;
                $item{$value} = $value;
                ++$skip;
            }
            $data{$item} = \%item;
        }
        elsif ( $skip-- <= 0 ) {
            $data{$item} = "_" if ( $item =~ /^#\t/ );
        }
    }
    return %data;
}

sub all_keys($) {
    my %source = %{ $_[0] };
    my $result = "";
    foreach my $option ( sort keys %source ) {
        $result .= " " . $option;
    }
    return $result;
}

# add options read via read_config
sub add_config ($$) {
    my %target = %{ $_[0] };
    my %source = %{ $_[1] };
    printf "ADD_CONFIG\n" if ($opt_d);
    if (%source) {
        foreach my $build ( sort keys %source ) {
            printf "...build:%s\n", $build if ($opt_d);
            my %build = %{ $source{$build} };
            printf "...BUILD:%s\n", &all_keys( $source{$build} ) if ($opt_d);
            my %item;
            if ( $target{$build} ) {
                foreach my $options ( sort keys %build ) {
                    %item           = %{ $target{$build} };
                    $item{$options} = $options;
                    $target{$build} = \%item;
                }
            }
            else {
                foreach my $options ( sort keys %build ) {
                    $item{$options} = $options;
                    $target{$build} = \%item;
                }
            }
        }
    }
    return %target;
}

# print update configure-options for map/sym files
sub write_options($) {
    my %data = %{ $_[0] };
    foreach my $name ( sort keys %data ) {
        if ( ref( $data{$name} ) ) {
            my %item = %{ $data{$name} };
            printf FP "%s\n", $name;
            for my $opt ( sort keys %item ) {
                printf FP "#\t%s\n", $opt;
            }
        }
        else {
            printf FP "%s\n", $name;
        }
    }
}

sub count_hash($) {
    my %hash   = %{ $_[0] };
    my $result = 0;
    if (%hash) {
        my @keys = keys %hash;
        $result = $#keys + 1;
    }
    return $result;
}

# read symbols from the libraries and executables in the current build-tree.
sub read_symbols() {
    my %result;

    &open_file("needed-syms|");
    my (@data) = <FP>;
    close FP;
    for my $n ( 0 .. $#data ) {
        chomp( $data[$n] );
        $data[$n] =~ s/^\s*//;
        next if ( $data[$n] =~ /^_/ and $data[$n] !~ /^_(nc_|trace)/ );
        next if ( $data[$n] =~ /^#/ );
        next unless ( $data[$n] =~ /\s.*(global|local|glue):/ );

        my $name = $data[$n];
        $name =~ s/\s.*//;

        my $lib = $data[$n];
        $lib =~ s/^[^\s]+\s*//;

        my $scope = $lib;
        $scope =~ s/:.*//;
        $scope = "global" if ( $scope eq "glue" );
        $lib =~ s/^[^:]*:\s*//;

        my $notes = $lib;
        $notes =~ s/^\w+//;
        $notes =~ s/^,\s*//;
        $lib   =~ s/[,\s].*//;

        my %obj;
        $obj{LIB}      = &ncurses_t_lib($lib);
        $obj{DATE}     = $PROGRAM_PATCH;
        $obj{SCOPE}    = $scope;
        $obj{NOTES}    = $notes;
        $result{$name} = \%obj;
    }
    printf "...read %d symbols\n", &count_hash( \%result ) if ($opt_v);
    return %result;
}

sub ncurses_t_node($) {
    my $node = shift;
    if ($opt_t) {
        if ( $node !~ /^[[:upper:]]+T[W]?_/ ) {
            if ( $node =~ /^[[:upper:]]+W_/ ) {
                $node =~ s/W_/TW_/;
            }
            else {
                $node =~ s/_/T_/;
            }
        }
    }
    return $node;
}

sub ncurses_t_lib($) {
    my $lib = shift;
    if ($opt_t) {
        if ( $lib !~ /^[[:lower:]]+t[w]?$/ ) {
            if ( $lib =~ /^[[:lower:]]+w$/ ) {
                $lib =~ s/w$/tw/;
            }
            else {
                $lib =~ s/$/t/;
            }
        }
    }
    return $lib;
}

# read the ".map" file corresponding to the current build configuration.
sub read_map_file() {
    my %result;

    &backup_file(".map");
    my $path = &output_file(".map");
    $path = &input_file(".map") unless ( -f $path );
    if ( -f $path ) {
        &open_file("$path");
        my (@data) = <FP>;
        close FP;
        my %node;
        my $label = "";
        my $scope = "";
        my $ident = "";
        my $prior = "";

        for my $n ( 0 .. $#data ) {
            chomp( $data[$n] );
            my $line = $data[$n];
            $line =~ s/^\s+//;
            $line =~ s/\s*([:;{}]+)\s*/$1/g;
            $line =~ s/\s+/ /g;
            while ( $line ne "" ) {
                last if ( $line =~ /^#.*/ );
                if ( $line =~ /^[[:alnum:]_.]+{/ ) {
                    $label = $line;
                    $label =~ s/{.*//;
                    $line  =~ s/^[^{]*{//;
                    $label = &ncurses_t_node($label);
                    printf "LABEL %d:%s->%s\n", $n, $data[$n], $label
                      if ($opt_d);
                }
                elsif ( $line =~ /^(global|local):/ ) {
                    $scope = $line;
                    $scope =~ s/:.*//;
                    $line  =~ s/^[^:]*://;
                    printf "SCOPE %d:%s->%s\n", $n, $data[$n], $scope
                      if ($opt_d);
                }
                elsif ( $line =~ /^[[:alnum:]_*]+;/ ) {
                    $ident = $line;
                    $ident =~ s/;.*//;
                    $line  =~ s/^[^;]*;//;
                    if ( $ident ne "_*" ) {
                        my %obj;
                        $obj{LABEL}   = $label;
                        $obj{SCOPE}   = $scope;
                        $obj{IDENT}   = $ident;
                        $node{$ident} = \%obj;
                        printf "IDENT %d:%s->%s\n", $n, $data[$n], $ident
                          if ($opt_d);
                    }
                }
                elsif ( $line =~ /}([[:alnum:]_.]+)?;/ ) {
                    $prior = $line;
                    $prior =~ s/^}//;
                    $prior =~ s/;.*//;
                    $line  =~ s/^[^;]*;//;
                    printf "PRIOR %d:%s->%s\n", $n, $data[$n], $prior
                      if ($opt_d);
                    for my $key ( keys %node ) {
                        my %obj = %{ $node{$key} };
                        $obj{PRIOR} = $prior;
                        my $date = $label;
                        $date =~ s/^.*_//;
                        $date =~ s/^.*\.//;
                        $obj{DATE} = $date;
                        my $lib = $label;
                        $lib =~ s/_.*//;
                        $obj{LIB} = &ncurses_t_lib( lc $lib );
                        my $ident = $obj{IDENT};

                        if ( $tack_symbols{$ident} ) {
                            $obj{LIB} =
                                &ncurses_t_lib("ncurses") . "_"
                              . $tack_symbols{$ident};
                            $obj{LABEL} =~ s/_(TINFO_|TIC_)+/_/g;
                            $obj{LABEL} =~ s/_/_TIC_/
                              if &is_libtic( $obj{LIB} );
                            $obj{LABEL} =~ s/_/_TINFO_/
                              unless &is_libtic( $obj{LIB} );
                            $obj{SCOPE} = "global";
                        }
                        elsif ( $obj{LABEL} =~ /^NCURSES_T/ ) {
                            $obj{LIB} = &generic_libname( lc $obj{LABEL} );
                        }
                        $obj{SCOPE} = "global"
                          if ( $deprecated_symbols{$ident} );
                        $result{$ident} = \%obj;
                    }
                    delete $node{$_} for keys %node;
                }
                else {
                    printf "?? %d:%s\n", $n, $line;
                    last;
                }
                $line =~ s/^\s+//;
            }
        }
    }
    return %result;
}

sub is_libtic($) {
    my $libname = shift;
    my $result  = 0;
    $result = 1 if ( $libname =~ /^(ncurses_)?tic.*/ );
    return $result;
}

sub is_libtinfo($) {
    my $libname = shift;
    my $result  = 0;
    $result = 1 if ( $libname =~ /^(ncurses_)?(tinfo|term).*/ );
    return $result;
}

# functions for tic/tinfo interfaces are generic
sub generic_libname($) {
    my $libname = shift;
    if ( &is_libtic($libname) ) {
        $libname = "ncurses_tic";
    }
    elsif ( &is_libtinfo($libname) ) {
        $libname = "ncurses_tinfo";
    }
    else {
        $libname =~ s/^form/ncurses/;
        $libname =~ s/^menu/ncurses/;
        $libname =~ s/^panel/ncurses/;
    }
    return &ncurses_t_lib($libname);
}

sub merge_maps($$) {
    my %old_symbols = %{ $_[0] };
    my %new_symbols = %{ $_[1] };

    for my $ident ( sort keys %new_symbols ) {
        my %new = %{ $new_symbols{$ident} };
        if ( $old_symbols{$ident} ) {
            my %old = %{ $old_symbols{$ident} };
            my $tmp = &generic_libname( $old{LIB} );
            $new{PRIOR} = $old{PRIOR};
            $new{LABEL} = $old{LABEL};
            printf "%s, OLD:%s ->%s, NEW:%s\n", $ident, $old{LIB}, $tmp,
              $new{LIB}
              if ($opt_d);
            if ( &is_libtic($tmp) ) {
                if ( $new{LIB} ne $tmp ) {
                    printf ".. override to %s-library, was %s\n", $tmp,
                      $new{LIB}
                      if ($opt_d);
                    $new{LIB} = $tmp;
                }
            }
            else {
                $new{LIB} = &generic_libname( $new{LIB} );
                $new{LIB} = $tmp if ( $new{LIB} eq "ncurses" );
                printf ".. merged library %s\n", $new{LIB} if ($opt_d);
            }
            $new{LABEL} =~ s/^[[:alpha:]_]+//;
            $new{LABEL} = sprintf "%s_%s", uc $new{LIB}, $new{LABEL};
            $new{DATE} = $old{DATE};

            # new scope should override, in general
            $new{SCOPE} = "global" if ( $tack_symbols{$ident} );
            $new{SCOPE} = "global" if ( $old{SCOPE} eq "global" );
        }
        else {
            $new{LIB}   = $tack_symbols{$ident} if ( $tack_symbols{$ident} );
            $new{LIB}   = &generic_libname( $new{LIB} );
            $new{LABEL} = sprintf "%s_%s.%s.%s", uc( $new{LIB} ),
              $PROGRAM_MAJOR,
              $PROGRAM_MINOR,
              $PROGRAM_PATCH;
            $new{DATE} = $PROGRAM_PATCH;
            $new{SCOPE} = "global" unless ( $new{SCOPE} );
        }
        $new{SCOPE} = "global" if ( $deprecated_symbols{$ident} );
        $new_symbols{$ident} = \%new;
    }
    for my $ident ( sort keys %old_symbols ) {
        my %old = %{ $old_symbols{$ident} };
        $new_symbols{$ident} = \%old unless ( $new_symbols{$ident} );
    }
    return %new_symbols;
}

sub synchronize_maps($$) {
    my %old_symbols = %{ $_[0] };
    my %new_symbols = %{ $_[1] };

    for my $ident ( sort keys %new_symbols ) {
        my %new = %{ $new_symbols{$ident} };
        if ( $old_symbols{$ident} ) {
            my %old = %{ $old_symbols{$ident} };
            if ( &is_libtic( $old{LIB} ) or &is_libtinfo( $old{LIB} ) ) {
                $new{LIB}            = $old{LIB};
                $new{DATE}           = $old{DATE};
                $new{LABEL}          = $old{LABEL};
                $new{SCOPE}          = "global" if ( $old{SCOPE} eq "global" );
                $new_symbols{$ident} = \%new;
            }
        }
    }
    return %new_symbols;
}

sub write_map_file($$$) {
    my %new_symbols = %{ $_[0] };
    my %new_config  = %{ $_[1] };

    my $path = &output_file(".map");
    my %data;
    my @scopes = ( "global", "local" );

    if ( -f $path ) {
        printf ".. merging %s\n", $path;
        %data = &read_options($path);
    }
    else {
        my $prior = &input_file(".map");
        %data = &read_options($prior) if ( -f $prior );
        printf ".. writing %s\n", $path;
    }
    %data = &add_config( \%data, \%new_config );

    printf ".. open >%s\n", $path if ($opt_v);
    open FP, ">$path" || die "cannot write map-file $path";

    printf FP "# %sId%s\n", '$', '$';
    printf FP "# script for shared library symbol-versioning using ld\n";
    printf FP "#\n";
    printf FP "# This file was generated by $program\n";
    &write_options( \%data );

    my %libs;
    foreach my $ident ( keys %new_symbols ) {
        my %new = %{ $new_symbols{$ident} };
        $libs{ $new{LIB} } = 1;
    }

    foreach my $lib ( sort keys %libs ) {
        my %labels_by_date;

        foreach my $ident ( keys %new_symbols ) {
            my %new = %{ $new_symbols{$ident} };
            next if ( $new{LIB} ne $lib );

            if ( not $new{DATE} ) {
                printf STDERR "missing date for $ident\n";
            }
            elsif ( not $new{LABEL} ) {
                printf STDERR "missing label for $ident\n";
            }
            else {
                $labels_by_date{ $new{DATE} } = \%new;
            }
        }

        my $prior       = "";
        my @label_dates = sort keys %labels_by_date;
        my $final_date  = $label_dates[$#label_dates];
        foreach my $date (@label_dates) {
            my %obj = %{ $labels_by_date{$date} };
            $obj{PRIOR} = $prior if ( $prior ne "" );
            printf FP "\n";
            printf FP "%s {\n", $obj{LABEL};
            for my $s ( 0 .. $#scopes ) {
                my $first = 1;
                foreach my $ident ( sort keys %new_symbols ) {
                    next if ( $ident eq "_*" );
                    my %new = %{ $new_symbols{$ident} };
                    next unless ( $new{LIB}   eq $obj{LIB} );
                    next unless ( $new{DATE}  eq $date );
                    next unless ( $new{SCOPE} eq $scopes[$s] );
                    if ($first) {
                        printf FP "\t%s:\n", $scopes[$s];
                        $first = 0;
                        if (    $scopes[$s] eq "local"
                            and $date eq $final_date
                            and $opt_p )
                        {
                            printf FP "\t\t_*;\n";
                        }
                    }
                    printf FP "\t\t%s;", $ident;
                    printf FP "\t# deprecated in ABI%d",
                      $deprecated_symbols{$ident}
                      if ( $deprecated_symbols{$ident} );
                    printf FP "\n";
                }
            }
            printf FP "} %s;\n", $obj{PRIOR} if ( $obj{PRIOR} );
            printf FP "};\n", $obj{PRIOR} unless ( $obj{PRIOR} );
            $prior = $obj{LABEL};
        }
    }
    close FP;
}

sub write_sym_file($) {
    my %new_symbols = %{ $_[0] };
    my %new_config  = %{ $_[1] };

    my $path = &output_file(".sym");
    my %data;
    if ( -f $path ) {
        printf ".. merging %s\n", $path;
        %data = &read_options($path);
    }
    else {
        my $prior = &input_file(".sym");
        %data = &read_options($prior) if ( -f $prior );
        printf ".. writing %s\n", $path;
    }
    %data = &add_config( \%data, \%new_config );

    foreach my $name ( keys %new_symbols ) {
        my %new = %{ $new_symbols{$name} };
        $data{$name} = $name unless ( $new{SCOPE} eq "local" );
    }
    &open_file(">$path");
    printf FP "# %sId%s\n", '$', '$';
    printf FP "# script for shared library symbol-visibility using libtool\n";
    printf FP "#\n";
    printf FP "# This file was generated by $program\n";
    &write_options( \%data );
    close FP;
}

# ncurses' --with-weak-symbols option has as a side-effect suppressing the "t"
# suffix normally used for the pthread configuration.  But that would cause
# this script to merge in unwanted symbols.  Test for it, so we can work around
# the suffix.
sub weak_symbols($) {
    my %config       = %{ $_[0] };
    my $weak_symbols = 0;
    my $with_pthread = 0;
    my $result       = 0;
    for my $key ( sort keys %config ) {
        $weak_symbols = 1 if ( $key eq "--enable-weak-symbols" );
        $with_pthread = 1 if ( $key eq "--with-pthread" );
    }
    $result = 1 if ( $weak_symbols and $with_pthread );
    return $result;
}

sub known_symbol() {
    my $result = "main";
    if ( $PROGRAM_ALIAS eq "ncurses" ) {
        $result = "initscr";
    }
    elsif ( $PROGRAM_ALIAS eq "dialog" ) {
        $result = "init_dialog";
    }
    elsif ( $PROGRAM_ALIAS eq "cdk" ) {
        $result = "initCDKScreen";
    }
    return $result;
}

sub ncu_mapsyms() {
    &read_version;
    my %new_config  = &read_config;
    my %new_symbols = &read_symbols;

    # Get the library root-name by looking to see where initscr() comes from.
    my %obj = %{ $new_symbols{&known_symbol} };
    $this_lib = $obj{LIB};
    if ( &weak_symbols( \%new_config ) ) {
        if ( $this_lib =~ /w$/ ) {
            $this_lib =~ s/^(.*)(w)$/$1t$2/;
        }
        else {
            $this_lib .= "t";
        }
    }

    my %old_symbols = &read_map_file;
    %new_symbols = &merge_maps( \%old_symbols, \%new_symbols );
    &write_sym_file( \%new_symbols, \%new_config );
    &write_map_file( \%new_symbols, \%new_config );
}

sub ncu_hide_locals() {
    printf "** hide remaining locals\n";

    &read_version;

    my $input = "package";
    opendir( my $dh, "$input" ) || die "can't opendir $input-directory: $!";
    my @entries = sort grep { /\.map$/ && -f "$input/$_" } readdir($dh);
    closedir $dh;

    for my $n ( 0 .. $#entries ) {
        next if ( $entries[$n] =~ /^\d/ );
        printf "%d:%s\n", $n, $entries[$n];
        $this_lib = $entries[$n];
        $this_lib =~ s/\.map$//;
        my %new_symbols = &read_map_file;
        unlink &output_file(".map");
        my %new_config = &read_options( &input_file(".map") );
        &write_map_file( \%new_symbols, \%new_config );
    }
}

sub ncu_sync_syms() {
    printf "** synchronize symbols\n";

    &read_version;

    $this_lib = $PROGRAM_ALIAS;
    my %old_symbols = &read_map_file;
    my $input       = "package";
    opendir( my $dh, "$input" ) || die "can't opendir $input-directory: $!";
    my @entries = sort grep { /\.map$/ && -f "$input/$_" } readdir($dh);
    closedir $dh;
    for my $n ( 0 .. $#entries ) {
        next if ( $entries[$n] eq "$PROGRAM_ALIAS.map" );
        next if ( $entries[$n] =~ /^\d/ );
        printf "%d:%s\n", $n, $entries[$n];
        $this_lib = $entries[$n];
        $this_lib =~ s/\.map$//;
        my %new_symbols = &read_map_file;
        unlink &output_file(".map");
        my %new_config = &read_options( &input_file(".map") );
        %new_symbols = &synchronize_maps( \%old_symbols, \%new_symbols );
        &write_map_file( \%new_symbols, \%new_config );
    }
}

sub main::HELP_MESSAGE() {
    printf STDERR <<EOF
Usage: $0 [options]

Options:

-d         debug, shows parsed values
-m         retain pre-merged files via renaming
-p         add "local:_*" to the final version of ".map" files
-r         remove "local:_*" from ".map" files
-s         synchronize all tic/tinfo symbols against package/ncurses.map
-t         treat libraries as ncurses "t" threaded variant with weak symbols
-v         verbose, shows files opened
EOF
      ;
    exit;
}

&getopts('dmprstv') || main::HELP_MESSAGE;
&main::HELP_MESSAGE() if ( $#ARGV >= 0 );

if ($opt_p) {
    &ncu_hide_locals;
}
elsif ($opt_s) {
    &ncu_sync_syms;
}
else {
    &ncu_mapsyms;
}

1;
