On Fri, Oct 20, 2023 at 11:52:25AM +0200, Marc Espie wrote:
> I guess i will probably leave it alone after this.
> This does quite a few things compared to my former patches.
>
> - totally get rid of eval, it doen't make sense anymore
> - declare variables before they get used, which tends to
> simplify things.
> - change quaint formatting to something more BSD like
> - update documentation to new style of doing OO
> - use defined logic on entry and such
> - always try to run infocmp as a last resort, even if
> we have a path.
> - run infocmp with the best options we have to get a good termcap
> - use \Q\E, which gets rid of termpat entirely
> - dedup the path along the way: for us, /etc/termcap
> and /usr/share/misc/termcap are the same.
> - redo recursion logic by just recording which term values we
> already saw, the max=32 value overflow was absurd, proper parsing
> yields roughly 10 or so tc redirections for xterm, not >32.
I eventually got an occation to test it. Except for the extra debug
print that sneaked. it works well for my use case. (pkg_* tools on a
terminal application from ports that ships its own terminfo entry).
ok matthieu@ with the print removed (see inline).
>
> Index: Cap.pm
> ===================================================================
> RCS file: /cvs/src/gnu/usr.bin/perl/cpan/Term-Cap/Cap.pm,v
> retrieving revision 1.3
> diff -u -p -r1.3 Cap.pm
> --- Cap.pm 18 Oct 2023 01:49:26 -0000 1.3
> +++ Cap.pm 20 Oct 2023 09:47:05 -0000
> @@ -16,8 +16,8 @@ sub croak
>
> use strict;
>
> +use v5.16;
> use vars qw($VERSION $VMS_TERMCAP);
> -use vars qw($termpat $state $first $entry);
>
> $VERSION = '1.17';
>
> @@ -33,7 +33,7 @@ Term::Cap - Perl termcap interface
> =head1 SYNOPSIS
>
> require Term::Cap;
> - $terminal = Tgetent Term::Cap { TERM => undef, OSPEED => $ospeed };
> + $terminal = Term::Cap->Tgetent({ TERM => undef, OSPEED => $ospeed });
> $terminal->Trequire(qw/ce ku kd/);
> $terminal->Tgoto('cm', $col, $row, $FH);
> $terminal->Tputs('dl', $count, $FH);
> @@ -75,10 +75,10 @@ if ( $^O eq 'VMS' )
>
> sub termcap_path
> { ## private
> - my @termcap_path;
> + my @l;
>
> # $TERMCAP, if it's a filespec
> - push( @termcap_path, $ENV{TERMCAP} )
> + push(@l, $ENV{TERMCAP})
> if (
> ( exists $ENV{TERMCAP} )
> && (
> @@ -87,23 +87,27 @@ sub termcap_path
> : $ENV{TERMCAP} =~ /^\//s
> )
> );
> - if ( ( exists $ENV{TERMPATH} ) && ( $ENV{TERMPATH} ) )
> - {
> -
> + if (exists $ENV{TERMPATH} && $ENV{TERMPATH}) {
> # Add the users $TERMPATH
> - push( @termcap_path, split( /(:|\s+)/, $ENV{TERMPATH} ) );
> - }
> - else
> - {
> -
> + push(@l, split( /(:|\s+)/, $ENV{TERMPATH}));
> + } else {
> # Defaults
> - push( @termcap_path,
> - exists $ENV{'HOME'} ? $ENV{'HOME'} . '/.termcap' : undef,
> - '/etc/termcap', '/usr/share/misc/termcap', );
> + if (exists $ENV{HOME}) {
> + push(@l, $ENV{HOME}.'/.termcap');
> + }
> + push(@l, '/etc/termcap', '/usr/share/misc/termcap', );
> + }
> + my @termcap_path;
> + my $seen = {};
> + for my $i (@l) {
> + next unless -f $i;
> + my $k = join(',', (stat _)[0,1]);
> + next if $seen->{$k};
> + push(@termcap_path, $i);
> + $seen->{$k} = 1;
> }
>
> - # return the list of those termcaps that exist
> - return grep { defined $_ && -f $_ } @termcap_path;
> + return @termcap_path;
> }
>
> =over 4
> @@ -164,195 +168,158 @@ It calls C<croak> on failure.
>
> sub Tgetent
> { ## public -- static method
> - my $class = shift;
> - my ($self) = @_;
> + my ($class, $self) = @_;
>
> $self = {} unless defined $self;
> bless $self, $class;
>
> - my ( $term, $cap, $search, $field, $max, $tmp_term, $TERMCAP );
> - local ( $termpat, $state, $first, $entry ); # used inside eval
> + my ($cap, $field);
> +
> local $_;
>
> # Compute PADDING factor from OSPEED (to be used by Tpad)
> - if ( !$self->{OSPEED} )
> - {
> - if ($^W)
> - {
> + if (!$self->{OSPEED}) {
> + if ($^W) {
> carp "OSPEED was not set, defaulting to 9600";
> }
> $self->{OSPEED} = 9600;
> }
> - if ( $self->{OSPEED} < 16 )
> - {
> -
> + if ($self->{OSPEED} < 16) {
> # delays for old style speeds
> my @pad = (
> 0, 200, 133.3, 90.9, 74.3, 66.7, 50, 33.3,
> 16.7, 8.3, 5.5, 4.1, 2, 1, .5, .2
> );
> $self->{PADDING} = $pad[ $self->{OSPEED} ];
> - }
> - else
> - {
> + } else {
> $self->{PADDING} = 10000 / $self->{OSPEED};
> }
>
> - unless ( $self->{TERM} )
> - {
> - if ( $ENV{TERM} )
> - {
> - $self->{TERM} = $ENV{TERM} ;
> - }
> - else
> - {
> - if ( $^O eq 'MSWin32' )
> - {
> + unless ($self->{TERM}) {
> + if ($ENV{TERM}) {
> + $self->{TERM} = $ENV{TERM} ;
> + } else {
> + if ( $^O eq 'MSWin32' ) {
> $self->{TERM} = 'dumb';
> - }
> - else
> - {
> + } else {
> croak "TERM not set";
> }
> }
> }
>
> - $term = $self->{TERM}; # $term is the term type we are looking for
> + my $term = $self->{TERM}; # $term is the term type we are looking for
>
> # $tmp_term is always the next term (possibly :tc=...:) we are looking
> for
> - $tmp_term = $self->{TERM};
> + my $tmp_term = $term;
>
> - # protect any pattern metacharacters in $tmp_term
> - $termpat = $tmp_term;
> - $termpat =~ s/(\W)/\\$1/g;
> -
> - my $foo = ( exists $ENV{TERMCAP} ? $ENV{TERMCAP} : '' );
> -
> - # $entry is the extracted termcap entry
> - if ( ( $foo !~ m:^/:s ) && ( $foo =~ m/(^|\|)${termpat}[:|]/s ) )
> - {
> - $entry = $foo;
> + my $foo = (exists $ENV{TERMCAP} ? $ENV{TERMCAP} : '' );
> +
> + my $seen = {};
> + my $entry;
> + if (exists $ENV{TERMCAP}) {
> + $_ = $ENV{TERMCAP};
> + if ( !m:^/:s && m/(^|\|)\Q$tmp_term\E[:|]/s) {
> + # $entry is the extracted termcap entry
> + $entry = $_;
> + $seen->{$tmp_term} = 1;
> + }
> }
>
> my @termcap_path = termcap_path();
> + print "TEMCAP_PATH", join(' ', @termcap_path), "\n";
Remove this ^^
>
> - if ( !@termcap_path && !$entry )
> - {
> -
> - # last resort--fake up a termcap from terminfo
> - local $ENV{TERM} = $term;
> -
> - if ( $^O eq 'VMS' )
> - {
> + if (!@termcap_path && !$entry) {
> + if ( $^O eq 'VMS' ) {
> $entry = $VMS_TERMCAP;
> - }
> - else
> - {
> - if ( grep { -x "$_/infocmp" } split /:/, $ENV{PATH} )
> - {
> - eval {
> - my $tmp = `infocmp -C 2>/dev/null`;
> - $tmp =~ s/^#.*\n//gm; # remove comments
> - if ( ( $tmp !~ m%^/%s )
> - && ( $tmp =~ /(^|\|)${termpat}[:|]/s ) )
> - {
> - $entry = $tmp;
> - }
> - };
> - warn "Can't run infocmp to get a termcap entry: $@" if $@;
> - }
> - else
> - {
> - # this is getting desperate now
> - if ( $self->{TERM} eq 'dumb' )
> - {
> - $entry = 'dumb|80-column dumb
> tty::am::co#80::bl=^G:cr=^M:do=^J:sf=^J:';
> - }
> - }
> - }
> + }
> }
>
> - croak "Can't find a valid termcap file" unless @termcap_path || $entry;
> -
> - $state = 1; # 0 == finished
> + my $state = 1; # 0 == finished
> # 1 == next file
> # 2 == search again
> + # 3 == infocmp
>
> - $first = 0; # first entry (keeps term name)
> -
> - $max = 64; # max :tc=...:'s
> -
> - if ($entry)
> - {
> + my $first = 0; # first entry (keeps term name)
>
> + if (defined $entry) {
> # ok, we're starting with $TERMCAP
> $first++; # we're the first entry
> # do we need to continue?
> - if ( $entry =~ s/:tc=([^:]+):/:/ )
> - {
> + if ($entry =~ s/:tc=([^:]+):/:/ ) {
> $tmp_term = $1;
> -
> - # protect any pattern metacharacters in $tmp_term
> - $termpat = $tmp_term;
> - $termpat =~ s/(\W)/\\$1/g;
> - }
> - else
> - {
> + } else {
> $state = 0; # we're already finished
> }
> }
>
> - # This is eval'ed inside the while loop for each file
> - $search = q{
> - while (<TERMCAP>) {
> - next if /^\\t/ || /^#/;
> - if ($_ =~ m/(^|\\|)${termpat}[:|]/o) {
> + my $TERMCAP;
> + while ($state != 0) {
> + if ($state == 1) {
> + # get the next TERMCAP or get ready for infocmp
> + $TERMCAP = shift @termcap_path or $state = 3;
> + } elsif ($state == 3) {
> + croak "failed termcap lookup on $tmp_term";
> + } else {
> + # do the same file again
> + # prevent endless recursion
> + $state = 1; # ok, maybe do a new file next time
> + }
> +
> + my ($fh, $child);
> + if ($state == 3) {
> + my $child = open($fh, "-|");
> + # TODO this breaks on !UNIX
> + # not do anything, or let it break here
> + croak "cannot fork: $!" if !defined $child;
> + if (!$child) {
> + open(STDERR, ">", "/dev/null");
> + system('infocmp', '-CTr', $tmp_term);
> + exit(1);
> + }
> + } else {
> + open($fh, "<", $TERMCAP ) || croak "open $TERMCAP: $!";
> + }
> + undef $_;
> + while (<$fh>) {
> + next if /^\t/ || /^#/;
> + if (m/(^|\|)\Q$tmp_term\E[:|]/) {
> chomp;
> s/^[^:]*:// if $first++;
> $state = 0;
> - while ($_ =~ s/\\\\$//) {
> - defined(my $x = <TERMCAP>) or last;
> + $seen->{$tmp_term} = 1;
> + while (s/\\$//) {
> + defined(my $x = <$fh>) or last;
> $_ .= $x; chomp;
> }
> + if (defined $entry) {
> + $entry .= $_;
> + } else {
> + $entry = $_;
> + }
> last;
> }
> }
> - defined $entry or $entry = '';
> - $entry .= $_ if $_;
> - };
> -
> - while ( $state != 0 )
> - {
> - if ( $state == 1 )
> - {
> -
> - # get the next TERMCAP
> - $TERMCAP = shift @termcap_path
> - || croak "failed termcap lookup on $tmp_term";
> - }
> - else
> - {
> -
> - # do the same file again
> - # prevent endless recursion
> - $max-- || croak "failed termcap loop at $tmp_term";
> - $state = 1; # ok, maybe do a new file next time
> - }
> -
> - open( TERMCAP, "< $TERMCAP\0" ) || croak "open $TERMCAP: $!";
> - eval $search;
> - die $@ if $@;
> - close TERMCAP;
> + close($fh);
> + waitpid($child, 0) if defined $child;
> + next if !defined $entry;
>
> # If :tc=...: found then search this file again
> - $entry =~ s/:tc=([^:]+):/:/ && ( $tmp_term = $1, $state = 2 );
> -
> - # protect any pattern metacharacters in $tmp_term
> - $termpat = $tmp_term;
> - $termpat =~ s/(\W)/\\$1/g;
> + while ($entry =~ s/:tc=([^:]+):/:/) {
> + $tmp_term = $1;
> + if ($seen->{$tmp_term}) {
> + next;
> + }
> + $state = 2;
> + last;
> + }
> }
>
> - croak "Can't find $term" if $entry eq '';
> + if (!defined $entry) {
> + if ($self->{TERM} eq 'dumb') {
> + $entry = 'dumb|80-column dumb
> tty::am::co#80::bl=^G:cr=^M:do=^J:sf=^J:';
> + }
> + }
> + croak "Can't find $term" if !defined $entry;
> $entry =~ s/:+\s*:+/:/g; # cleanup $entry
> $entry =~ s/:+/:/g; # cleanup $entry
> $self->{TERMCAP} = $entry; # save it
>
--
Matthieu Herrb
