Showing posts with label Perl. Show all posts
Showing posts with label Perl. Show all posts

Jun 29, 2009

Perl check web page alive status

use LWP::UserAgent;
use HTTP::Headers;
use Net::SMTP;
my $ip= $ARGV[0];
my $url=$ARGV[1];
my $agent_name='myagent';
my $ua=LWP::UserAgent->new($agent_name);

my $request=HTTP::Request->new(GET=>$url);

$request->header(Accept=>'text/html');

my $response=$ua->request($request);
if (!($response->code( )==200 || $response->code( )==401))
{
write_mail();
}

Mar 25, 2009

perl telnet cisco router script

use Net::Telnet::Cisco;
my $session = Net::Telnet::Cisco->new(Host => '192.168.1.1');
$session->login('xxx', 'xxx');
# Execute a command
my @output = $session->cmd('show version');
print @output;
# Enable mode
if ($session->enable("enable_password") ) {
@output = $session->cmd('show privilege');
print "My privileges: @output\n";
} else {
warn "Can't enable: " . $session->errmsg;
}
$session->close;

perl 中文 string split by use encoding big5

Perl 處理中文, 加入

use encoding big5;
$string="中文成功123";
後, split(//,$string); 即可拆成 "中","文","成","功","1","2","3"

若是從資料庫取得的字串, 可試試
$string=decode("big5", $string);
再做 @str=split(//,$string);

Mar 19, 2009

perl telnet script

use Net::Telnet;
$telnet = new Net::Telnet ( Timeout=>10, Errmode=>'die', Prompt => '/\$|#|%|>/');
$telnet->open('192.168.1.1');
$telnet->login('root','tttt');
print $telnet->cmd('who');
print $telnet->cmd('ps -ef | grep ora_ | wc -l');

Activeperl ssh

Activeperl , type ppm to explore Perl Package Manager ,
search net-ssh-perl , if cannot find , then edit the preference , add other repository.

Choose mark for install , you will find warning message .
Install all of it before install net-ssh-perl.

And then comment out line 216 at 'dir'\net\ssh\perl.pm
# defined($sock->blocking(0))
# or die "Can't set socket non-blocking: $!";

then can try following ssh test script.

use Net::SSH::Perl ;
my $ssh = Net::SSH::Perl->new("192.168.1.1");
$ssh->login("root", "bbb");
my($stdout,$stderr,$exit)=$ssh -> cmd("ls");
print $stdout;

Feb 25, 2009

perl get remote file property and copy to local - for windows

perl to get remote file property is simple,but it spends me lots of time to findout windows driver syntax .

use strict;
use warnings;
use File::Copy;
my $remote_file = "\\\\192.168.1.1\\c\$\\temp.log";
my ($mtime) = (stat $remote_file)[9];
my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($mtime);
$year+=1900;
$mon +=1;
print "$year/$mon/$mday $hour:$min:$sec";
copy($remote_file, "C:\\Temp");

Feb 24, 2009

perl ado connection for sql server , oracle, MySQL by Win32::OLE

A easy way to connect database server and get data by using perl Win32::OLE.
The connection string is same with asp or vbscript.

use Win32::OLE;
#for sqlserver with user/password
#my $ConnStr="driver={SQL Server};server=;AutoTranslate=No;uid=sa;pwd=xxx;Network=Dbmssocn;Database=master;";

#for oracle , must install oracle client first to get connction str
#my $ConnStr="driver={Microsoft ODBC for Oracle};server=;uid=system;pwd=xxx;";

#for sqlserver with Trusted_Connection
my $ConnStr="driver={SQL Server};server=;AutoTranslate=No;Trusted_Connection=yes;Network=dbnmpntw;Database=master;";

#For MySQL
my $connCMDBstr="DRIVER={MySQL ODBC 3.51 Driver};SERVER=192.168.2.1; PORT=3306;DATABASE=Test; USER=root; PASSWORD=; OPTION=3;";


my $Conn = Win32::OLE-> new('ADODB.Connection');
$Conn-> Open($ConnStr);
my $err = Win32::OLE::LastError();
if (not $err eq "0")
{
print"FATAL: no connection, OLE error 0x%08x: $err\n";
exit;
}

my $Statement = "select * from sysdatabases";
if(! ($RS = $Conn->Execute($Statement)))
{
print Win32::OLE->LastError();
exit;
}
while (! $RS->EOF)
{
$servername= $RS->Fields(0)->value;
print"servername is: $servername\n";
$RS->MoveNext;
}
$RS->Close;
$Conn->Close;

Feb 8, 2009

AIX 5.3 - install perl DBI and oracle DBD

1. down DBI http://search.cpan.org/~timb/DBI/
2. install DBI
perl Makefile.PL
make
make test
make install
3. download DBD http://search.cpan.org/~timb/DBD-Oracle-1.16/
$ perl Makefile.PL
Edit Makefile with following commands(OS and Oracle is 64bit,perl is 32bit. Need to set oracle lib as 32 bit):
1,$s?/lib/ ?/lib32/ ?g
1,$s?-q64??g
1,$s?/lib/sysliblist?/lib32/sysliblist?g
Now perform normal commands to perform the testing/making:
$ make
$ make test
$ make install

Sep 22, 2008

perl use DBI connect to mysql

#!/usr/bin/perl
# MySQL installation verification.
# Open database 'sedb', then just exit.
# No errors should occur.

use strict;
use Socket;
#use DBI();
use DBI;
my $host="127.0.0.1";
my $db="sec";
# Connect to the database.
#my $dbh = DBI->connect("DBI:mysql:database=sec;host=127.0.0.1","root", "ashley",{'RaiseError' => 1});
print "access database--$db\n";
my $dbh = DBI->connect("DBI:mysql:$db;$host","root", "ashley",{'RaiseError' => 1});
print "drop table if exist cmdb\n";
$dbh->do("drop table if exists cmdb");
print "Create table cmdb\n";
$dbh->do("create table cmdb(auto int(5) unsigned not null)");
print "insert into data\n";
for(my $i=1;$i< 10;$i++)
{
$dbh->do("insert into cmdb(auto) values($i)");
}
print "select data from cmdb table\n";
my $sth=$dbh->prepare("select * from cmdb");
$sth->execute() or die $sth->errstr;
my $i=0;
while((my $row=$sth->fetchrow_arrayref))
{
print $row->[0],"\n";
}
exit;

Sep 2, 2008

perl 筆記

字串運算子 (比 ASCII表)
. => "my"."doc" = "mydoc" 字串相加
x => "yes"x2 = "yesyes" 複製字串
eq => "my" eg "MY" = false 字串相等
ne => "my" ne "MY" = true 字串不相等
lt => "abc" lt "bc" = true 逐個字元比對兩字串大小,看是否前ㄧ個比後一個小,not equal 時就停止比較,等於就持續往後比較
gt => "abc" gt "bc" = false 逐個字元比對兩字串大小,看是否前ㄧ個比後一個小
cmp => "abc" cmp "bc" = 表較兩個字串,傳回有三種 , 前大於後為 1, 小於為 -1, 等於時為0

處理字串函數
length(字串值) =>傳回整數,空值傳回0

chomp($num)
//chomp 函數去除$num 變數值的最後換行符號 , 回傳值為被刪除的字元個數
chop($num)
//chomp 函數去除$num 變數值的最後ㄧ個字元 , 回傳值為被刪除的字元
$/ => 指定 chomp 要去除的字元, 預設是 "\n" 換行符號

split(/模式/,字串) => @str=split(/&/,"u=brian&password=good") => $str[0]="u=brian" , $str[1]="password=good"
substr(字串,字串起始位置索引值,字串長度)
改變大小寫=> lc , uc , lcfirst, usfirst
index(原字串,要找尋的子字串,偏移量), 若未找到會回傳-1
pack 與 unpack => pack(指定的格式,需解碼的字元) => pack("u","這是測試") , 編碼為 uuencode 格式.


$name=;
// <> 代表從檔案代碼中讀出資料

my($sec,$min,$day,$mon,$year)=@{[localtime(time)]}[0,1,2,3,4,5];
$year +=1900;
$mon +=1;
print "現在時間 $year/$mon/$day $hour:$min:$sec";
//time 函數傳回 從1900 道現在的秒數, localtime 函數轉換為年用日分時秒.$time[6] 代表 星期幾, $time[7] 代表一年的第幾天

//單引號內無變數內插, 雙引號會有變數內插

//perl 內部變數
$_ => 預設變數($ARG), 凡是程式需要純量資料作為輸出而我們沒有提供資料的地方時,perl就會用 $_ 來代替,如 print 就等於 print $_.
$& => 成供比對的字串
$. => 檔案代碼目前讀的行
$$ => 執行該程式的process id
$0 => 所執行的perl程式的檔名
$# => 輸出數值的格式
$] => perl 編譯器的版本
$^0 => Perl 編譯器所處的作業系統名稱
$ARGV => 目前從<>讀取的檔案名稱
@ARGV => 包含指令行輸入的陣列
@_ => 函數的參數陣列
$|=1; => Autoflush STDOUT


${name}s => 此種表示法可把變數取得後加上s 字元

":" 與 "空白" 皆會切割相鄰變數名稱

my $var2=@var1
// $var2 的值為 @var1 陣列的個數

//陣列的索引值是從 0 開始
$#array=99; => 表定義了一個有100的資料欄位的陣列 @array
$#array=-1 => 表刪除整個陣列並釋回佔用的記憶體

$string=shift;
$logfile=pop;
// shift函數 用來把陣列的第一個元素取出 並指定給 $string
// pop 函數用來把最後一個元素取出, 並指定給 $logfile

//倒裝與And 語法:若 if內的結構只有一行敘述
print "這是測試" if($input > 30);

($input > 30) and print "這是測試" ;

// for 與 foreach
@array=(this,is,a,book);
for $item(@array){
print $item,"\n"
}

@array=(this,is,a,book);
foreach $item(@array){
print $item,"\n"
}


常規表示式
=~ => 運算子用於指定要處理的字串純量變數,可和 m// , s// , 與 tr// 搭配使用, 成功傳回 true , != 則與=~ 傳回相反的判斷
m// => 比對函數, m 可以省略, / 可以用任何的符號來取代如 m!!
s// => 搜索字串並取代
$string = "Yes it is"
if($string=~m/YES/){
print "Find yes";
}
else
{
print "No yes";
}

[] => 可用來表示比對其中的任何一個字

Jun 30, 2008

cygwin 上使用 Mysql

如果你是shell指令愛好者,非常喜歡用shell下指令玩Rails的話,除了Mac, Linux之外,最好的選擇就是在Win32平台上安裝Cygwin

安裝Cygwin有什麼好處呢?這可以讓你在Win32底下使用一些常見的Linux工具程式,例如: joe, nano, vim, emacs, mc, gcc, make等,其他像top, ls, man, ps, mv等常見的指令也都相容。

Windows/CygWin
If you are a user of Cygwin (the Redhat distribution) you already know, it contains a nicely running perl 5.6.1, installation of additional modules usually works as a charm via the standard procedure of
- perl makefile.PL
- make
- make test
- make install
The Windows binary distribution of MySQL runs smoothly under Cygwin. You can start/stop the server and use all Windows clients without problem. But to install DBD::mysql you have to take a little special action.
Don't attempt to build DBD::mysql against either the MySQL Windows or Linux/Unix BINARY distributions: neither will work!
You MUST compile the MySQL clients yourself under Cygwin, to get a 'libmysqlclient.a' compiled under Cygwin. Really! You'll only need that library and the header files, you don't need any other client parts. Continue to use the Windows binaries. And don't attempt (currently) to build the MySQL Server part, it is unnecessary, as MySQL AB does an excellent job to deliver optimized binaries for the mainstream operating systems, and it is told, that the server compiled under Cygwin is unstable.
Install MySQL (if you havn't already)
- download the MySQL Windows Binaries from http://www.mysql.com/downloads/index.html
- unzip mysql--win.zip into some temporary location
- start the setup.exe there and follow the instructions
- start the server
- alternatively download, install and start the server on a remote server, on what supported OS ever Build MySQL clients under Cygwin:
- download the MySQL LINUX source from http://www.mysql.com/downloads/index.html
- unpack mysql-XX.tar.gz into some tmp location
- cd into the unpacked dir mysql-
./configure --prefix=/usr/local/mysql --enable-server
#./configure --prefix=/usr/local/mysql --without-server
This prepares the Makefile with the installed Cygwin features. It takes some time, but should finish without error. The 'prefix', as given, installs the whole Cygwin/MySQL thingy into a location not normally in your PATH, so that you continue to use already installed Windows binaries. The --without-server parameter tells configure to only build the clients.
- make :This builds all MySQL client parts ... be patient. It should finish finally without any error.
- make install :This installs the compiled client files under /usr/local/mysql/. Remember, you don't need anything except the library under /usr/local/mysql/lib and the headers under /usr/local/mysql/include! Essentially you are now done with this part. If you want, you may try your compiled binaries shortly; for that, do:
- cd /usr/local/mysql/bin
mysql.exe -h 127.0.0.1 -u root -p

The host (-h) parameter 127.0.0.1 targets the local host, but forces the mysql client to use a TCP/IP connection. The default would be a pipe/socket connection (even if you say '-h localhost') and this doesn't work between Cygwin and Windows (as far as I know).
If you have your MySQL server running on some other box, then please substitute '127.0.0.1' with the name or IP-number of that box.
At the 'mysql>' prompt do a quick check:
mysql> use mysql
mysql> show tables;
mysql> select * from db;
mysql> exit
You are now ready to build DBD::mysql!
Build DBD::mysql:
- download DBD-mysql-X.tar.gz from CPAN
- unpack DBD-mysql-X.tar.gz
- cd into unpacked dir DBD-mysql- you probably did that already, if you are reading this!
- cp /usr/local/mysql/bin/mysql_config .
This copies the executable script mentioned in the DBD::mysql docs from your just built Cywin/MySQL client directory; it knows about your Cygwin installation, especially about the right libraries to link with.
- perl Makefile.PL --testhost=127.0.0.1 --testuser=root --testpassword=xxxx
The --testhost=127.0.0.1 parameter again forces a TCP/IP connection to the MySQL server on the local host instead of a pipe/socket connection for the 'make test' phase.
- make :This should run without error
- make test :with DBD-mysql-2.1022 or earlier you will see several errors in dbdadmin.t, mysql.t and mysql2.t; with later versions you should not get errors (except possibly one, indicating, that some tables could not be dropped. I'm hunting for a solution to that problem, but have none yet).
- make install :This installs DBD::mysql into the Perl hierarchy.
Notes:
This was tested with MySQL version 3.23.54a and DBD::mysql version 2.1022. I patched the above mentioned test scripts and sent the patches to the author of DBD::mysql Jochen Wiedman.


--- If you try to install MySQL with wrong version(Must be source) , you will get return message like this.
./bin/my_print_defaults: ./bin/my_print_defaults: cannot execute binary file
Neither host 'brian_chang' nor 'localhost' could be looked up with
./bin/resolveip
Please configure the 'hostname' command to return a correct
hostname.
If you want to solve this at a later stage, restart this script
with the --force option

Perl 連接 MySQL

連接MySQL

Perl 要搭配資料庫,必須安裝以下模組:

1. DBI : Perl 的 DataBase Interface 的簡稱,

請至

ftp2.tnc.edu.tw/pub/unix/perl/CPAN/modules/by-module/DBI

抓取:DBI-1.37.tar.gz

tar xvzf DBI-1.37.tar.gz

cd DBI-1.37

perl Makefile.PL
make
make test
make install

2. Data-ShowTable

請至

ftp2.tnc.edu.tw/pub/unix/perl/CPAN/modules/by-module/Data

抓取:Data-ShowTable-3.3.tar.gz

安裝方法同 DBI。

3. DBD::資料庫driver

因為我想和 MySQL 搭配,所以必須安裝 DBD::mysql 的驅動程式

請至

ftp2.tnc.edu.tw/pub/unix/perl/CPAN/modules/by-module/DBD

抓取:Msql-Mysql-modules-1.2219.tar.gz 或 DBD-mysql*.tar.gz

安裝方法同 DBI。

至此,Perl 即可和 MySQL 一起運作了! 注意:通常,若您使用的是套件版的 Perl/MySQL,通常系統中已有相關的 DBI/DBD 了,比如:perl-DBI-1.32*.rpm (即 DBI)/ perl-Mysql-1.22_19*.rpm(即 DBD::mysql),因此,您不一定要安裝上面這些 tarbll 模組。

#! /usr/bin/perl

use DBI;
use strict;

my $db="test";
my $host='localhost';
my $user='root';
my $password='ppp123';

my $dbh = DBI->connect("DBI:mysql:database=$db;host=$host",
$user, $password, {RaiseError => 1});

open(FHD, "stu.csv") or die;
while (my $line=) {
chomp($line);
my ($f1, $f2, $f3, $f4, $f5)=split(/\,/,$line);
if ($f1) {
my $q=qq[ INSERT INTO stu_table VALUES ("$f1", "$f2", "$f3", "$f4", "$f5") ];
my $sth=$dbh->prepare($q);
unless($sth->execute) {die "$!\n";}
}
}
close(FHD);

實例:

我在 test 這個資料庫中開了一個 table 叫 aaa,其結構如下:

CREATE TABLE `aaa` (
`no` varchar(10) NOT NULL default '',
`name` varchar(12) NOT NULL default ''
)

其中 no 代表身份證字號,name 代表姓名。

我準備用它來儲存 studdemo.csv 中的學生身份證及姓名!

程式如下:

#! /usr/bin/perl

use DBI;
use strict;

my $db="test";
my $host='localhost';
my $user='root';
my $password='1234';

my $dbh = DBI->connect("DBI:mysql:database=$db;host=$host",
$user, $password, {RaiseError => 1});

open(FHD, "stu.csv") or die;
while (my $line=) {
chomp($line);
my ($f1, $name, $f3, $f4, $f5, $f6, $f7, $pslno, $f9)=split(/\,/,$line);
if ($f1) {
my $q=qq[ INSERT INTO aaa VALUES ("$pslno", "$name") ];
my $sth=$dbh->prepare($q);
unless($sth->execute) {die "$!\n";}
}
}
close(FHD);


From http://linux.tnc.edu.tw/techdoc/perl_intro/c1239.html

May 29, 2008

perl - 取得網頁填寫的資料,並寄送Email

#!/usr/bin/perl
$recipient1 = 'ttt@com';
$mail_from = "ttt\@com";
$subject = "客戶回函";
# Print out a content-type for HTTP/1.0 compatibility
print "Content-type: text/html\n\n";
# Get the input
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
# Split the name-value pairs
@pairs = split(/&/, $buffer);
foreach $pair (@pairs)
{
($name, $value) = split(/=/, $pair);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$FORM{$name} = $value;
}

&mail_user;

$mail_to = $FORM{'b5'};
open (MAIL, "|/usr/sbin/sendmail -f '$mail_to' '$recipient1' ")||die "sendmail: $!\n";
print MAIL<<"EOM";
Subject:客戶回函
MIMI-Version:1.0
Content-type:text/plain;charset=big5
這是客戶回函
個人簡介:
---------------------------------------------------------------------
名字 : $FORM{'a1'}
職稱 : $FORM{'a2'}
公司名 : $FORM{'b1'}
地址 : $FORM{'b2'}
電話 : $FORM{'b3'}
傳真 : $FORM{'b4'}
E-Mail : $FORM{'b5'}
EOM
close (MAIL);
print "<body background=/gif/bookback.gif \n";
print " text=\"#000000\" link=\"#0000ff\" vlink=\"#ff0000\" \n";
print "alink=\"#00ff000\">\n";
print "<title>客戶回函</title>\n";
print "<body><center>";
print "<h5><font face=\"Arial\"><a href=\"http://www.simplo.com.tw/\"><strong></strong></a><br>";
print "<hr>\n";
print "</center>";

print " </p>\n";
print " <blockquote>\n";
print "<font size=+1>個人簡介</font><br>\n";
print "<hr><br>\n";
print "名字 : $FORM{'a1'}<br>\n";
print "職稱 : $FORM{'a2'}<br>\n";
print "部門 : $FORM{'a3'}<br>\n";
print "性別 : $FORM{'sex'}<br>\n";
print "<br>\n";
print "<font size=+1>公司簡介:</font><br>\n";
print "<hr><br>\n";
print "公司名 : $FORM{'b1'}<br>\n";
print "地址 : $FORM{'b2'}<br>\n";
print "電話 : $FORM{'b3'}<br>\n";
print "傳真 : $FORM{'b4'}<br>\n";
print "E-Mail : $FORM{'b5'}<br>\n";
print "<br>\n";
print " </blockquote>\n";
print "<br>\n";
print "<center>\n";
print "<hr align=center width=80%>\n";
print "<font size=+1 color=red>感謝您填寫本表單</font>\n";
print "<hr align=center width=80%>\n";

sub mail_user {

$mail_to = $FORM{'b5'};

open (UMAIL, "|/usr/sbin/sendmail -f '$mail_from' '$mail_to'")||die "sendmail: $!\n";
print UMAIL<<"EOM";
Subject:$subject
MIMI-Version:1.0
Content-type:text/plain;charset=big5
Hello $FORM{'a1'},

謝謝您填寫此表單
EOM
close(UMAIL);
}

---------------------------------
###在Subject 之後的兩行可避免發生中文亂碼
MIMI-Version:1.0
Content-type:text/plain;charset=big5

Mar 26, 2008

cygwin + perl

cygwin source setup file ,
http://sources.redhat.com/cygwin/
執行Setup 時確認 perl 有選到要安裝.

cygwin 是模擬 GNU 的環境, 而不是 unix 的環境 (對啦, 這正是 "Gnu's Not Unix" 要表達的意思 : -)。 Cygnus Solutions 公司 (後來為 redhat 所併購) 以自由軟體基金會的 gnu 工具為基礎, 將它移植到 windows 上, 就成了 cygwin; 它一直都是自由軟體。 初期只有命令列視窗 bash, 及編譯器 gcc 等等開發工具可以使用; 現在則連 X 視窗系統都已移植成功; 未來 X 視窗系統下的應用軟體也將逐漸移植過來。

為什麼要用 cygwin? 因為 cygwin 提供 regexp 與 gnu 命令列環境 等等組合式工具。

------
參考底下步驟:

  1. 連至 www.cygwin.com 下載 setup.exe
  2. 執行 setup.exe , 選取Download from Internet
    1. 選取所需套件 // 建議全選devel, lib等分類的所有套件
  3. 執行 setup.exe , 選取Install from Local directory安裝套件 //最好選取 All user
    1. 選取所有套件
  4. 執行桌面上的 Cygwin 的 icon 圖示即可執行此一 Cygwin 環境。// 視窗大小可由icon 圖示右點按 選取調整字型 及佈置

step by step 可參考 http://linux.tnc.edu.tw/techdoc/shell/x52.html

在Cygwin console輸入、顯示中文

需要在家目錄($HOME)下新增或編輯兩個檔案:
.inputrc 和 .bash_profile
在.inputrc中要有下面三行
set meta-flag on
set convert-meta off
set output-meta on

在.bash_profile中要有下面三行
export LESSCHARSET=latin1
alias less='/bin/less -r'
alias ls='/bin/ls -F --color=tty --show-control-chars'

如果對指令跟文字編輯器都不熟, 請開啟cygwin console,依序執行下面七個指令:

cd
echo "set meta-flag on" >> .inputrc
echo "set convert-meta off" >> .inputrc
echo "set output-meta on" >> .inputrc
echo "export LESSCHARSET=latin1" >> .bash_profile
echo "alias less='/bin/less -r'" >> .bash_profile
echo "alias ls='/bin/ls -F --color=tty --show-control-chars'" >> .bash_profile

然後退出cygwin console,再重新開啟,就可以輸入、顯示中文了。