This prints
�~X�
How could I get the unicode ☺ instead?
#!/usr/bin/env perl6
use v6;
use NCurses;
my $win = initscr;
my Str $s = "\x[263a]";
printw( $s );
nc_refresh;
while getch() < 0 {};
endwin;
I was getting the same as you - turns out just needed to set locale;
#!/usr/bin/env perl6
use v6;
use NCurses;
use NativeCall;
my int32 constant LC_ALL = 6; # From locale.h
my sub setlocale(int32, Str) returns Str is native(Str) { * }
setlocale(LC_ALL, "");
my $win = initscr;
my Str $s = "\x[263a]";
printw( $s );
nc_refresh;
while getch() < 0 {};
endwin;
That puts a smile on my face... and screen. ☺
Related
To diagnose or debug my perl code, I would like to easily display the name of a variable along with its value. In bash, one types the following:
#!/bin/bash
dog=pitbull
declare -p dog
In perl, consider the following script, junk.pl:
#!/usr/bin/perl
use strict; use warnings;
my $dog="pitbull";
my $diagnosticstring;
print STDERR "dog=$dog\n";
sub checkvariable {
foreach $diagnosticstring (#_) { print "nameofdiagnosticstring=$diagnosticstring\n"; }
}
checkvariable "$dog";
If we call this script, we obtain
bash> junk.pl
dog=pitbull
nameofdiagnosticstring=pitbull
bash>
But instead, when the subroutine checkvariable is called, I would like the following to be printed:
dog=pitbull
This would make coding easier and less error-prone, since one would not have to type the variable's name twice.
You can do something like this with PadWalker (which you'll need to install from CPAN). But it's almost certainly far more complex than you'd like it to be.
#!/usr/bin/perl
use strict;
use warnings;
use PadWalker 'peek_my';
my $dog="pitbull";
print STDERR "dog=$dog\n";
sub checkvariable {
my $h = peek_my(0);
foreach (#_) {
print '$', $_,'=', ${$h->{'$'. $_}}, "\n";
}
}
checkvariable "dog";
Data::Dumper::Names may be what you're looking for.
#! perl
use strict;
use warnings;
use Data::Dumper::Names;
my $dog = 'pitbull';
my $cat = 'lynx';
my #mice = qw(jumping brown field);
checkvariable($dog, $cat, \#mice);
sub checkvariable {
print Dumper #_;
}
1;
Output:
perl test.pl
$dog = 'pitbull';
$cat = 'lynx';
#mice = (
'jumping',
'brown',
'field'
);
(not an answer, a formatted comment)
The checkvariable sub receives only a value, and there's no (simple or reliable) way to find out what variable holds that value.
This is why Data::Dumper forces you to specify the varnames as strings:
perl -MData::Dumper -E '
my $x = 42;
my $y = "x";
say Data::Dumper->Dump([$x, $y]);
say Data::Dumper->Dump([$x, $y], [qw/x y/])
'
$VAR1 = 42;
$VAR2 = 'x';
$x = 42;
$y = 'x';
Something as following usually helps
use strict;
use warnings;
use Data::Dumper;
my $debug = 1;
my $container = 20;
my %hash = ( 'a' => 7, 'b' => 2, 'c' => 0 );
my #array = [ 1, 7, 9, 8, 21, 16, 37, 42];
debug('container',$container) if $debug;
debug('%hash', \%hash) if $debug;
debug('#array', #array) if $debug;
sub debug {
my $name = shift;
my $value = shift;
print "DEBUG: $name [ARRAY]\n", Dumper($value) if ref $value eq 'ARRAY';
print "DEBUG: $name [HASH]\n", Dumper($value) if ref $value eq 'HASH';
print "DEBUG: $name = $value\n" if ref $value eq '';
}
But why not run perl script under build-in debugger? Option -d
The Perl Debugger
Is the below program correct to compare two versions?
say v1 = 3.0.1 and v2 = 4.5.5
sub VerChecker
{
my $v1 = shift;
my $v2 = shift;
my #v1_parts = split (/./, $v1);
my #v2_parts = split (/./, $v2);
for( my $i = 0; $i < #v1_parts; $i++ )
{
if( $v1_parts[$i] < $v2_parts[$i] )
{
return -1;
}
elsif( $v1_parts[$i] > $v2_parts[$i] )
{
return 1;
}
}
# equal !
return 0;
}
Can you correct the above code
#!/bin/env perl
use strict;
use warnings;
sub ver_checker {
my ($v1, $v2) = #_;
my #v1_parts = split(/\./, $v1);
my #v2_parts = split(/\./, $v2);
my $num_parts = scalar #v1_parts;
if (scalar #v2_parts > $num_parts) {
$num_parts = scalar #v2_parts;
}
for my $part (0 .. $num_parts-1) {
$v1_parts[$part] = sprintf("%04d", $v1_parts[$part] // 0);
$v2_parts[$part] = sprintf("%04d", $v2_parts[$part] // 0);
}
return join('', #v1_parts) cmp join('', #v2_parts);
}
print ver_checker('3.0.1', '4.5.5')."\n";
print ver_checker('3.0', '4.5.5')."\n";
print ver_checker('3.0.1', '4')."\n";
print ver_checker('5', '4')."\n";
A few things to mention:
use strict; use warnings; always
Camel Case Isn't Fun Anymore. Use lowercase_and_underscores
Escape literals in regular expressions. Your split needed to escape the period
I find that when comparing something dotted like this, it's easier to pad everything out and compare the string. Your code only considered if the version number was three dotted numbers. I made it more portable by making it choose the longest dotted number and pad both out (ie. 3.1 vs 5.0.1 essentially becomes 3.1.0 vs 5.0.1, and pads to 000300010000 vs 000500000001. cmp returns your -1/0/1 value.
To clarify why your split wasn't working:
Your split needed to escape the period. You were splitting on every character, which meant there were no captures. Run this script to see for yourself.
#!/bin/env perl
use strict; use warnings;
use Data::Dumper;
my $foo = 'a.b.c';
my #split1 = split(/./, $foo); # gives []
my #split2 = split(//, $foo); # gives ['a', '.', 'b', '.', 'c']
my #split3 = split(/\./, $foo); # gives [ 'a', 'b', 'c']
print Dumper [ \#split1, \#split2, \#split3 ];
When I run this script in a Windows console where the active codepage is 65001 InputChar returns undef if I enter an ö (U+00F6). Does this mean that InputChar doesn't work with cp65001?
#!perl
use warnings;
use strict;
use 5.10.0;
use Devel::Peek;
use Win32::Console;
my $in = Win32::Console->new( STD_INPUT_HANDLE );
$in->Mode( ENABLE_PROCESSED_INPUT );
my $char = $in->InputChar();
Dump $char;
say "{$char}";
C:>chcp 65001
Active code page: 65001
C:>perl.pl
SV = NULL(0x0) at 0x12b6fac
REFCNT = 1
FLAGS = (PADMY)
Use of uninitialized value $char in concatenation (.) or string at ... line 21.
{}
If you look inside sub InputChar you can see it uses _ReadConsole which doesn't do unicode (i think char * isn't unicode)
It also doesn't do unicode because of the way ReadConsole function (Windows) is called, at least that is what documentation hints to me :)
update: OTOH, if I edit Win32-Console-0.10\Makefile.PL to add
DEFINE => ' -DUNICODE ',
and then recompile/reinstall Win32::Console, I can get AöBöCöDö10 into the program using the following
my $chars = ShInputChar( $in, 10 );
sub ShInputChar {
package Win32::Console;
my($self, $number) = #_;
return undef unless ref($self);
$number = 1 unless defined($number);
my $onumber = $number;
## double up or free to wrong pool, char versus wchar
$number = 2 * $number;
my $buffer = (" " x $number);
my $readed = _ReadConsole($self->{'handle'}, $buffer, $number) ;
my $err = sprintf "ErrSet \$!(%d)(%s)\n\$^E(%d)(%s)\n", $!,$!,$^E,$^E;
use Encode;
$buffer = Encode::decode('UTF-16LE', $buffer );
if ( $readed == $number or $onumber == $readed ) {
return $buffer;
}
else {
warn "wanted $number but read $readed returning buffer anyway";
return $buffer;
}
}
You should report this to the author , hes more knowledgeable about win32
I would be very cautious with libwin32 (of which Win32::Console is a part) as it was last updated over six years ago, in the early days of Windows Vista.
You may want to try Win32::Unicode::Console which has a very different API but is designed for your purpose.
How can I induce Term::Readline to set the UTF8 flag one the results from readline?
#!/usr/local/bin/perl
use warnings FATAL => qw(all);
use strict;
use 5.10.1;
use utf8;
use open qw( :encoding(UTF-8) :std );
use Term::ReadLine;
use Devel::Peek;
my $term = Term::ReadLine->new( 'test', *STDIN, *STDOUT );
$term->ornaments( 0 );
my $char;
$char = $term->readline( 'Enter char: ' );
Dump $char;
print 'Enter char: ';
$char = <>;
chomp $char;
Dump $char;
The output:
Enter char: ü
SV = PV(0x11ce4c0) at 0x1090078
REFCNT = 1
FLAGS = (PADMY,POK,pPOK)
PV = 0x14552c0 "\374"\0
CUR = 1
LEN = 16
Enter char: ü
SV = PV(0x11ce4c0) at 0x1090078
REFCNT = 1
FLAGS = (PADMY,POK,pPOK,UTF8)
PV = 0x14552c0 "\303\274"\0 [UTF8 "\x{fc}"]
CUR = 2
LEN = 16
Comment:
When I am searching in a mysql database (with mysql_enable_utf8 enabled):
my $stmt = "SELECT * FROM $table WHERE City REGEXP ?";
say $stmt;
# my $term = Term::ReadLine->new( 'table_watch', *STDIN, *STDOUT );
# $term->ornaments( 0 );
# my $arg = $term->readline( 'Enter argument: ' ); # ü -> doesn't find 'München'
print "Enter argument: ";
my $arg = <>; # ü -> finds 'München'
chomp $arg;
Why? Those two strings are equivalent. It's like 0 stored as an IV vs stored as a UV.
Well, it's possible that you have to deal with buggy XS code. If that's the case, utf8::upgrade($s) and utf8::downgrade($s) can be used to change how the string is stored in the scalar.
Unlike encoding and decoding, utf8::upgrade and utf8::downgrade don't change the string, just how it's stored.
$ perl -MDevel::Peek -E'
$_="\xFC";
utf8::downgrade($d=$_); Dump($d);
utf8::upgrade($u=$_); Dump($u);
say $d eq $u ?1:0;
'
SV = PV(0x86875c) at 0x4a9214
REFCNT = 1
FLAGS = (POK,pPOK)
PV = 0x8699b4 "\374"\0
CUR = 1
LEN = 12
SV = PV(0x868784) at 0x4a8f44
REFCNT = 1
FLAGS = (POK,pPOK,UTF8)
PV = 0x869d14 "\303\274"\0 [UTF8 "\x{fc}"]
CUR = 2
LEN = 12
1
#!/usr/bin/env perl
use warnings;
use 5.014;
use Term::Cap;
use POSIX;
my $termios = new POSIX::Termios;
$termios->getattr;
my $ospeed = $termios->getospeed;
my $terminal = Tgetent Term::Cap { TERM => undef, OSPEED => $ospeed };
$terminal->Trequire("ku"); # move cursor up
my $UP = $terminal->Tputs("ku");
my $t = 500;
while ($t > 0) {
printf "Hour: %d \n", $t/3600;
printf "Minute: %d \n", ($t/60)%60;
printf "Second: %d \n", $t%60;
print $UP,$UP,$UP;
sleep 5;
$t -= 5;
}
When I try this (found here: How can I update values on the screen without clearing it in Perl?) I get this output:
Hour: 0
Minute: 8
Second: 20
AAAHour: 0
Minute: 8
Second: 15
AAAHour: 0
Minute: 8
Second: 10
AAAHour: 0
Minute: 8
Second: 5
Does this mean, that key-up doesn't work with my terminal?
You've misunderstood the ku capability. That's the character sequence generated when the user presses the up arrow key on the terminal. To actually move the cursor up on the screen, you print the up capability. (Also, it's best to avoid the indirect object syntax, although that had nothing to do with your problem.)
Here's a corrected version:
#!/usr/bin/env perl
use warnings;
use 5.014;
use Term::Cap;
use POSIX;
my $termios = POSIX::Termios->new;
$termios->getattr;
my $ospeed = $termios->getospeed;
my $terminal = Term::Cap->Tgetent({ TERM => undef, OSPEED => $ospeed });
$terminal->Trequire("up"); # move cursor up
my $UP = $terminal->Tputs("up");
my $t = 500;
while ($t > 0) {
printf "Hour: %d \n", $t/3600;
printf "Minute: %d \n", ($t/60)%60;
printf "Second: %d \n", $t%60;
print $UP,$UP,$UP;
sleep 5;
$t -= 5;
}
You may find the Termcap manual helpful. It explains what all the capabilities mean.