perl ASCII 码 处理日文或中文字

#!/usr/bin/perl -w
use strict;
use warnings;
#binmod(utf8);

my @strings = qw(
!?
@
#
$
%
^
&
*
(
)
{
}
[
]
`
;
:
\'
"
?
<
>
,
.
/
\
|
-
+
_
=
！
＠
＃
＄
％
＾
＆
＊
（
）
｛
｝
「
」
‘
；
：

”
？
＜
＞
、
。
?
￥
｜
ー
＋
＿
＝
【
】
［
］
);

my @char=qw(
1个好人
$
<＋
<
);

my $Count=0;
my %hashmap;
my @ascii_character_numbers;
foreach(@strings)
{
@ascii_character_numbers = unpack("C*", "$_");
my $temp= "@ascii_character_numbers";
$hashmap{$temp}=$temp;
}

foreach my $k ( keys %hashmap )
{print $k,"-\t-";}

if (exists($hashmap{'163 189'})) {
#print " it exists \n";
}
print "*"x50,"\n";
my @ascii_characters;
foreach my $char (@char)
{
@ascii_characters = unpack("C*", "$char");
#print "@ascii_characters\n";
print "-"x50,"\n";
my @real=();
my $i=0;
while($i<=scalar(@ascii_characters))
{
#print $ascii_characters[$i],"\n";
if ($ascii_characters[$i]>127){
#print "是一个多字节字\n";
my $tt = $ascii_characters[$i]." ".$ascii_characters[$i+1];
push @real,$tt;
$i+=2;
}
else{
#print "是一个单字节字\n";
push @real,$ascii_characters[$i];
$i++;
}
if ($i==(scalar(@ascii_characters))) {
print "start to print real ary\n";
print join "\n",@real,"\n";
foreach my $key (@real){
if (!exists($hashmap{$key}))
{
print "No\n";
}
else{
print "YES\n";
$Count++;
}
}


}


}


}

print "All: $Count\n";

-------
下午有空做了修改
sub Check_Have_Defined{
# IN two argus: 1.productid 2.productname
# OUT 0: 所有字符都在字符列表中 1：有不在列表中的字符
my ( $pid, $pname ) = @_;
#print "$pid\t\t$pname\n";
my @ascii_characters = unpack("C*", "$pname");

my @real=();
my $i=0;
my $sign=0;
while($i<=scalar(@ascii_characters))
{
if ($ascii_characters[$i]>127){
#print "是一个多字节字\n";
my $tt = $ascii_characters[$i]." ".$ascii_characters[$i+1];
push @real,$tt;
$i+=2;
}
else{
#print "是一个单字节字\n";
push @real,$ascii_characters[$i];
$i++;
} #end else

if ($i==(scalar(@ascii_characters))){
#print "start to print real ary\n";
#print join "\n",@real,"\n";
foreach my $key (@real)
{
#print $key,"\n";
if (!exists($hashmap{$key}))
{
$sign++;
}
}
} #end if
} # while

#print "====== $sign =======\n";
if ($sign == 0)
{
#print "符合，所有字符在特殊列表中\n";
return 1;
}
else{
#print "不符合\n";
return 0;
}


} # sub

写成函数

调用:
use DBI;
my $host = "192.168.117.161";
my $db = "FrontEnd";
my $user = "dev";
my $passwd = "hereiserror";

my $Report="REPORT";
open(FHD,">$Report") || die "Can't write file";

my $dbh = DBI->connect("DBI:mysql:database=$db;host=$host",$user,$passwd) or die "connecting : $DBI::errstr\n";
my $sth;
my @chids = qw/50 56 57 58 59 60/;
my $Count=0;

foreach my $chid (@chids)
{
print FHD "ChannelID : $chid \n";
my $SQL=qq(select productid,name from C${chid}Product);
$sth = $dbh->prepare($SQL) or die "Can't prepare : $dbh->errstr\n";
$sth->execute();

while(my @array = $sth->fetchrow_array() ) {
my $needed = Check_Have_Defined($array[0],$array[1]);
if ($needed==1)
{
print FHD "ProductID: $array[0]\t ProductName: $array[1]\n";
$Count++;
}
}
}
print FHD "All: $Count\n";

perl找出需要的串

#!/usr/bin/perl -w
use DBI;
use strict;

my $host = "192.168.10.118";
my $db = "BE";
my $user = "dev";
my $passwd = "3h8hs3";

my $Report="SPREPORT";
my $Rep="tempEPORT";
open(FHD,">$Report") || die "Can't write file";

open(HD,">$Rep") || die "Can't write file";

my $dbh = DBI->connect("DBI:mysql:database=$db;host=$host",$user,$passwd) or die "connecting : $DBI::errstr\n";
my $sth;


my @chids = qw/2 3 4 5 6 7 8 9 10/;
my @sum;
my %hm;
while()
{
chomp($_);
$hm{$_}=$_;
}

foreach my $chid (@chids)
{
print FHD "ChannelID : $chid \n";
print FHD "="x40,"\n";
my $SQL=qq(select productid,name from C${chid}Product);
#print "$SQL\n";
$sth = $dbh->prepare($SQL) or die "Can't prepare : $dbh->errstr\n";
$sth->execute();

my $productid;
my $name;

my $i = 0;
my $j = 0;
while(my @array = $sth->fetchrow_array() )
{
$productid=$array[0];nn
$name=$array[1];
chomp($name);
if ($productid==2536882) {
print "HERE\n";
}
if($name=~/^([!@#\$\%\^&*(){}\[\]`;:\'\"?<>,.\/\\|\-+_=])+$/)
{
$i++;
$j++;
print FHD "3. Sep characters ProductID:$productid \t Name:$name\n";
}
else{
my @sp = split //,$name;
my $sign=0;
foreach(@sp)
{
chomp($_);
$sign++ if ! exists $hm{$_};
}
if ($sign==0)
{
$i++;
$j++;
print FHD "3. Sep characters ProductID:$productid \t Name:$name\n";
}
else
{
$j++;
print HD " $j \n";
}
}
}
print FHD "ChannelID :$chid \t Count: $i\n";
push @sum,$i;
}

