perl 加载文本文件

显示如何加载文本文件

<a href="http://perldoc.perl.org/functions/open.html"><span style="color: #000066;">open</span></a><span style="color: #66cc66;">&#40;</span>TEST, <span style="color: #ff0000;">&quot;test.txt&quot;</span><span style="color: #66cc66;">&#41;</span>;
<span style="color: #b1b100;">while</span> <span style="color: #66cc66;">&#40;</span><span style="color: #009999;">&lt;TEST&gt;</span><span style="color: #66cc66;">&#41;</span><span style="color: #66cc66;">&#123;</span>
&nbsp;
    <span style="color: #808080; font-style: italic;"># print the current line</span>
    <a href="http://perldoc.perl.org/functions/print.html"><span style="color: #000066;">print</span></a> <span style="color: #ff0000;">&quot;$_&lt;br&gt;&quot;</span>;
&nbsp;
<span style="color: #66cc66;">&#125;</span>
<a href="http://perldoc.perl.org/functions/close.html"><span style="color: #000066;">close</span></a><span style="color: #66cc66;">&#40;</span>TEST<span style="color: #66cc66;">&#41;</span>;

perl LWP请求示例

显示如何加载文本文件<br/> <br/>另一个好资源:<a href=\"http://www.oreilly.com/openbook/webclient/ch06.html\">使用Perl进行Web客户端编程</ a>(oreilly.com)。

<span style="color: #808080; font-style: italic;"># load LWP library:</span>
<span style="color: #000000; font-weight: bold;">use</span> LWP::<span style="color: #006600;">UserAgent</span>;
<span style="color: #000000; font-weight: bold;">use</span> HTML::<span style="color: #006600;">Parse</span>;
&nbsp;
<span style="color: #808080; font-style: italic;"># define a URL</span>
<span style="color: #b1b100;">my</span> <span style="color: #0000ff;">$url</span> = <span style="color: #ff0000;">'http://www.jonasjohn.de'</span>;
&nbsp;
<span style="color: #808080; font-style: italic;"># create UserAgent object</span>
<span style="color: #b1b100;">my</span> <span style="color: #0000ff;">$ua</span> = <span style="color: #000000; font-weight: bold;">new</span> LWP::<span style="color: #006600;">UserAgent</span>;
&nbsp;
<span style="color: #808080; font-style: italic;"># set a user agent (browser-id)</span>
<span style="color: #808080; font-style: italic;"># $ua-&gt;agent('Mozilla/5.5 (compatible; MSIE 5.5; Windows NT 5.1)');</span>
&nbsp;
<span style="color: #808080; font-style: italic;"># timeout:</span>
<span style="color: #0000ff;">$ua</span>-&gt;<span style="color: #006600;">timeout</span><span style="color: #66cc66;">&#40;</span><span style="color: #cc66cc;">15</span><span style="color: #66cc66;">&#41;</span>;
&nbsp;
<span style="color: #808080; font-style: italic;"># proceed the request:</span>
<span style="color: #b1b100;">my</span> <span style="color: #0000ff;">$request</span> = HTTP::<span style="color: #006600;">Request</span>-&gt;<span style="color: #006600;">new</span><span style="color: #66cc66;">&#40;</span><span style="color: #ff0000;">'GET'</span><span style="color: #66cc66;">&#41;</span>;
<span style="color: #0000ff;">$request</span>-&gt;<span style="color: #006600;">url</span><span style="color: #66cc66;">&#40;</span><span style="color: #0000ff;">$url</span><span style="color: #66cc66;">&#41;</span>;
&nbsp;
<span style="color: #b1b100;">my</span> <span style="color: #0000ff;">$response</span> = <span style="color: #0000ff;">$ua</span>-&gt;<span style="color: #006600;">request</span><span style="color: #66cc66;">&#40;</span><span style="color: #0000ff;">$request</span><span style="color: #66cc66;">&#41;</span>;
&nbsp;
&nbsp;
<span style="color: #808080; font-style: italic;">#</span>
<span style="color: #808080; font-style: italic;"># responses:</span>
<span style="color: #808080; font-style: italic;">#</span>
&nbsp;
<span style="color: #808080; font-style: italic;"># response code (like 200, 404, etc)</span>
<span style="color: #b1b100;">my</span> <span style="color: #0000ff;">$code</span> = <span style="color: #0000ff;">$response</span>-&gt;<span style="color: #006600;">code</span>;
&nbsp;
<span style="color: #808080; font-style: italic;"># headers (Server: Apache, Content-Type: text/html, ...)</span>
<span style="color: #b1b100;">my</span> <span style="color: #0000ff;">$headers</span> = <span style="color: #0000ff;">$response</span>-&gt;<span style="color: #006600;">headers_as_string</span>;
&nbsp;
<span style="color: #808080; font-style: italic;"># HTML body:</span>
<span style="color: #b1b100;">my</span> <span style="color: #0000ff;">$body</span> =  <span style="color: #0000ff;">$response</span>-&gt;<span style="color: #006600;">content</span>;
&nbsp;
&nbsp;
&nbsp;
<span style="color: #808080; font-style: italic;"># print the website content:</span>
<span style="color: #808080; font-style: italic;"># print $body;</span>
&nbsp;
&nbsp;
<span style="color: #808080; font-style: italic;"># do some parsing:</span>
&nbsp;
<span style="color: #b1b100;">my</span> <span style="color: #0000ff;">$parsed_html</span> = HTML::<span style="color: #006600;">Parse</span>::<span style="color: #006600;">parse_html</span><span style="color: #66cc66;">&#40;</span><span style="color: #0000ff;">$body</span><span style="color: #66cc66;">&#41;</span>;
<span style="color: #b1b100;">for</span> <span style="color: #66cc66;">&#40;</span>@<span style="color: #66cc66;">&#123;</span> <span style="color: #0000ff;">$parsed_html</span>-&gt;<span style="color: #006600;">extract_links</span><span style="color: #66cc66;">&#40;</span><a href="http://perldoc.perl.org/functions/qw.html"><span style="color: #000066;">qw</span></a><span style="color: #66cc66;">&#40;</span>a body img<span style="color: #66cc66;">&#41;</span><span style="color: #66cc66;">&#41;</span> <span style="color: #66cc66;">&#125;</span><span style="color: #66cc66;">&#41;</span> <span style="color: #66cc66;">&#123;</span>
&nbsp;
    <span style="color: #808080; font-style: italic;"># extract all links (a, body, img)</span>
    <span style="color: #b1b100;">my</span> <span style="color: #66cc66;">&#40;</span><span style="color: #0000ff;">$link</span><span style="color: #66cc66;">&#41;</span> = <span style="color: #0000ff;">@$_</span>;
