您当前的位置：飞诺网 >> 网站开发 >> CGI-Perl >> CGI-Perl实例
perl メモ
www.diybl.com 时间 ： 2008-06-14 作者：佚名 编辑：本站 点击： [ 评论 ]
======================Data::Dumper=========================
use Data::Dumper;
$aa = "123";
print "1---$aa\n";
$dumper = Data::Dumper ->new([$aa],[qw(aa)]);
$value = $dumper -> Dump();
print "$value\n";
$aa = "abc";
print "2----$aa\n";
eval($value);
print $aa;
================================cpan==========================
perl -MCPAN -e shell
o conf
o conf urllist push ftp://ftp.ring.gr.jp/pub/lang/perl/CPAN/
o conf commit #保存
=====================================scan dir============================
sub scanDir {
my $dir = shift;
if (-d $dir) {
my $DH;
opendir $DH, $dir or warn "Couldn't open directory $dir: $!";
while (my $file = readdir $DH) {
next if $file eq '.' || $file eq '..';
my $fullFileName = $dir . '/' . $file;
open(FF,">>list.txt");
print FF "$fullFileName\n";
close(FF);
scanDir($fullFileName);
}
}
}
scanDir($ARGV[0] ? $ARGV[0] : '.');
=================================check time================================
use Benchmark;
timethis(1000,"aa()"); # 回数=1000
================================== time ====================================
my @nowtime = localtime(time);
my $year = sprintf("%04D",$nowtime[5] + 1900);
my $month = sprintf("%02D",$nowtime[4] + 1);
my $mday = sprintf("%02D",$nowtime[3]);
my $timenow = "$year$month$mday";
================================ html \s ==================================
$html =~ s/\n/aaa/g;
$html =~ s/\t/bbb/g;
$html =~ s/ /ccc/g;
$html =~ s/\r/ddd/g;
$html =~ s/\f/eee/g;
================================= utf-8 ==========================
use Encode;
gbk->uft-8：
$line = encode("utf-8",decode("gbk",$line));
或
$line = encode_utf8(decode("gbk",$line));
utf-8->gbk：
$line = encode("gbk", decode("utf8", $line));
uft-8->gb2312：
$line = encode("gb2312", decode("utf8", $line));
=========================== ENV =================================
#!/usr/bin/perl
print "Content-type: text/html\n\n";
print "<html><head>\n";
print "<META HTTP-EQUIV=\"Content-type\" CONTENT=\"text/html;charset=Shift_JIS\">\n";
print "<title>環境変数一覧</title>";
print "</head><body>\n";
foreach (sort keys %ENV) {
print "$_: $ENV{$_}<BR>\n";
}
print "</body></html>\n";
=====================input===================
perl yu.pl xxxxfile
@ARGV
$ARGV[0]
===============================================================
use Data::Dumper
print Dumper( \%xxx );
Devel::Peek
=========================DBI=======================================
#!/usr/bin/perl
print "Content-type: text/html\n\n";
use DBI;
my $dbh = DBI->connect("DBI:mysql:yu","root","123456",{'RaiseError' => 1});
#$dbh->do("CREATE TABLE foo (id mediumint not null auto_increment, name VARCHAR(20),)");
#$dbh->do("INSERT INTO user VALUES ('bbbbb','bb22','b333','f','1999-03-30','2008-01-01')");
#$dbh->do("DROP DATABASE db2");
my $sth = $dbh->prepare("SELECT * FROM user");
$sth->execute();
while (my $ref = $sth->fetchrow_hashref()) {
print "<p>$ref->{'name'}</p>\n";
}
$sth->finish();
$dbh->disconnect;
説明: 1.RaiseError 自動的にエラーを捕らえる
特に: 1.$quotestring = $dbh->quote($string); # ""とセット
2.$dbh -> trace(4,log.txt); # 0 無効 エラー情報：1 2 3 4 ->詳細
3.DBI::neat()とDBI::neat_list() # きれいになる neatの最大値400である
4.DBI::looks_like_number() # quoteとセット
5.$row = $sth -> dump_results(80,'\n','-',\*FILE); # maximum field length line separator field seoarator output file handle
6.? $sth -> bind_param(1,"何々");
7.
================================ wget==============================
sub getfile{
if(-e "d$year$month$mday.htm"){ unlink("d$year$month$mday.htm"); }
my $cmd = "http://sc.hkex.com.hk/gb/www.hkex.com.hk/markdata/quot/d$year$month$mday.htm";
system "/usr/local/bin/wget --timeout=10 --continue --tries=3 --output-document=d$year$month$mday.htm $cmd";
waitpid($pid1,0);
}
==========================================================
@array =qw(a b c b d e b c d b);
$index = 0;
for(@array){
print "$index " if /b/;
$index++;
}
======================================================================
20080122可以用
my($year,$mon,$day,) = unpack("A4A2A2",$date);
如果是2008年12月12日
my($year,$mon,$day) = $string=~/(\d+).*?(\d+).*?(\d+)/;
====================================================================
print sort {(split(/<>/,$a))[4] <=> (split(/<>/,$b))[4]} <FF>;
===============sort map====================
open(FF,"test.dat") or die $!;
@by2and3 = map {$_->[0]} sort {$b->[1] <=> $a->[1]} map {[$_,(split(/,/))[2]]} <FF>;
close(FF);
for(@by2and3){
print;
}
===============================================================
open(FF,"bbsdata.cgi");
@by2and3 = map {$_->[0]} sort {$b->[1] <=> $a->[1]} map {my $date=(split(/<>/))[4]; $date=~s/[^0-9]//g ;[$_,$date]}<FF>;
close(FF);
for(@by2and3){
print;
}
============================ ===========================
perl -MImage::Magick -e 'print $Image::Magick::VERSION . "\n"';
perl -MCGI -e 'print $CGI::VERSION . "\n"';
perl -MCGI::Session -e 'print $CGI::Session::VERSION . "\n"';
perl -MCGI::Cookie -e 'print $CGI::Cookie::VERSION . "\n"';
================module モジュール===================
#!/usr/bin/perl
package testmodule;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(mysub1,mysub2);
@EXPORT_OK = qw($myvar1,$mysub2);
sub sub1{}
sub sub2{}
=========================プレビュー js版==============
<input type="button" name="abc" value="preview" onclick="precode()">
<script>
function precode(){
var oPopup = window.open("preview.cgi");
var oPopBody = oPopup.document.body;
oPopBody.style.backgroundColor = "lightyellow";
oPopup.document.write("<center><table><tr><td>");
oPopup.document.write(form.message.value);
oPopup.document.write("</td></tr></table border=1></center><div align=right>close</div>");
oPopup.show(70, 500, 1100, 200, document.body);
}
</script>
==========================================
<script>
function goto()
{
var tag=form.tagu.value;
var msg=form.message.value;
form.action=("preview.cgi?gomessage="+msg+"&gotagu=");
form.submit();
}
</script>
=========================プレビュー ==============
<input type=button onclick="form.action='preview.cgi';form.submit()" value= "プレビュー">
=================CGI::SESSION 222-- client=========
#!/usr/bin/perl
print "Content-type: text/html\n\n";
use CGI;
use CGI::Cookie;
use CGI::Session;
$login = new CGI;
$session = new CGI::Session("driver:File",$login,{Directory=>'/tmp'});
$name = $session -> param("username");
$sessid = $session -> id;
print "$name---$sessid\n";
@cookiepairs = split(/&/, $ENV{'HTTP_COOKIE'});
foreach $pair (@cookiepairs){
($cookiename, $cookievalue) = split(/=/, $pair);
$cookievalue =~ tr/+/ /;
$cookievalue =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$cookie{$cookiename} = $cookievalue;
$cookname = $cookie{'CGISESSID'};
}
print "$cookname---$sessid\n";
=================CGI::SESSION 111-- server=========
#!/usr/bin/perl
use CGI;
use CGI::Cookie;
use CGI::Session;
$login = new CGI;
$loginuser = $login->param('textuser');
$loginpass = $login->param('textpasswd');
$session = new CGI::Session("driver:File",$login,{Directory=>'/tmp'});
$session -> expire("+1m");
$session -> param('username',$loginuser);
$cookie = new CGI::Cookie(-name => 'CGISESSID',
-value => $session->id);
if(("admin" eq $loginuser) && ("admin" eq $loginpass)){
print "location: admin.cgi\n";
print $login->header(-cookie=>$cookie);
print "\n";
}else{
checkuser();
}
================== colse windows ========
<script LANGUAGE="JavaScript">
function openwin() {
window.open ("preview.cgi?gotemp=$message")
}
</script>
========================コード ==============================
URL エンコード
$str =~ s/(\W)/'%'.unpack("H2", $1)/ego;
$str =~ tr/ /+/;
URL デコード
$str =~ tr/+/ /;
$str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/ego;
=================================================================
sub add_all{
local($sum); #将$sum定??局部?量
$sum=0; #将sum初始化
foreach $_(@_) { #遍?参数列表
$sum+=$_; #累加?个元素
}
$sum; #返回sum即?和的?
}
$sum=88; #$sum的原始??88
print $sum; #?示$sum的?即88
$a=&add_all(3,4,5); #$a的??3+4+5即12
print $sum; #?示$sum的?仍?88
===========cookie1追加設定===============
#!/usr/bin/perl
use CGI qw/:standard/;
use CGI::Cookie;
my $cgi = new CGI;
my $cookie = new CGI::Cookie(
-name => 'name',
-value => 'wac',
-expires => '+2M',
);
print $cgi->header(-cookie=>$cookie);
print $cgi->header("text/html; charset=shift_jis");
print "COOKIEsadfasdfasdfasd\n";
================cookie読む==================
@cookiepairs = split(/&/, $ENV{'HTTP_COOKIE'});
foreach $pair (@cookiepairs){
($cookiename, $cookievalue) = split(/=/, $pair);
$cookie{$cookiename} = $cookievalue;
print "$cookie{'bbsname'}\n";
}
================特定行を削除する==========-
open(INPUT,"<admin.dat");
while ($ln = <INPUT>){
chomp $ln;
if($ln !~ s/1(.+)/$1/g){
push (@newdata,join(",",$ln));
print "$ln\n";
}
}
close(INPUT);
open (OUTPUT,">admin.dat");
foreach (@newdata){
print OUTPUT "$_\n";
}
close (OUTPUT);
------------------------------------------
こんなのはどうでしょう。
==========require package module=============
1.require
require ("yu.pl");
unshift (@INC, "/u/perldir");
----yu.pl-----
sub 123{
}
1;
2.package
定義：
package yupackage;
呼び出し方：
$yupackage::var;
&yupackage::123;
消す:
no yupackage;
3.module
定義：
package yumodule;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(yufunc1,yufunc2);
@EXPORT_OK = qw($yuvar1,$yuvar2);
呼び出し方；
use yumodule;
消す:
no yumodule;
==========よく使う======
foreach $i (1..10){
print "$i\n";
}
======入力=====
sub yuwrite{
for ($line = <STDIN>,$count =1;$count <=10;$line=<STDIN>,$count++){
print ($line);
}
}
&yuwrite;
=====open=====
open(INPUT,"<test.txt");
while (<INPUT>){
print "$_\n";
}
close(INPUT);
=====read======
open(INPUT,"<test.txt");
$read_longer = read INPUT,$char,256; #read_longer==charの長さ
print "$read_longer\n";
print "$char\n";
close(INPUT);
=====OUTPUT======
open(OUTPUT,">test.txt");
for($i=0;$i<5;$i++){
print OUTPUT "$i\n";
}
close(OUTPUT);
=====ファイル中に入力内容を加入する=====
for ($line = <STDIN>,$count =1;$count <=1;$line=<STDIN>,$count++){
open(OUTPUT,">test.txt");
print OUTPUT $line; # $line==入力内容
close(OUTPUT);
}
========ファイル中に入力内容を加入してから、内容の長さを表示する=====
sub write_file{
for ($line = <STDIN>,$count =1;$count <=1;$line=<STDIN>,$count++){
open(OUTPUT,">test.txt");
print OUTPUT $line;
close(OUTPUT);
}
}
sub read_file{
open(INPUT,"<test.txt");
$read_longer = read INPUT,$char,256; #read_longer==charの長さ
print "$read_longer\n";
print "$char\n";
close(INPUT);
}
&write_file;
&read_file;
===== ファイルを削除する=======
unlink("test.txt");
unlink("test1.txt","test2.txt");
unlink(<*>); #すべての削除
=====ファイルの名前変更========
rename("old.txt","new.txt");
flock(INPUT,1); #1,2,4,8
=========open dir =================
opendir (DIR,"test")or die("Cannot OPEN\n");
@filelist=readdir(DIR);
foreach $file(@filelist){
print "$file\n";
}
=========移動================
chdir("test");
unlink(<*.ppt>);
rmdir("test");
如果图片或页面不能正常显示请点击这里
CGI-Perl实例推荐文章
频道地图
CGI-Perl实例相关文章
