Related
I would imagine this is too big and too specific for a normal StackOverflow question, so I can understand if there isn't any possible help. However I will try and show what is the issue I am facing. Also I am new to Perl and I know you shouldn't declare all variables at the start, I'm just trying to see if I can get this implemented first.
I have a Perl script:
use 5.010;
use Math::Trig ':radial';
use Math::Trig;
use List::Util qw(max min);
#Input parameters:
#The ouput filename:
$outfile = 'Tree.scad';
#The coordinates of the points that is to be supported.
$min_X=0;
$max_X=60;
$min_Y=0;
$max_Y=60;
$distance=10;
#The minimum angle from horizontal your printer can make, in degrees
$min_angle= 40;
#Ignore the next line, it is not an input parameter.
($X_ref,$Y_ref)=grid($min_X,$max_X,$min_Y,$max_Y,$distance);#X=#$X_ref;#Y=#{$Y_ref};
for $i (0..$#X){
$Z[$i]=20;#The function that defined the height of each point. This setting wil give you a flat roof. For a more advanced tree, try:
#$Z[$i]=-0.01*$X[$i]**2+0.2*$Y[$i]-0.005*$Y[$i]**2+20;
}
#End of input parameters.
$min_radian = deg2rad($min_angle);
$b = tan($min_radian);
#Z=map{$_/$b}#Z;
open $output, '>', $outfile or die "error writing to '$outfile'";
print $output "width=2;\n";
print $output "sphere_radius=0;\n";
print $output "base_plate_size=10;\n\n";
while ($#X>0){
($I,$J)=find_min_dist(\#X,\#Y,\#Z);
($X_branch,$Y_branch,$Z_branch)=find_branch($X[$I],$Y[$I],$Z[$I],$X[$J],$Y[$J],$Z[$J]);
#X_list=($X_branch,$X[$I],$X[$J]);
#Y_list=($Y_branch,$Y[$I],$Y[$J]);
#Z_list=($Z_branch,$Z[$I],$Z[$J]);
for $j (0..$#Y_list){
if (abs($X_list[$j]) < 0.001){
$X_list[$j]=0;
}
if (abs($Y_list[$j]) < 0.001){
$Y_list[$j]=0;
}
if (abs($Z_list[$j]) < 0.001){
$Z_list[$J]=0;
}
}
branch(\#X_list,\#Y_list,\#Z_list);
splice(#X,$I,1,$X_branch);
splice(#X,$J,1);
splice(#Y,$I,1,$Y_branch);
splice(#Y,$J,1);
splice(#Z,$I,1,$Z_branch);
splice(#Z,$J,1);
}
print $output 'if(base_plate_size>0){';
print $output "\n translate([$X[0],$Y[0],$Z[0]*$b])\n";
print $output "cube([base_plate_size,base_plate_size,1],center=true);}";
sub grid{
my $d=$_[4];
#X_values=$_[0]/$d..$_[1]/$d;
#X_values=map{$_*$d} #X_values;
#Y_values=$_[2]/$d..$_[3]/$d;
#Y_values=map{$_*$d} #Y_values;
for $i (0..$#X_values){
#Y=(#Y,#Y_values);
for $j (0..$#Y_values){
$X[$i*($#Y_values+1)+$j]= $X_values[$i];
}
}
return (\#X,\#Y);
}
sub branch{
my #X=#{ $_[0] };
my #Y=#{ $_[1] };
my #Z=#{ $_[2] };
#Z=map{$_*$b}#Z;
for $i (1..$#X){
($rho, $theta, $phi) = cartesian_to_spherical($X[$i]-$X[0],$Y[$i]-$Y[0],$Z[$i]-$Z[0]);
$phi = rad2deg($phi);
if (abs($phi)<0.001){$phi=0;}
$theta = rad2deg($theta)+90;
if (abs($theta)<0.001){$theta=0;}
if (abs($rho)>0.001){
print $output "translate([$X[0],$Y[0],$Z[0]])\n";
print $output "rotate([0,0,$theta])\n";
print $output "rotate([$phi,0,0])\n";
print $output "translate([-width/2,-width/2,0])";
print $output "cube([width,width,$rho]);\n";
print $output 'if (sphere_radius>0){';
print $output "\n translate([$X[$i],$Y[$i],$Z[$i]])\n";
print $output "sphere(sphere_radius,center=1);}\n";}
}
}
sub find_min_dist{
my #X=#{ $_[0] };
my #Y=#{ $_[1] };
my #Z=#{ $_[2] };
my $min_dist=($X[0]-$X[1])**2+($Y[0]-$Y[1])**2+($Z[0]-$Z[1])**2;
my $max_Z=$Z[0];
my $I=0;
my $J=1;
for $i (1..$#Z){
if ($Z[$i]>=$max_Z){
$max_Z=$Z[$i];
$I=$i;}
}
for $j (0..$#X){
if ($j!=$I){
$dist=(($X[$I]-$X[$j])**2+($Y[$I]-$Y[$j])**2+($Z[$I]-$Z[$j])**2);
if ($min_dist>$dist){
$min_dist=$dist;
$J=$j;
}}}
return ($I,$J);
}
sub find_branch{
my $X1=$_[0];
my $Y1=$_[1];
my $Z1=$_[2];
my $X2=$_[3];
my $Y2=$_[4];
my $Z2=$_[5];
$rXY=sqrt(($X1-$X2)**2+($Y1-$Y2)**2);
if (abs($Z1-$Z2) < $rXY) {
$Z_branch=($Z1+$Z2-$rXY)/2;
$a=($Z1-$Z_branch)/$rXY;
$X_branch=(1-$a)*$X1+$a*$X2;
$Y_branch=(1-$a)*$Y1+$a*$Y2;
}
elsif ($Z1 < $Z2) {
$X_branch=$X1;
$Y_branch=$Y1;
$Z_branch=$Z1;
}
else {
$X_branch=$X2;
$Y_branch=$Y2;
$Z_branch=$Z2;
}
return ($X_branch,$Y_branch,$Z_branch);
}
Which produces a scad file and outputs it as this:
I thought it would be good to implement this method in a slicing program, Slic3r. Now what I have done is attempted to still keep it separate since I would like to show at least this structure in the program and decide whether or not it is possible to do.
Slic3r Original Code: https://github.com/slic3r/Slic3r/blob/21eb603cc16946b14e77d3c10cbee2f1163503c6/lib/Slic3r/Print/SupportMaterial.pm
Modified Slic3r Code: https://pastebin.com/aHzXT4RW
So the comparison is, I removed the generate_pillar_supports and added my grid subroutine. I assumed I would just have to call it since this script is separate to how it's generated compared to the other support structures on:
So replaced this:
my $shape = [];
if ($self->object_config->support_material_pattern eq 'pillars') {
$self->generate_pillars_shape($contact, $support_z, $shape);
}
With this:
my $shape = [];
if ($self->object_config->support_material_pattern eq 'pillars') {
$self->grid($min_X,$max_X,$min_Y,$max_Y,$distance);
}
However unfortunately, I have not been able to get a nice structure to form but rather this:
As I said, I know this is a large question and I'm not diving into the entire Slic3ing program so it might be even harder to understand. However just from a brief look, would anyone know what the issue is? Am I calling the subroutine wrong, does the script only work to produce a scad file, etc. All I would need is just to see if this is able to show or not. Thanks.
sub grid does not appear to be a method, but you are calling it as one
$self->grid($min_X,$max_X,$min_Y,$max_Y,$distance);
This syntax actually sends $self as the first argument, so that call is equivalent to the function call
grid($self,$min_X,$max_X,$min_Y,$max_Y,$distance);
What you probably want is to just say
grid($min_X,$max_X,$min_Y,$max_Y,$distance);
(You also really want to say
use strict;
use warnings;
at the top of every script)
I'm running the following code to extract a list of IDs from a mysql database and store them in an array. I'm doing this exact sequence of steps in other places in my code, but in this location, something funny happens and Perl just hangs and never returns. Every where else in the code, it works fine. If I run this code as is, it runs fine, but if I uncomment the push() function, it hangs. Is this a bug?
my $result = $db->query($sqlstring)
if ($result->numrows > 0) {
my #list = ();
while (my %row = $result->fetchhash) {
my $studyid = $row{'study_id'} + 0;
print "$studyid\n";
WriteLog("Found study [" . $studyid . "]");
#push(#list,$studyid); # uncomment this to hang it
}
return \#list;
}
EDIT: I tried the data::dumper. But now the freezing occurs in a new location. In the code below, it freezes right after the very last Dumper(#list) statement. (I also switched to DBI from MySQL module, but that had no effect).
my #list = ();
my $result = $dbh->prepare($sqlstring);
$result->execute();
WriteLog($sqlstring);
if ($result->rows > 0) {
while (my $row = $result->fetchrow_hashref()) {
my $studyid = $row->{study_id};
WriteLog("Found study [" . $studyid . "]");
push #list,$studyid;
}
}
print Dumper(#list);
return \#list;
When is this freezing? Is it freezing on the first call to push, or on some subsequent call?
Are you sure you're pushing what you think you're pushing?
What you should do is to use Data::Dumper; and then do a dumper before the push.
use Data::Dumper;
use feature qw(say);
my $result = $db->query($sqlstring)
if ( $result->numrows > 0 ) {
my #list;
while ( my %row = $result->fetchhash ) {
my $studyid = $row{study_id} + 0;
say $studyid;
WriteLog("Found study [" . $studyid . "]");
say "List: " . Dumper #list;
say "Study ID: " . Dumper \$studyid;
push #list, $studyid; # uncomment this to hang it
}
return \#list;
}
Note I'm using say instead of print. Dumper can cause problems if you don't parenthesize it and use print. If you don't want to use say, then you'll need to do this:
print "Study ID: " . Dumper ( \$studyid ) . "\n";
By the way, what do you return if there are no rows?
I was going to mention that we just had this same problem with one of our scripts. The script is being run through Jenkins and the problem was that there wasn't really a problem. We just hadn't seen all of the output up to the point of the program's current state. So it looked like it was hung on a push - it was actually hung legitimately on a sleep() call a few lines later. It was fixed with the auto-flush flag which David W. mentioned. The problem was worsened by the use of Jenkins as an execution environment (vs the command-line debugger). The STDOUT/STDIN pipe opened in the Jenkins context doesn't exist in a command-line shell. So we would never see the issue from the command line - further confusing us. Once I realized that there was a communications pipe involved then things fell into place.
This is driving me crazy, Perl is simply losing the value of a variable once I enter an if statement... and the weird this is, its only that variable, any other variable will not lose its value
open (MYFILE, "b");
my $haysack = "";
while (<MYFILE>)
{
$haysack = $haysack . "$_";
}
close (MYFILE);
open (MYFILE2, "ip_range");
my $needles = "";
while (<MYFILE2>)
{
$needles = $needles . "$_";
}
close (MYFILE2);
my $someOtherValue = "blabla";
while ($needles =~ m/(.*?)\n/g)
{
$needle = $1;
if ($haysack =~ m/$needle/ims)
{
print "FOUND : $needle\n";
print "$someOtherValue\n";
}
}
So the code succesfully enters the if statement, but once it does I get the following output:
FOUND:
blabla
can anyone help?
This really should be a comment, since it's not an answer, but comments don't allow code formatting, so:
Can you provide a complete, runnable, self-contained, minimal example which demonstrates the problem without extraneous moving parts, such as reading files? Something similar to the following:
#!/usr/bin/env perl
use strict;
use warnings;
my $haysack = "Foo
Bar
Baz
";
my $needles = "a
b
c
";
while ($needles =~ m/(.*?)\n/g) {
my $needle = $1;
if ($haysack =~ m/$needle/ims) {
print "FOUND : $needle\n";
}
}
...except that mine runs perfectly, producing the output
FOUND : a
FOUND : b
rather than failing. Note that, in the process of creating a minimal failing example, you are very likely to discover the solution to your problem...
As far as general troubleshooting advice, use strict and use warnings if you aren't already doing so. Check the value of $1 after doing the outer match to verify that $needle will be getting the value you expect it to.
EDIT:
I will try a better explication this time, this is the exact code from my script (sorry for all them coments, they are a result of your sugestions, and apear in the video below).
#use warnings;
#use Data::Dumper;
open(my $tmp_file, ">>", "/tmp/some_bad.log") or die "Can not open log file: $!\n";
#if( $id_client != "")
#allowed_locations = ();
#print $tmp_file "Before the if: ". Data::Dumper->Dump([\#allowed_locations, $id_client]) . "";
if( $id_client )
{
# print $tmp_file "Start the if: ". Data::Dumper->Dump([\#allowed_locations, $id_client]) . "";
# my $q = "select distinct id_location from locations inner join address using (id_db5_address) inner join zona_rural_detaliat using (id_city) where id_client=$id_client";
# my $st = &sql_special_transaction($sql_local_host, $sql_local_database, $sql_local_root, $sql_local_root_password, $q);
# print $tmp_file "Before the while loop: ref(st)='". ref($st) . "\n";
# while((my $id)=$st->fetchrow())
# {
# print $tmp_file "Row the while loop: ". Data::Dumper->Dump([$id]) . "";
# my $id = 12121212;
# push(#allowed_locations, $id);
# }
# print $tmp_file "After the while loop: ref(st)='". ref($st) . "\n";
# my($a) = 1;
#} else {
# my($a) = 0;
}
#print $tmp_file "After the if: ". Data::Dumper->Dump([\#allowed_locations, $id_client]) . "";
close($tmp_file) or die "Can not close file: $!\n";
#&html_error(#allowed_locations);
First off all, somebody said that I should try to run it in command line, the script works fine in command line (no warnings, It was uncommented then), but when triyng to load in via apache in the browser it fails, please see this video where I captured the script behavior, what I tried to show in the video:
I have opened 2 tabs the first doesn't define the variable $id_client, the second defines the variable $id_client that is read from GET: ?id_client=36124 => $id_client = 36124; , both of them include the library in the video "locallib.pl"
When running the script with all the
new code commented the page loads
when uncoment the line that defines
the #allowed_locations = (); the
script fails
leave this definition and uncoment
the if block, and the definition of
my $a; in the if block; Now the script works fine when $id_client is
defined, but fails when $id_client
is not defined
Uncoment the else block and the
definition of my $a; in the else
block. Now the script works fine
with or without $id_client
now comment all the my $a;
definisions and comment the else
block, the script fails
but if I'm using open() to open
a file before the IF, and
close() to close it after the if it does't fail even if the IF block
is empty and event if there is no
else block
I have replicated all the steps when running the script in the command line, and the script worked after each step.
I know it sounds like something that cannot be the behavior of the script, but please watch the video (2 minutes), maybe you will notice something that I'm doing wrong there.
Using perl version:
[root#db]# perl -v
This is perl, v5.8.6 built for i386-linux-thread-mult
Somebody asked if I don't have a test server, answer: NO, my company has a production server that has multiple purposes, not only the web interface, and I cannot risk to update the kernel or the perl version, and cannot risk instaling any debuger, as the company owners say: "If it works, leave it alone", and for them the solution with my ($a); is perfect beacause it works, I'm asking here just for me, to learn more about perl, and to understand what is going wrong and what can I do better next time.
Thank you.
P.S. hope this new approach will restore some of my -1 :)
EDIT:
I had success starting the error logging, and found this in the error log after each step that resulted in a failure I got this messages:
[Thu Jul 15 14:29:19 2010] [error] locallib.pl did not return a true value at /var/www/html/rdsdb4/cgi-bin/clients/quicksearch.cgi line 2.
[Thu Jul 15 14:29:19 2010] [error] Premature end of script headers: quicksearch.cgi
What I found is that this code is at the end of the main code in the locallib.pl after this there are sub definitions, and locallib.pl is a library not a program file, so it's last statement must returns true. , a simple 1; statement at the end of the library ensures that (I put it after sub definitions to ensure that noobody writes code in the main after the 1;) and the problem was fixed.
Don't know why in CLI it had no problem ...
Maybe I will get a lot of down votes now ( be gentle :) ) , but what can I do ...and I hope that some newbies will read this and learn something from my mistake.
Thank you all for your help.
You need to explicitly check for definedness.
If you want to enter the loop when $client is defined,
use if ( defined $client ).
If you want to enter the loop when $client is defined and a valid integer,
use if ( defined $client && $client =~ /^-?\d+$/ ).
I assume it's an integer from the context, if it can be a float, the regex needs to be enhanced - there's a standard Perl library containing pre-canned regexes, including ones to match floats. If you require a non-negative int, drop -? from regex's start.
If you want to enter the loop when $client is defined and a non-zero (and assuming it shouldn't ever be an empty string),
use if ( $client ).
If you want to enter the loop when $client is defined and a valid non-zero int,
use if ( $client && $client =~ /^-?\d+$/ ).
Your #ids is "undef" when if condition is false, which may break the code later on if it relies on #ids being an array. Since you didn't actually specify how the script breaks without an else, this is the most likely cause.
Please see if this version works (use whichever "if" condition from above you need, I picked the last one as it appears to match the closest witrh the original code's intent - only enter for non-zero integers):
UPDATED CODE WITH DEBUGGING
use Data::Dumper;
open(my $tmp_file, ">", "/tmp/some_bad.log") or die "Can not open log file: $!\n";
#ids = (); # Do this first so #ids is always an array, even for non-client!
print $tmp_file "Before the if: ". Data::Dumper->Dump([\#ids, $client]) . "\n";
if ( $client && $client =~ /^-?\d+$/ ) # First expression catches undef and zero
{
print $tmp_file "Start the if: ". Data::Dumper->Dump([\#ids, $client]) . "\n";
my $st = &sql_query("select id from table where client=$client");
print $tmp_file "Before the while loop: ref(st)='". ref($st) . "'\n";
while(my $row = $st->fetchrow())
{
print $tmp_file "Row the while loop: ". Data::Dumper->Dump([row]) . "'\n";
push(#ids, $row->[0]);
}
print $tmp_file "After the while loop: ref(st)='". ref($st) . "'\n";
# No need to undef since both variables are lexically in this block only
}
print $tmp_file "After the if\n";
close($tmp_file) or die "Can not close file: $!\n";
when checking against a string, == and != should be respectively 'eq' or 'ne'
if( $client != "" )
should be
if( $client ne "" )
Otherwise you don't get what you're expecting to get.
Always begin your script with :
use warnings;
use strict;
these will give you usefull informations.
Then you could write :
my #ids;
if (defined $client) {
#ids = (); # not necessary if you run this part only once
my $st = sql_query("select id from table where client=$client");
while( my ($id) = $st->fetchrow ) {
push #ids, $id;
}
} else {
warn '$client not defined';
}
if (#ids) { # Your query returned something
# do stuff with #ids
} else {
warn "client '$client' does not exist in database";
}
Note: this answer was deleted because I consider that this is not a real question. I am undeleting it to save other people repeating this.
Instead of
if( $client != "" )
try
if ($client)
Also, Perl debugging is easier if you
use warnings;
use strict;
What I found is that this code is at the end of the main code in the locallib.pl after this there are sub definitions, and locallib.pl is a library not a program file, so it's last statement must returns true, a simple 1; statement at the end of the library ensures that (put it after sub definitions to ensure that noobody writes code in the main after the 1;) and the problem was fixed.
The conclusion:
I have learned that every time you write a library or modify one, ensure that it's last statment returns true;
Oh my... Try this as an example instead...
# Move the logic into a subroutine
# Forward definition so perl knows func exists
sub getClientIds($);
# Call subroutine to find id's - defined later.
my #ids_from_database = &getClientIds("Joe Smith");
# If sub returned an empty list () then variable will be false.
# Otherwise, print each ID we found.
if (#ids_from_database) {
foreach my $i (#ids_from_database) {
print "Found ID $i \n";
}
} else {
print "Found nothing! \n";
}
# This is the end of the "main" code - now we define the logic.
# Here's the real work
sub getClientIds($) {
my $client = shift #_; # assign first parameter to var $client
my #ids = (); # what we will return
# ensure we weren't called with &getClientIds("") or something...
if (not $client) {
print "I really need you to give me a parameter...\n";
return #ids;
}
# I'm assuming the query is string based, so probably need to put it
# inside \"quotes\"
my $st = &sql_query("select id from table where client=\"$client\"");
# Did sql_query() fail?
if (not $st) {
print "Oops someone made a problem in the SQL...\n";
return #ids;
}
my #result;
# Returns a list, so putting it in a list and then pulling the first element
# in two steps instead of one.
while (#result = $st->fetchrow()) {
push #ids, $result[0];
}
# Always a good idea to clean up once you're done.
$st->finish();
return #ids;
}
To your specific questions:
If you want to test if $client is defined, you want "if ( eval { defined $client; } )", but that's almost certainly NOT what you're looking for! It's far easier to ensure $client has some definition early in the program (e.g. $client = "";). Also note Kaklon's answer about the difference between ne and !=
if (X) { stuff } else { } is not valid perl. You could do: if (X) { stuff } else { 1; } but that's kind of begging the question, because the real issue is the test of the variable, not an else clause.
Sorry, no clue on that - I think the problem's elsewhere.
I also echo Kinopiko in recommending you add "use strict;" at the start of your program. That means that any $variable #that %you use has to be pre-defined as "my $varable; my #that; my %you;" It may seem like more work, but it's less work than trying to deal with undefined versus defined variables in code. It's a good habit to get into.
Note that my variables only live within the squiggliez in which they are defined (there's implicit squiggliez around the whole file:
my $x = 1;
if ($x == 1)
{
my $x = 2;
print "$x \n"; # prints 2. This is NOT the same $x as was set to 1 above.
}
print "$x \n"; # prints 1, because the $x in the squiggliez is gone.
Before posting my question to the ActiveState forum, I'd like to try luck here :)
I'm trying to convert a simple script of mine to .exe file using Perlapp (version 8.1). The Perl script works fine and it seems Perlapp also did its job successfully.
But the converted .exe file has some weird behavior, which, I believe, must be related to utf-8 encoding. For example, the Perl script would yield the result like:
hàn huáng zhòng sè sī qīng guó
But running the executable file would give me only this:
h hu zh s s q gu
I've already configured Perlapp so that utf8.pm is explicitly added but the problem just refuses to go away. I've tried something else. For example,
binmode DATA, ":utf8";
and
">:encoding(utf8)"
but without any luck;
Can anyone kindly give me some hint as to what might be the reason? Thanks like always :)
I can post the whole code here but it seems unnecessary so I just paste some snippets of the code that I think is relevant to the problem:
use utf8;
%zidian = map {chomp;split/\s+/,$_,2} <DATA>;
open my $in,'<:utf8',"./original.txt";
open my $out,'>:utf8',"./modified.txt";
if ( $code~~%zidian) {
$value = lc$zidian{$code};
}
__DATA__
3400 Qiū
3401 TIǎN
3404 KUà
3405 Wǔ
And one more thing, I'm running ActivePerl 5.10.0.on Windows XP (Chinese Version) and the script is saved as utf-8 encoding without BOM. PerlApp cannot handle a script that has BOM.
Edit
If I were to give a workable snippet, then I suppose it's like giving the whole code because I'm using three inter-connected sub-routines, which I take with some modifications from Lingua::han::Pinyin module and Lingua::han::Utils module.
#! perl
# to make good vertical alignment,
# set font family to SonTi and font size to Four(12pts)
use utf8;
sub Unihan {
my $hanzi = shift;
my #unihan = map { uc sprintf("%x",$_) } unpack ("U*", $hanzi);
}
sub csplit {
my $hanzi = shift;
my #return_hanzi;
my #code = Unihan($hanzi);
foreach my $code (#code) {
my $value = pack("U*", hex $code);
push #return_hanzi, $value if ($value);
}
return wantarray ? #return_hanzi : join( '', #return_hanzi );
}
%zidian = map {chomp;split/\s+/,$_,2} <DATA>;
sub han2pinyin {
my $hanzi = shift;
my #pinyin;
my #code = Unihan($hanzi);
foreach $code (#code) {
if ( $code~~%zidian) {
$value = lc$zidian{$code};
}
else {
$value = " ";
}
push #pinyin, $value;
}
return wantarray ? #pinyin : join( '', #pinyin );
}
open $in,'<:utf8',"./original.txt";
seek $in, 3,0;
open $out,'>:utf8',"./modified.txt";
while(<$in>){
s/(.{18})/$1\n/g;
push #tmp, $_;
}
foreach (#tmp){
my #hanzi;
my #pinyin;
#hanzi = csplit($_);
my $hang = join "", #hanzi;
#pinyin = han2pinyin($hang);
for ( my $i = 0; $i < #hanzi && $i < #pinyin; ++$i ) {
if ( $hanzi[$i] =~ /[\xEFBC8C]|[\xE38082]|[\xEFBC81]|[\xEFBC9F]|[\xE2809C]|[\xE2809D]|[\xEFBC9A]/ ) {
splice(#pinyin, $i, 0," ");
}
}
printf $out "%-7s" x #pinyin, #pinyin;
print $out "\n";
printf $out "%-6s" x #hanzi, #hanzi;
print $out "\n";
}
__DATA__
3400 Qiū
3401 TIǎN
3404 KUà
3405 Wǔ
ActiveState hasn't given me any help yet. Whatever. Now I've figured out a workaround for my problem and this workaround looks very weird.
First I added some otherwise useless utf-8 encoded characters to my DATA section, like the following:
__DATA__
aardvark 'ɑ:dvɑ:k
aardwolf 'ɑ:dwulf
aasvogel 'ɑ:sfәugәl
3400 Qiū
3401 TIǎN
3404 KUà
3405 Wǔ
And then I removed the use utf8; pragma from my script;
and then I removed the utf8 flag from the following line of code:
open $out,'>:utf8',"./modified.txt";
Now it becomes
open $out,'>',"./modified.txt";
But I had to let the following line of code unchanged:
open $in,'<:utf8',"./original.txt";
Then everything was okay except that I'd receive "wide characters in print" warnings. But I added another line of code:
no warnings;
And then I Perlapped my script and everything worked fine :)
This is really strange. I'm suspecting this problem is somehow OS specific. It's also quite likely that there's something wrong with my Windows system. And I also tried Perl2exe and the compiled executable gave me some "memory 0010c4 cannot be read" error. Whatever. My problem is somehow fixed by myself :)