&nbsp;
    <span style="color: #808080; font-style: italic;"># print link:</span>
    <a href="http://perldoc.perl.org/functions/print.html"><span style="color: #000066;">print</span></a> <span style="color: #0000ff;">$link</span> . <span style="color: #ff0000;">&quot;<span style="color: #000099; font-weight: bold;">\n</span>&quot;</span>;
<span style="color: #66cc66;">&#125;</span>

perl Opendir的例子

显示如何加载和显示目录的内容

<span style="color: #808080; font-style: italic;"># load all files of the &quot;data/&quot; folder</span>
<span style="color: #808080; font-style: italic;"># into the @files array</span>
<a href="http://perldoc.perl.org/functions/opendir.html"><span style="color: #000066;">opendir</span></a><span style="color: #66cc66;">&#40;</span>DIR, <span style="color: #ff0000;">&quot;data/&quot;</span><span style="color: #66cc66;">&#41;</span>;
<span style="color: #0000ff;">@files</span> = <a href="http://perldoc.perl.org/functions/readdir.html"><span style="color: #000066;">readdir</span></a><span style="color: #66cc66;">&#40;</span>DIR<span style="color: #66cc66;">&#41;</span>;
<a href="http://perldoc.perl.org/functions/closedir.html"><span style="color: #000066;">closedir</span></a><span style="color: #66cc66;">&#40;</span>DIR<span style="color: #66cc66;">&#41;</span>;
&nbsp;
&nbsp;
<span style="color: #808080; font-style: italic;"># build a unsorted list from the </span>
<span style="color: #808080; font-style: italic;"># @files array:</span>
&nbsp;
<a href="http://perldoc.perl.org/functions/print.html"><span style="color: #000066;">print</span></a> <span style="color: #ff0000;">&quot;&lt;ul&gt;&quot;</span>;
&nbsp;
<span style="color: #b1b100;">foreach</span> <span style="color: #0000ff;">$file</span> <span style="color: #66cc66;">&#40;</span><span style="color: #0000ff;">@files</span><span style="color: #66cc66;">&#41;</span> <span style="color: #66cc66;">&#123;</span>
    <span style="color: #b1b100;">next</span> <span style="color: #b1b100;">if</span> <span style="color: #66cc66;">&#40;</span><span style="color: #0000ff;">$file</span> eq <span style="color: #ff0000;">&quot;.&quot;</span> <span style="color: #b1b100;">or</span> <span style="color: #0000ff;">$file</span> eq <span style="color: #ff0000;">&quot;..&quot;</span><span style="color: #66cc66;">&#41;</span>;
    <a href="http://perldoc.perl.org/functions/print.html"><span style="color: #000066;">print</span></a> <span style="color: #ff0000;">&quot;&lt;li&gt;&lt;a href=<span style="color: #000099; font-weight: bold;">\&quot;</span>$file<span style="color: #000099; font-weight: bold;">\&quot;</span>&gt;$file&lt;/a&gt;&lt;/li&gt;&quot;</span>;