print "@sum\n";

$sth->finish();
$dbh->disconnect();


__DATA__
！
＠
＃
＄
％
＾
＆
＊
（
）
｛
｝
「
」
‘
；
：

”
？
＜
＞
、
。
・
￥
｜
ー
＋
＿
＝
【
】
［
］

处理xml一例

#!/usr/bin/perl
use strict;
use XML::Simple;
use Data::Dumper;
use warnings;

my $xmlfile = $ARGV[0];
my $ref = XMLin("$xmlfile",ForceArray=>1);
my $xmlname = `basename $xmlfile`;

my $Country ;
($Country = $xmlname ) =~ s/-\d+\.xml//g;
chop($Country);

my %prodprophash = (
"de" => "Produkteigenschaften",
"uk" => "Product properties",
"ca" => "Product properties",
"us" => "Product properties",
"es" => "Product properties",
"fr" => "Caract.ristiques du produit");

my $PROPerty = $prodprophash{"$Country"};
my $errnum = 0;my $warnnum = 0;
foreach (@{$ref->{'product'}}){
print "="x25,"\n";
print "Country : \"",$Country,"\"\n";
print "category id:";
print $_->{'category-id'}->[0],"\n";
print "Product id :"; print $_->{id}->[0],"\n";
my $ImgCheck="N";
my $ImgCheck="N";
if (exists($_->{'image-url'}->[0] ) )
{
if( !( ($_->{'image-url'}->[0]->{'content'} ne "") && ($_->{'image-url'}->[0]->{'content'} =~ /^http:\/\/www.abc.com\/product/)) )
...

[ array标记
{ hash标记

外层用SHELL调用
在特定目录下，循环利用 0000~0029 目录，利用一个文件来保存最后写入的文件夹名称

if [ x"$2" != x ]
then
tmpdir="$2"
downloadXml="N"
else
downloadXml="Y"

if ! [ -d "$batchDir" ]
then
mkdir -p "$batchDir"
echo "0" > "$batchDir"/lastBatchId.txt
fi

temp=$(expr $(cat "$batchDir"/lastBatchId.txt) + 1)
batchId=$(expr $temp % 30 )
batchIdDir=$(printf "%04d" $batchId)

if [ -d "$batchDir"/"$batchIdDir" ]
then
rm -rf "$batchDir"/"$batchIdDir"
fi

mkdir -p "$batchDir"/"$batchIdDir"
echo $(expr $batchId) > "$batchDir"/lastBatchId.txt

tmpdir="$batchDir"/"$batchIdDir"
fi

有趣的perl

引用《大骆驼》中那一个例子：jacob has four wives

将一个列表当成一个标量 []
$wife{"Jacob"} = ["Leah", "Rachel", "Bilhah", "Zilpah"];
$wife{"Jacob"}[0] = "Leah";
$wife{"Jacob"}[1] = "Rachel";
$wife{"Jacob"}[2] = "Bilhah";
$wife{"Jacob"}[3] = "Zilpah";

every wife has her own kids
将散列结构也当成一个标量 {}
$kids_of_wife{"Jacob"} = {
"Leah" => ["Reuben", "Simeon", "Levi", "Judah", "Issachar", "Zebulun"],
"Rachel" => ["Joseph", "Benjamin"],
"Bilhah" => ["Dan", "Naphtali"],
"Zilpah" => ["Gad", "Asher"],
};

$kids_of_wife{"Jacob"}{"Leah"}[0] = "Reuben";
$kids_of_wife{"Jacob"}{"Leah"}[1] = "Simeon";
$kids_of_wife{"Jacob"}{"Leah"}[2] = "Levi";
$kids_of_wife{"Jacob"}{"Leah"}[3] = "Judah";
$kids_of_wife{"Jacob"}{"Bilhah"}[1] = "Naphtali";
$kids_of_wife{"Jacob"}{"Zilpah"}[0] = "Gad";
$kids_of_wife{"Jacob"}{"Zilpah"}[1] = "Asher";

为了启动的纪念 perl 正则

有时想不起来，记一下：（源自perl by example edition 4）

Character Class: Single Characters and Digits
.	Matches any character except a newline
[a–z0–9]	Matches any single character in set
[^a–z0–9]	Matches any single character not in set
\d	Matches one digit
\D	Matches a nondigit, same as [^0–9]
\w	Matches an alphanumeric (word) character
\W	Matches a nonalphanumeric (nonword) character
Character Class: Whitespace Characters
\s	Matches a whitespace character, such as spaces, tabs, and newlines
\S	Matches nonwhitespace character
\n	Matches a newline
\r	Matches a return
\t	Matches a tab
\f	Matches a form feed
\b	Matches a backspace
\0	Matches a null character
Character Class: Anchored Characters
\b	Matches a word boundary (when not inside [ ])
\B	Matches a nonword boundary
^	Matches to beginning of line
$	Matches to end of line
\A	Matches the beginning of the string only
\Z	Matches the end of the string or line
\z	Matches the end of string only
\G	Matches where previous m//g left off
Character Class: Repeated Characters
x?	Matches 0 or 1 x
x*	Matches 0 or more occurrences of x
x+	Matches 1 or more occurrences of x
(xyz)+	Matches 1 or more patterns of xyz
x{m,n}	Matches at least m occurrences of x and no more than n occurrences of x
Character Class: Alternative Characters
was|were|will	Matches one of was, were, or will
Character Class: Remembered Characters
(string)	Used for backreferencing
\1 or $1	Matches first set of parentheses
\2 or $2	Matches second set of parentheses
\3 or $3	Matches third set of parentheses
Character Class: Miscellaneous Characters
\12	Matches that octal value, up to \377
\x811	Matches that hex value
\cX	Matches that control character; e.g., \cC is -C and \cV is -V
\e	Matches the ASCII ESC character, not backslash
\E	Marks the end of changing case with \U, \L, or \Q
\l	Lowercase the next character only
\L	Lowercase characters until the end of the string or until \E
\N	Matches that named character; e.g., \N{greek:Beta}
\p{PROPERTY}	Matches any character with the named property; e.g., \p{IsAlpha}/
\P{PROPERTY}	Matches any character without the named property
\Q	Quote metacharacters until \E
\u	Titlecase next character only
\U	Uppercase until \E
\x{NUMBER}	Matches Unicode NUMBER given in hexadecimal
\X	Matches Unicode "combining character sequence" string
\[	Matches that metacharacter
\\	Matches a backslash