1package Term::Detect::Software; 2 3our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY 4our $DATE = '2020-07-10'; # DATE 5our $DIST = 'Term-Detect-Software'; # DIST 6our $VERSION = '0.223'; # VERSION 7 8use 5.010001; 9use strict; 10use warnings; 11use experimental 'smartmatch'; 12#use Log::Any '$log'; 13 14require Exporter; 15our @ISA = qw(Exporter); 16our @EXPORT_OK = qw(detect_terminal detect_terminal_cached); 17 18my $dt_cache; 19sub detect_terminal_cached { 20 if (!$dt_cache) { 21 $dt_cache = detect_terminal(@_); 22 } 23 $dt_cache; 24} 25 26sub detect_terminal { 27 my @dbg; 28 my $info = {_debug_info=>\@dbg}; 29 30 DETECT: 31 { 32 unless (defined $ENV{TERM}) { 33 push @dbg, "skip: TERM env undefined"; 34 $info->{emulator_engine} = ''; 35 $info->{emulator_software} = ''; 36 last DETECT; 37 } 38 39 if ($ENV{KONSOLE_DBUS_SERVICE} || $ENV{KONSOLE_DBUS_SESSION}) { 40 push @dbg, "detect: konsole via KONSOLE_DBUS_{SERVICE,SESSION} env"; 41 $info->{emulator_engine} = 'konsole'; 42 $info->{color_depth} = 2**24; 43 $info->{default_bgcolor} = '000000'; 44 $info->{unicode} = 1; 45 $info->{box_chars} = 1; 46 last DETECT; 47 } 48 49 if ($ENV{XTERM_VERSION}) { 50 push @dbg, "detect: xterm via XTERM_VERSION env"; 51 $info->{emulator_engine} = 'xterm'; 52 $info->{color_depth} = 256; 53 $info->{default_bgcolor} = 'ffffff'; 54 $info->{unicode} = 0; 55 $info->{box_chars} = 1; 56 last DETECT; 57 } 58 59 # cygwin terminal 60 if ($ENV{TERM} eq 'xterm' && ($ENV{OSTYPE} // '') eq 'cygwin') { 61 push @dbg, "detect: xterm via TERM env (cygwin)"; 62 $info->{emulator_engine} = 'cygwin'; 63 $info->{color_depth} = 16; 64 $info->{default_bgcolor} = '000000'; 65 $info->{unicode} = 0; # CONFIRM? 66 $info->{box_chars} = 1; 67 last DETECT; 68 } 69 70 if ($ENV{TERM} eq 'linux') { 71 push @dbg, "detect: linux via TERM env"; 72 # Linux virtual console 73 $info->{emulator_engine} = 'linux'; 74 $info->{color_depth} = 16; 75 $info->{default_bgcolor} = '000000'; 76 # actually it can show a few Unicode characters like single borders 77 $info->{unicode} = 0; 78 $info->{box_chars} = 0; 79 last DETECT; 80 } 81 82 my $gnome_terminal_terms = [qw/gnome-terminal guake xfce4-terminal 83 mlterm lxterminal/]; 84 85 my $set_gnome_terminal_term = sub { 86 $info->{emulator_software} = $_[0]; 87 $info->{emulator_engine} = 'gnome-terminal'; 88 89 # xfce4-terminal only shows 16 color, despite being 90 # gnome-terminal-based? 91 $info->{color_depth} = $_[0] =~ /xfce4/ ? 16 : 256; 92 93 $info->{unicode} = 1; 94 if ($_[0] ~~ [qw/mlterm/]) { 95 $info->{default_bgcolor} = 'ffffff'; 96 } else { 97 $info->{default_bgcolor} = '000000'; 98 } 99 $info->{box_chars} = 1; 100 }; 101 102 if (($ENV{COLORTERM} // '') ~~ $gnome_terminal_terms) { 103 push @dbg, "detect: gnome-terminal via COLORTERM"; 104 $set_gnome_terminal_term->($ENV{COLORTERM}); 105 last DETECT; 106 } 107 108 # Windows command prompt 109 if ($ENV{TERM} eq 'dumb' && $ENV{windir}) { 110 push @dbg, "detect: windows via TERM & windir env"; 111 $info->{emulator_software} = 'windows'; 112 $info->{emulator_engine} = 'windows'; 113 $info->{color_depth} = 16; 114 $info->{unicode} = 0; 115 $info->{default_bgcolor} = '000000'; 116 $info->{box_chars} = 0; 117 last DETECT; 118 } 119 120 # run under CGI or something like that 121 if ($ENV{TERM} eq 'dumb') { 122 push @dbg, "detect: dumb via TERM env"; 123 $info->{emulator_software} = 'dumb'; 124 $info->{emulator_engine} = 'dumb'; 125 $info->{color_depth} = 0; 126 # XXX how to determine unicode support? 127 $info->{default_bgcolor} = '000000'; 128 $info->{box_chars} = 0; 129 last DETECT; 130 } 131 132 { 133 last if $^O =~ /Win/; 134 135 require Proc::Find::Parents; 136 my $ppids = Proc::Find::Parents::get_parent_processes(); 137 unless (defined $ppids) { 138 push @dbg, "skip: get_parent_processes returns undef"; 139 last; 140 } 141 142 # [0] is shell 143 my $proc = @$ppids >= 2 ? $ppids->[1]{name} : ''; 144 #say "D:proc=$proc"; 145 if ($proc ~~ $gnome_terminal_terms) { 146 push @dbg, "detect: gnome-terminal via procname ($proc)"; 147 $set_gnome_terminal_term->($proc); 148 last DETECT; 149 } elsif ($proc ~~ [qw/rxvt mrxvt/]) { 150 push @dbg, "detect: rxvt via procname ($proc)"; 151 $info->{emulator_software} = $proc; 152 $info->{emulator_engine} = 'rxvt'; 153 $info->{color_depth} = 16; 154 $info->{unicode} = 0; 155 $info->{default_bgcolor} = 'd6d2d0'; 156 $info->{box_chars} = 1; 157 last DETECT; 158 } elsif ($proc eq 'st' && $ENV{TERM} eq 'xterm-256color') { 159 push @dbg, "detect: st via procname"; 160 $info->{emulator_software} = 'st'; 161 $info->{emulator_engine} = 'st'; 162 $info->{color_depth} = 256; 163 $info->{unicode} = 1; 164 $info->{default_bgcolor} = '000000'; 165 $info->{box_chars} = 1; # some characters are currently flawed though as of 0.6 166 last DETECT; 167 } elsif ($proc ~~ [qw/pterm/]) { 168 push @dbg, "detect: pterm via procname ($proc)"; 169 $info->{emulator_software} = $proc; 170 $info->{emulator_engine} = 'putty'; 171 $info->{color_depth} = 256; 172 $info->{unicode} = 0; 173 $info->{default_bgcolor} = '000000'; 174 last DETECT; 175 } elsif ($proc ~~ [qw/xvt/]) { 176 push @dbg, "detect: xvt via procname ($proc)"; 177 $info->{emulator_software} = $proc; 178 $info->{emulator_engine} = 'xvt'; 179 $info->{color_depth} = 0; # only support bold 180 $info->{unicode} = 0; 181 $info->{default_bgcolor} = 'd6d2d0'; 182 last DETECT; 183 } 184 } 185 186 # generic 187 { 188 unless (exists $info->{color_depth}) { 189 if ($ENV{TERM} =~ /256color/) { 190 push @dbg, "detect color_depth: 256 via TERM env"; 191 $info->{color_depth} = 256; 192 } else { 193 require File::Which; 194 if (File::Which::which("tput")) { 195 my $res = `tput colors` + 0; 196 push @dbg, "detect color_depth: $res via tput"; 197 $res = 16 if $res == 8; # 8 is basically 16 (8 low-intensity + 8 high-intensity) 198 $info->{color_depth} = $res; 199 } 200 } 201 } 202 203 $info->{emulator_software} //= '(generic)'; 204 $info->{emulator_engine} //= '(generic)'; 205 $info->{unicode} //= 0; 206 $info->{color_depth} //= 0; 207 $info->{box_chars} //= 0; 208 $info->{default_bgcolor} //= '000000'; 209 } 210 211 } # DETECT 212 213 # some additional detections 214 215 # we're running under emacs, it doesn't support box chars 216 if ($ENV{INSIDE_EMACS}) { 217 $info->{inside_emacs} = 1; 218 $info->{box_chars} = 0; 219 } 220 221 $info; 222} 223 2241; 225# ABSTRACT: Detect terminal (emulator) software and its capabilities 226 227__END__ 228 229=pod 230 231=encoding UTF-8 232 233=head1 NAME 234 235Term::Detect::Software - Detect terminal (emulator) software and its capabilities 236 237=head1 VERSION 238 239This document describes version 0.223 of Term::Detect::Software (from Perl distribution Term-Detect-Software), released on 2020-07-10. 240 241=head1 SYNOPSIS 242 243 use Term::Detect::Software qw(detect_terminal detect_terminal_cached); 244 my $res = detect_terminal(); 245 die "Not running under terminal!" unless $res->{emulator_engine}; 246 say "Emulator engine: ", $res->{emulator_engine}; 247 say "Emulator software: ", $res->{emulator_software}; 248 say "Unicode support? ", $res->{unicode} ? "yes":"no"; 249 say "Boxchars support? ", $res->{box_chars} ? "yes":"no"; 250 say "Color depth: ", $res->{color_depth}; 251 say "Inside emacs? ", $res->{inside_emacs} ? "yes":"no"; 252 253=head1 DESCRIPTION 254 255This module uses several heuristics to find out what terminal (emulator) 256software the current process is running in, and its capabilities/settings. This 257module complements other modules such as L<Term::Terminfo> and 258L<Term::Encoding>. 259 260=head1 FUNCTIONS 261 262=head2 detect_terminal() => HASHREF 263 264Return a hashref containing information about running terminal (emulator) 265software and its capabilities/settings. 266 267Detection method is tried from the easiest/cheapest (e.g. checking environment 268variables) or by looking at known process names in the process tree. Terminal 269capabilities is determined using heuristics. 270 271Currently Konsole and Konsole-based terminals (like Yakuake) can be detected 272through existence of environment variables C<KONSOLE_DBUS_SERVICE> or 273C<KONSOLE_DBUS_SESSION>. xterm is detected through C<XTERM_VERSION>. XFCE's 274Terminal is detected using C<COLORTERM>. The other software are detected via 275known process names. 276 277Terminal capabilities and settings are currently determined via heuristics. 278Probing terminal configuration files might be performed in the future. 279 280Result: 281 282=over 283 284=item * emulator_engine => STR 285 286Possible values: C<konsole>, C<xterm>, C<gnome-terminal>, C<rxvt>, C<pterm> 287(PuTTY), C<xvt>, C<windows> (CMD.EXE), C<cygwin>, C<st> (suckless.org's terminal 288emulator), or empty string (if not detected running under terminal). 289 290=item * emulator_software => STR 291 292Either: C<xfce4-terminal>, C<guake>, C<gnome-terminal>, C<mlterm>, 293C<lxterminal>, C<rxvt>, C<mrxvt>, C<putty>, C<xvt>, C<windows> (CMD.EXE), C<st> 294(suckless.org's terminal emulator), or empty string (if not detected running 295under terminal). 296 297=item * color_depth => INT 298 299Either 0 (does not support ANSI color codes), 16, 256, or 16777216 (2**24). 300 301=item * default_bgcolor => STR (6-hexdigit RGB) 302 303For example, any xterm is assumed to have white background (ffffff) by default, 304while Konsole is assumed to have black (000000). Better heuristics will be done 305in the future. 306 307=item * unicode => BOOL 308 309Whether terminal software supports Unicode/wide characters. Note that you should 310also check encoding, e.g. using L<Term::Encoding>. 311 312=item * box_chars => BOOL 313 314Whether terminal supports box-drawing characters. 315 316=back 317 318=head2 detect_terminal_cached([$flag]) => ANY 319 320Just like C<detect_terminal()> but will cache the result. Can be used by 321applications or modules to avoid repeating detection process. 322 323=head1 FAQ 324 325=head2 What is this module for? Why not Term::Terminfo or Term::Encoding? 326 327This module was first written for L<Text::ANSITable> so that the latter can 328provide good defaults when displaying formatted and colored tables, especially 329on popular terminal emulation software like Konsole (KDE's default terminal), 330gnome-terminal (GNOME's default), Terminal (XFCE's default), xterm, rxvt. 331 332This module works by trying to figure out the terminal emulation software 333because the information provided by L<Term::Terminfo> and L<Term::Encoding> are 334sometimes not specific enough. For example, Term::Encoding can return L<utf-8> 335when running under rxvt, but since the software currently lacks Unicode support 336we shouldn't display Unicode characters. Another example is color depth: 337Term::Terminfo currently doesn't recognize Konsole's 24bit color support and 338only gives C<max_colors> 256. 339 340=head1 HOMEPAGE 341 342Please visit the project's homepage at L<https://metacpan.org/release/Term-Detect-Software>. 343 344=head1 SOURCE 345 346Source repository is at L<https://github.com/perlancar/perl-Term-Detect-Software>. 347 348=head1 BUGS 349 350Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Term-Detect-Software> 351 352When submitting a bug or request, please include a test-file or a 353patch to an existing test-file that illustrates the bug or desired 354feature. 355 356=head1 SEE ALSO 357 358L<Term::Terminfo> 359 360L<Term::Encoding> 361 362=head1 AUTHOR 363 364perlancar <perlancar@cpan.org> 365 366=head1 COPYRIGHT AND LICENSE 367 368This software is copyright (c) 2020, 2019, 2015, 2014, 2013 by perlancar@cpan.org. 369 370This is free software; you can redistribute it and/or modify it under 371the same terms as the Perl 5 programming language system itself. 372 373=cut 374