<span style="color: #66cc66;">&#125;</span>
&nbsp;
<a href="http://perldoc.perl.org/functions/print.html"><span style="color: #000066;">print</span></a> <span style="color: #ff0000;">&quot;&lt;/ul&gt;&quot;</span>;

perl PERL ONE LINERS

PERL ONE LINERS:perlgrepsedawk.pl :: PERL - 喜欢grep / sed / awk #perl

perlgrepsedawk.pl
###################################
#
#	1. Text finding (normal)
		perl -ne 'print if /111/' testperloneliner.txt
		cat testfile | perl -ne 'print if /111/'
		perl -ne '/111/ and print' testfile
		
#   2. Text finding (with regex)
		perl -ne 'print if /\d/' testperloneliner.txt
		cat testfile | perl -ne 'print if /\d/'
		perl -ne '/\d/ and print' testperloneliner.txt
		
#   3. Text finding (inverse)
		perl -ne 'print if not /\d/' testperloneliner.txt
		cat testfile | perl -ne 'print if not /\d/'
		perl -ne '/111/ or print' testperloneliner.txt
		
#	4. Text finding (with condition substring)
		perl -ne 'print if not substr($_, 1, 3)==111' testperloneliner.txt
		cat testfile | perl -ne 'print if not substr($_, 1, 3)==111'
		perl -ne 'substr($_, 1, 3)==111 or print' testperloneliner.txt

#
#	1. Text Substitution (normal)
		cat | perl -pe 's/pattern/replacement/flags'
		perl -pe 's/pattern/replacement/flags' filein > fileot
		
		
#	2. Text Substitution (with regex)
		cat testfilein | perl -pe 's/$/\t2/' (one match) 
		cat testfilein | perl -pe 's/$/\t2/g' testfilein (all matches)
		perl -pe 's/$/\t2/' testfilein	(one match) 
		perl -pe 's/$/\t2/g' testfilein (all matches)
		
#   3. Text Substitution (with regex and regex match condition )
		cat testfilein | perl -pe 's/\t/888888/g if /\d/' 
		cat testfilein | perl -pe 's/22222222222222222/888888/g if not /111/' 
		cat testfilein | perl -pe 's/33333333333333333/888888/g if not /\d' 
		cat testfilein | perl -pe 's/33333333333333333/888888/g if not /\d/' 
		perl -pe 's/\t/888888/g if /\d/' testperloneliner.txt
		perl -pe 's/22222222222222222/888888/g if not /111/' testperloneliner.txt
		perl -pe 's/33333333333333333/888888/g if not /\d' testperloneliner.txt
		perl -pe 's/33333333333333333/888888/g if not /\d/' testperloneliner.txt
				
#   4. Text Substitution (with text and substring match)
		cat testfilein | perl -pe 's/\t/888888/g if not substr($_ , 1, 3)==111'
		cat testfilein | perl -pe 's/22222222/888888/g if substr($_ , 1, 3)==111
		perl -pe 's/\t/888888/g if not substr($_ , 1, 3)==111' testperloneliner.txt
		perl -pe 's/22222222/888888/g if substr($_ , 1, 3)==111' testperloneliner.txt
				
#   5. Text Substitution (Above ex. with inverse condition)
		perl -pe 's/\t/888888/g if not substr($_ , 1, 3)==111' testperloneliner.txt
		perl -pe 's/22222222/888888/g if substr($_ , 1, 3)==111' testperloneliner.txt
		perl -pe 's/\t/888888/g if /\d/' testperloneliner.txt
		perl -pe 's/22222222222222222/888888/g if not /111/' testperloneliner.txt




#
#   0. Print specific field, no delimiter. (default delim space)
		perl -lane 'print @F[0]' file_in
		cat file_in | perl -lane 'print @F[0]'
		
#	1. Print specific field, with delimiter (input) - (delim -F)
		perl -F: -lane 'print @F[0]' file_in
		cat file_in | perl -F: -lane 'print @F[0]'

#	1.2 Print specific fields, with no delimiter. (default delim space)
		perl -F: | perl -lane 'print @F[0,1,2]' file_in 
		cat file_in | perl -F: -lane 'print @F[0,1,2]
		
#   1.5 Print fields with specific input and output delimiter 
		perl -F; -lane "BEGIN {$, = ';'} print @F[0,1]" file_in 
		cat file_in | perl -F; -lane 'BEGIN {$, = ';'} print @F[0,1]'
		cat file_in | perl -F';' -lane 'BEGIN {$, = ';'} print @F[0,1]'
		cat file_in | perl -F(';') -lane 'BEGIN {$, = ';'} print @F[0,1]'
		
#	2. Print specific substring of line
		perl -F; -lanE "print substr($_, 1, 2)" testperloneliner.txt
		cat file_in | perl -F; -lanE "print substr($_, 1, 2)"
				
#   3. Print specific substring of field 
		perl -F; -lanE "print substr(@F[1], 1, 2)" testperloneliner.txt
		cat file_in | perl -F: -lanE 'print substr(@F[1], 1, 2)' 
		 
#   3. Print specific fields with the same delimiter
		perl -MEnglish -F';' -lane 'BEGIN { $OFS = ";" } print @F[0,1,2] if substr(@F[0], 1, 3)==111' testperloneliner.txt
		
#   4. Print specific fields with diff delimiter
		perl -MEnglish -F';' -lane 'BEGIN { $OFS = "@" } print @F[0,1,2] if substr(@F[0], 1, 3)==111' testperloneliner.txt
		
#   5. Print specific fields with pattern match
		 perl -MEnglish -F';' -lane 'BEGIN { $OFS = ";" } print @F[0,1,2] if /111/' testperloneliner.txt
		 
#   6. Print specific fields with specific field match
		 perl -MEnglish -F';' -lane 'BEGIN { $OFS = ";" } print @F[0,1,2] if @F[0] eq 11111111111' testperloneliner.txt

#   7. Print specific fields with field substring match.
		perl -MEnglish -F';' -lane 'BEGIN { $OFS = ";" } print @F[0,1,2] if substr(@F[0], 1, 2) eq 11111111111' testperloneliner.txt

perl 检查数组是否包含

FunctionContains.pl
function contains() {
    local n=$#
    local value=${!n}
    for ((i=1;i < $#;i++)) {
        if [ "${!i}" == "${value}" ]; then
            echo "y"
            return 0
        fi
    }
    echo "n"
    return 1
}

perl kaggle提交示例

prl
kaggle competitions submit -c nyc-taxi-trip-duration -f PycharmProjects/PythonTraining/PyTraining/Datasets/submissions/trip_duration_average.csv -m "Message"

perl Perl - Getopt ::长例

使用Getopt :: Long传递更详细的参数和值

getOptLongExample
#!/usr/bin/perl

use strict;
use warnings;

use Getopt::Long qw(GetOptions);

my $action;

GetOptions("action=s" => \$action);

# some valid action we'll expect
if (not $action or $action !~ /^(create|insert|selecta|selecth)$/) {
    print <<"USAGE";
Usage:
      $0 --action create|insert|selecta|selecth

USAGE
    exit;
}

perl 从雅虎获取股票数据并将它们放入mysql数据库服务器

从雅虎获取股票数据并将它们放入mysql数据库服务器

scrape4_mysql.pl
#!/usr/bin/perl
use strict;
use warnings;
use Web::Scraper;
use URI;
use Encode;
# use Spreadsheet::WriteExcel;
use strict;
use warnings;
use utf8;
use String::Scanf;
use DBI;
# binmode STDIN, ':encoding(cp932)';
# binmode STDOUT, ':encoding(cp932)';
# binmode STDERR, ':encoding(cp932)';

my $time = time();

# my $thisDay = thisDay($time);
# my $prev50Day = prev50Day($time,12);

# my @start;
# my @end;

my @hajimari;
my @owari;

 $hajimari[5] = prev50Day($time,366);
 $owari[5] = prev50Day($time,306);
 $hajimari[4] = prev50Day($time,305);
 $owari[4] = prev50Day($time,245);
 $hajimari[3] = prev50Day($time,244);
 $owari[3] = prev50Day($time,184);
 $hajimari[2] = prev50Day($time,183);
 $owari[2] = prev50Day($time,123);
 $hajimari[1] = prev50Day($time,122);
 $owari[1] = prev50Day($time,62);
 $hajimari[0] = prev50Day($time,61);
 $owari[0]    = thisDay($time);
# my $start[0] = prev50day($time,185);
# my $end[0]   = prev50day($time,124);
# my $start[1] = prev50day($time,123);
# my $end[1]   = prev50day($time,62);
# my $start[2] = prev50day($time,61);
# my $end[2]   = thisday($time)

sub thisDay{
  my $time = shift || time();
  my $thisDay = $time ;
  my ($yyyy, $mm, $dd) = (localtime($thisDay))[5,4,3];

  $yyyy += 1900;
  $mm += 1;

  return(
    sprintf('%4d/%02d/%02d', $yyyy, $mm, $dd)
  );
}
sub prev50Day{
  my $time = shift || time();
  my $prevDay = $time - (24 * 60 * 60 * $_[0]);
  my ($yyyy, $mm, $dd) = (localtime($prevDay))[5,4,3];

  $yyyy += 1900;
  $mm += 1;

  return(
    sprintf('%4d/%02d/%02d', $yyyy, $mm, $dd)
  );
}

sub chghiduke{
   my $hiduke0 = shift;
#   my @hidu = split(/\年/,$hiduke0);
#   print $hidu[0];
   my $a;
   my $b;
   my $c;

   ($a,$b,$c)=sscanf('%d年%d月%d日',$hiduke0);
   print $a . $b . $c . "\n";
#   $hiduke0 =~ s/年/\//;
   return( 
    sprintf('%4d/%02d/%02d', $a,$b,$c)
   );
}
    # 新しいExcelワークブックの作成
#    my $workbook = Spreadsheet::WriteExcel->new("temp.xls");

my $dbuser="root";
my $dbpass="root";
my $dbname="stock_db";

my $dsn = "DBI:mysql:$dbname";
my $dsh = DBI -> connect ( $dsn, $dbuser, $dbpass , { RaiseError => 0 } );
my $sth;




# my @list = split(/\//, $thisDay );
# print $list[0]."\n";
# print $list[1]."\n";
# print $list[2]."\n";
#   print $list[3]."\n";

# my @list1 = split(/\//, $prev50Day );
# print $list1[0]."\n";
# print $list1[1]."\n";
# print $list1[2]."\n";

    # 新しいExcelワークブックの作成
    # my $workbook = Spreadsheet::WriteExcel->new("temp.xls");




open(IN,"zzz.txt");
while( my $Meigara0 = <IN> )
{
sleep(0.5);
chomp($Meigara0);

my @Meigara_list = split(/\,/,$Meigara0);
my $Meigara = $Meigara_list[0];
print encode('utf-8',$Meigara) . "\n";



    # ワークシートの追加
#    my $worksheet = $workbook->addworksheet($Meigara);
#    $worksheet->set_column('B:B', 18);
#    $worksheet->set_column('A:A', 18);
#    $worksheet->set_column('G:G', 12);

    #  書式の追加と定義
#    $format = $workbook->addformat(); # 書式の追加
#    $format->set_bold();
#a3    $format->set_color('red');
#    $format->set_align('center');

    # 行、列の書き方で書式付とそうでない文字列を出力
#    $col = $row = 0;
#    $worksheet->write($row, $col, "Hi Excel!", $format);
#    $worksheet->write(1,    $col, "Hi Excel!");

    # A1という書き方を使って、数字と式を出力
#    $worksheet->write('A3', 1.2345);
#    $worksheet->write('A4', '=SIN(PI()/4)');

# my $ws = scraper {
#  process
#    '//center/div[@class="invest"]/table[2]/tr[2]/td[3]',
#    meigara => [ 'text', sub { s/,//g } ];
#  process
#    '//center/div[@class="invest"]/table[2]/tr[2]/td[1]',
#    code => [ 'text', sub { s/,//g } ];
#  process
#    '//center/div[@class="invest"]/table[2]/tr[2]/td[5]/b',
#    price => [ 'text', sub { s/,//g } ];
#  process
#    '//center/div[@class="invest"]/table[2]/tr[2]/td[4]',
#    jikoku=> [ 'text', sub { s/,//g } ];
# };

# my $price = 0;
# my $jikoku;
# my $code;
# my $meigara;

# foreach my $stock(@STOCKS) {
# my $res =  $ws->scrape(URI->new('http://quote.yahoo.co.jp/q?s=' . $Meigara));
# $price = $res->{price};
# $jikoku = $res->{jikoku};
# print $jikoku . " " . $price . "\n";

my $i = 0;
my $j =0;
my $length;
for ( $i =5 ;$i >= 0 ; $i--){

my @list1 = split(/\//, $hajimari[$i] );
#  print $list1[0]."\n";
#  print $list1[1]."\n";
#  print $list1[2]."\n";

my @list = split(/\//, $owari[$i]);
#  print $list[0]."\n";
#  print $list[1]."\n";
#  print $list[2]."\n";
#   print $list[3]."\n";
print $hajimari[$i] . " - " . $owari[$i] . "\n";

my $scraper = scraper {
 process '//tr[@bgcolor="#ffffff"]/td[1]','sdata[]' => 'TEXT';
 process '//tr[@bgcolor="#ffffff"]/td[2]','svalue[]' => 'TEXT';
 process '//tr[@bgcolor="#ffffff"]/td[3]','hvalue[]' => 'TEXT';
 process '//tr[@bgcolor="#ffffff"]/td[4]','lvalue[]' => 'TEXT';
 process '//tr[@bgcolor="#ffffff"]/td[5]','evalue[]' => 'TEXT';
 process '//tr[@bgcolor="#ffffff"]/td[6]','mount[]' => 'TEXT';
 process '//tr[@bgcolor="#ffffff"]/td[7]','fvalue[]' => 'TEXT';
 process '//b[@class="yjXL"]','name' => 'TEXT';
};
  my $res = $scraper->scrape(URI->new("http://table.yahoo.co.jp/t?c=".$list1[0]."&a=".$list1[1]."&b=".$list1[2]."&f=".$list[0]."&d=".$list[1]."&e=".$list[2]."&g=d&s=".$Meigara.".t&y=0&z=&x=sb"));

 my @sdata = @{$res->{sdata}};
 my @svalue = @{$res->{svalue}};
 my @lvalue = @{$res->{lvalue}};
 my @hvalue = @{$res->{hvalue}};
 my @evalue = @{$res->{evalue}};
 my @amount = @{$res->{mount}};
 my @fvalue = @{$res->{fvalue}};
 my $name = $res->{name};
    $length = @svalue;

 my $hiduke = "日付";
#  $worksheet->write( 0 , 0, $name );
# $worksheet->write( 0 , 1, encode('utf-8',$hiduke ));
#  $worksheet->write( 0 , 1, $hiduke );
#  $worksheet->write( 0 , 2, "始値");
#  $worksheet->write( 0 , 3, "高値");
#  $worksheet->write( 0 , 4, "安値");
#  $worksheet->write( 0 , 5, "終値");
#  $worksheet->write( 0 , 6, "出来高");
#  $worksheet->write( 0 , 7, "修正値");
 for ( $_= 0; $_ < $length; $_++){
#  print $sdata[$_], ",", "\"";
#  print encode('utf-8',$sdata[$_]), ",", "\"";
#  print encode('utf-8',$svalue[$_]), "\"", ",", "\"","\n";
       $svalue[$_] =~ s/\,//g;
       $hvalue[$_] =~ s/\,//g;
       $lvalue[$_] =~ s/\,//g;
       $evalue[$_] =~ s/\,//g;
       $amount[$_] =~ s/\,//g;
       $fvalue[$_] =~ s/\,//g;


#  $worksheet->write($j + $length - $_ ,1, chghiduke($sdata[$_]));
#  $worksheet->write($j + $length - $_ ,2, $svalue[$_]);
#  $worksheet->write($j + $length - $_ ,3, $hvalue[$_]);
#  $worksheet->write($j + $length - $_ ,4, $lvalue[$_]);
#  $worksheet->write($j + $length - $_ ,5, $evalue[$_]);
#  $worksheet->write($j + $length - $_ ,6, $amount[$_]);
#  $worksheet->write($j + $length - $_ ,7, $fvalue[$_]);

  my $sql="insert into table_stock (hiduke,meigara,svalue,hvalue,lvalue,evalue,amount,fvalue) values ('" . chghiduke($sdata[$_]) . "','" . $Meigara . "','" . $svalue[$_] . "','" . $hvalue[$_] . "','" . $lvalue[$_] . "','" . $evalue[$_] . "','" . $amount[$_] . "','" . $fvalue[$_] . "');";
   $sth = $dsh->prepare($sql);
   $sth->execute;
  my $num_rows = $sth->rows;
  print "num_rows:" . $num_rows . "\n";
 }
 $j = $j + $length;
 }
# print $j . " " . $jikoku . " " . $price . "\n" ;
  # $worksheet->write($j + 1 ,1, $jikoku);
  # $worksheet->write($j + 1 ,5, $price);
}
close(IN);

$sth->finish;
$dsh -> disconnect;

perl JavaScript Bookmarklet Builder

JavaScript Bookmarklet Builder

make_bookmarklet.pl
#!/usr/bin/env perl
#
# http://daringfireball.net/2007/03/javascript_bookmarklet_builder

use strict;
use warnings;
use URI::Escape qw(uri_escape_utf8);
use open  IO  => ":utf8",		# UTF8 by default
		  ":std";				# Apply to STDIN/STDOUT/STDERR

my $source_code = do { local $/; <> };

# Zap the first line if there's already a bookmarklet comment:
$source_code =~ s{^// ?javascript:.+\n}{};

my $bookmarklet = $source_code;
for ($bookmarklet) {
	s{(^\s*//.+\n)}{}gm;		# Kill commented lines
	s{^\s*/\*.+?\*/\n?}{}gms;	# Kill block comments
	s{\t}{ }gm;					# Tabs to spaces
	s{[ ]{2,}}{ }gm;			# Space runs to one space
	s{^\s+}{}gm;				# Kill line-leading whitespace
	s{\s+$}{}gm;				# Kill line-ending whitespace
	s{\n}{}gm;					# Kill newlines
}

# Escape single- and double-quotes, spaces, control chars, unicode:
$bookmarklet = "javascript:" .
	uri_escape_utf8($bookmarklet, qq(%'" \x00-\x1f\x7f-\xff));

print "// $bookmarklet\n" . $source_code;

# Put bookmarklet on clipboard:
my $fh;
open($fh, '|-', '/usr/bin/pbcopy')
	or die "Failed to open pipe to /usr/bin/pbcopy - $!";
print $fh $bookmarklet
	or die "Failed to write to pbcopy pipe - $!";
close($fh)
	or die "Failed to close pipe to pbcopy - $!";


__END__

27 Jan 2014
- Switched from backticks to open() for the pipe to pbcopy. Thanks to John Siracusa.
- Added '%' to the list of characters to encode.

perl 手动AWK para Perl

a.pl
perl -lane 'if ($F[0] =~ /export/) {$F[3]=$F[1]}; print "@F"' a.txt


@F -> nova linha
$_ -> linha antiga
F[0] -> primeira coluna

$" -> field separator (  perl -lane 'BEGIN{$"="\t"} ...... )
$/ -> record separator
$#F+1 -> número de colunas na linha