顯示具有 perl 標籤的文章。 顯示所有文章
顯示具有 perl 標籤的文章。 顯示所有文章

2012年7月12日 星期四

我真的很懶嗎?


我一直覺得,我還蠻懶惰的,不喜歡做一堆重複的工作,寧願認真做完一次,寫個code,叫電腦自動做,也不願意重複的命令一直打,感覺這種行為很浪費生命,明明自動程序在跑幾秒鐘就沒事了,要燒個一天去做就感覺很白痴。

底下兩段CODE是把當下的UBUNTU或DEBIN系統抽出來做一個ROOTFS,也就是自動做出initrd.img的腳本,用Perl寫這種腳本還蠻快的,而且很好寫,主要是autofs.pl在運作,poCmd.pl是讀取cmd.list內容,讓autofs.pl去呼叫,poCmd.pl會按照cmd.list內列出來的命令,逐一拷貝到/bin底下,順便把需要的動態庫檔案也拷貝進去,後面要把busybox支援的命令在/bin底下做一個soft link,讓系統起來之後有一些基本的命令可以用。

原理就上一篇講的那些做一個自動腳本,把目前的系統抽一個initrd.img的小rootfs出來用,讓系統開機使用RAM DISK的ROOTFS運作,也就是有一些系統商做的小LINUX系統的搞法。

這種系統就是比誰做的小,也就是要做剛好的系統,這有兩個大原則,一個是只載入要用的模組,另外一個是只放需要的命令,所以不要白痴的把所有的模組都放在裏面,也不需要把沒用到的動態函式庫放進去,這樣會讓你做出來的ROOTFS會肥到百M的尺寸,要小,這就需要挑,挑的方法也很簡單,就先看目前系統需要哪些模組,lsmod這個命令可以列出目前系統載入了哪些模組,之後靠modinfo -n去看那個檔案放哪,只抓要用到的東西,另外有些命令用到動態庫,要調用ldd -v 命令去看用了哪些動態庫,只需要拷貝要用到的動態庫就好,這樣才能夠做出比較小的系統,我做出來的initrd.img大概就16M左右,事實上還好沒很肥,反正是自動做的,這大小還可以接受。

本來只是要我做個小系統,讓測試人員可以直接開進去使用,要穩、好拷貝,所以才要我搞這個,我也是努力的花了一星期(含其他案子同時進行)搞出來,下次就開腳本去抽就有了,不需要再來煩我~~XD。

當然不免俗的這程式有BUG(我知道有個問題),有看出來的可以留言,我們討論一下~~XD


poCmd.pl

#!/usr/bin/perl -w

open FH,"<../cmd.list";
foreach my $line(< FH >){
 chomp($line);
 if($line ne ""){
 my $limitCounter=0;
 DOAGAIN:
  my @paths=("/bin/","/sbin/","/usr/bin/","/usr/sbin/");
  print "$line";
  my $found=0;
  foreach my $path(@paths){
   if(-e "$path$line"){
    print "\t- $path$line\n";
    system "cp $path$line bin/.";
    my @vars=`ldd -v $path$line | grep lib | grep :\$ | cut -d ':' -f 1`;
    foreach my $var(@vars){
     chomp($var);
     $var =~ s/\t//g;
     $var =~ s/\ //g;
     print "\t$var\n";
     my $libPath="lib/.";
     #$libPath = "lib64/." if($var =~ /x86\_64/i);
     system "cp $var $libPath";
    }
    $found = 1;
    $limitCounter=0;
    last;
   }
  }
  if($found == 0){
   print "Can't found command exist!";
   system "sudo apt-get install $line";
   exit 1 if($limitCounter >= 3);
   $limitCounter++;
   goto DOAGAIN;
  }
 }
}

close FH;

#process busybox softlink

print "make busybox command list\n";
chdir "bin/";
my @vars = `busybox | grep \,\ `;
foreach my $var (@vars){
 if($var !~ /copyright/i){
  chomp($var);
  $var =~ s/\ //g;
  $var =~ s/\t//g;
  my @cmds = split /\,/,$var;
  foreach my $cmd(@cmds){
   if($cmd !~ /\[/){
    print "[busybox command]\t$cmd\n";
    system "ln -s busybox $cmd";
   }
  }
 }
}

autofs.pl

#!/usr/bin/perl -w

use File::Basename;
#Auto make rootfs on Debin/Ubuntu
#Author Jones
print "Auto make rootfs for Debin/Ubuntu\n";
print "Author Jones Lai\n";

my $var = `uname -a`;

if(($var !~ /ubuntu/i)&&($var !~ /debin/i)){
 print "This script just made for Debin/Ubuntu\n";
 exit 1;
}

$var = `dpkg -l`;

if($var !~ /build\-essential/){
 print "Require build-essential\r\n";
 system "sudo apt-get install build-essential";
}

my @kernels = `ls /lib/modules/`;

@kernels = sort {$b cmp $a} @kernels;

my $lastKernel = $kernels[0];

chomp($lastKernel);

print "Last kernel version is $lastKernel\n";

if(!(-e "vmlinuz")){
 print "copy kernel to local\n";
 system "cp /boot/vmlinuz-$lastKernel ./vmlinuz";
}
if(!(-e "initrd.img")){
 system "mkinitramfs -o initrd.img $lastKernel";
}
if(!(-e "tmp")){
 system "mkdir tmp";
}else{
 system "rm tmp/ -fr";
 system "mkdir tmp";
}

chdir "tmp/";
system "gunzip < ../initrd.img | cpio --extract --preserve --verbose --no-absolute-filenames";
my @modules = `lsmod`;

open(FH,">conf/modules");

foreach my $module(@modules){
 chomp($module);
 next if($module =~ /module/i);
 my ($MOD,$others) = split /\ +/,$module;
 print FH "$MOD\n";
 my $var = `modinfo -n $MOD`;
 chomp($var);
 my $dirname  = dirname($var);
 system "mkdir -p .$dirname/\n";
 system "cp -p $var .$var\n";
 print "[copy module]: $var\n";
}
close(FH);

system "perl ../poCmd.pl";

system "cp ../init init";
system "chmod +x init";

$var = `find . | cpio --create --format='newc' > ../newinitrd`;
print "$var\n";
$var = `gzip ../newinitrd`;
print "$var\n";
$var = `mv ../newinitrd.gz ../newinitrd.img`;
print "$var";
$var = `rm ../initrd.img` if(-e "../initrd.img");
$var = `mv ../newinitrd.img ../initrd.img`;

chdir "../";

2012年4月12日 星期四

perl的檔案處理

配合上perl對文字串的處理,它在做檔案處理還蠻實用的。

  • 刪除檔案 unlink
  • 更改檔名 rename
  • 更改權限 chmod
  • 取得檔案屬性 stat
  • 拷貝檔案 copy
底下的參考網址有範例程式可以參考


參考網址

GUI沒辦法像積木一樣堆積出新的面貌,也就沒什麼彈性可以自動處理,工程師在這種環境底下慢慢的會變得跟一般使用者沒兩樣,失去高速、自動控制系統的能力,當然GUI在某些時候的確是比較直觀、方便,對使用者來說或許是福音,但是對於工程師來說可能就是毒藥,工程師常常需要大批的處理檔案,怎麼辦?

一個一個改嗎?

我是認為寫code按照某個規則,整批的改比較快吧!

檔案及檔案夾中有空白要改

在網路上看到一個問題,有人資料夾或檔案有空白,希望把資料夾或檔案名稱中的空白改成底線,而底下的code就是本人使用Perl寫出來的,事實上還蠻簡單的,當然與上次在Linux上使用的方法有點差異,Perl的資源豐富、強大,有發現好方法可以快速的搞定當然是拿來用阿~~XD。

所以code是愈寫愈小...XD


#!/usr/bin/perl -w

use File::Find;

$start_dir = shift || '.';

find( sub{
 if($_ =~ /\ /){
  my $new=$_;
  $new=~s/\ /\_/g;
  print "$_ --> $new\r\n";
  rename($_,$new);
 }
}, $start_dir );

2012年4月4日 星期三

用日期排列超級影音動物機下載的影片並砍掉垃圾檔

你是不是像我在太陽下低頭下載之後發現一堆垃圾檔案,也像我一樣覺得BT軟體不是按照下載完成的時間排放在資料夾中,覺得不是很方便。

我與一般使用者不一樣的地方就是,我會寫code解決這鳥事,不過就是把檔案撈出來砍掉嘛,順便重做連結讓找的時候方便一點而已,所以我寫出底下的code,這主要是運作在Linux伺服器上,我家的超級影音動物機(改天專題介紹一下這強大的機器),利用crontab排程更新資料就變得十分完美,只要丟檔案到AutoSeed資料夾下,等著看最新下載的就好,當然這個程式改一改就可以自動砍掉老舊的檔案,自動保持系統容量在一定的範圍之內。



#!/usr/bin/perl -w

use File::Basename;

$fileLocate="/media/mediaDisk";
@lines=`find $fileLocate/done`;
my $var=`rm -fr $fileLocate/dayList/*`;

my $index=0;

foreach $line(@lines){
	chomp($line);
	if(($line =~ /\.url$/i)||
	   ($line =~ /\.chm$/i)||
	   ($line =~ /\.mht$/i)||
	   ($line =~ /\.txt$/i)||
	   ($line =~ /___padding_file/)
	){
		unlink("$line");
	}
	if(($line =~ /\.mkv$/i)||
	   ($line =~ /\.avi$/i)||
	   ($line =~ /\.divx$/i)||
	   ($line =~ /\.mov$/i)||
	   ($line =~ /\.mp4$/i)||
	   ($line =~ /\.m4v$/i)||
	   ($line =~ /\.rmvb$/i)||
	   ($line =~ /\.rm$/i)||
	   ($line =~ /\.wmv$/i)||
	   ($line =~ /\.asf$/i)||
	   ($line =~ /\.ass$/i)||
	   ($line =~ /\.srt$/i)||
	   ($line =~ /\.ssa$/i)||
	   ($line =~ /\.sub$/i)||
	   ($line =~ /\.idx$/i)||
	   ($line =~ /\.vkt$/i)
	){
		if(-f $line){
			my @statArray=stat("$line");
			my ($sec,$min,$hour,$mday,$mon,$year)=localtime($statArray[9]);
			$year+=1900;
			$mon++;
			my $locate="$fileLocate/dayList/$year-$mon-$mday";
			#printf("%s\n",$line);
			if(!(-e $locate)){
				mkdir("$locate");
				print "[[$locate]]\n";
			}
			my($fname,$dir,$ext)=fileparse($line);
			print "$fname\n\t$dir\n\t$ext\n";
			print "ln -s \'$line\' \'$locate/$fname\'";
			if(-e "$locate/$fname"){
				$var=`ln -s \'$line\' \'$locate/$index_$fname\'`;
				$index++;
			}
			$var=`ln -s \'$line\' \'$locate/$fname\'`;
		}
	}else{
		if(-z $line){
			print ">>$line\n";
		}
	}
}

2011年8月14日 星期日

資料收集者的福音~網頁表格殺手,又是Perl發功(股票)

你是不是對一些公司基本面感到興趣?
你是不是很懶的去抄那一堆資料?
你還在用手算?

各位認識小弟的股友們有福了,信我,沒辦法給你上天堂,也沒辦法給永生,但是,讓你多空出點時間陪家人這小事還是做得到,底下的是Perl寫的webTableKiller,這網頁表格殺手主要功能就是把網頁上面的資料抓下來,讓後面串接的Script可以快速的取得網頁的資料,我是拿Yahoo的股市當祭品做出來。

Perl的特色是垮平台都可以使用,也可以找Perl2Exe轉成Windows執行檔(不建議)。

$./webTableKiller <網址> <取出目標欄位的.CSV檔案>











#!/usr/bin/perl
use LWP;
use HTML::TreeBuilder;
use Text::Iconv;

my $url="http://tw.stock.yahoo.com/d/s/company_3115.html"; 

if(defined $ARGV[0]){
  if($ARGV[0] =~ /^http/){
    $url=$ARGV[0];
  }
}

my $showAll=0;
my @getList;
my $getLists;

if(defined $ARGV[1]){
  if($ARGV[1] =~ /\.csv$/i){
    if(open(FH, "<$ARGV[1]")){
      @getList=;
      close FH;
    }
  }
}

foreach (@getList){
   $getLists.=$_;
}

my $ua=LWP::UserAgent->new;
my $res=$ua->get($url);
die "Can't get $url ", $res->status_line unless $res->is_success;
my $html=$res->content;

$converter = Text::Iconv->new("big5", "utf8");
$html = $converter->convert("$html");
#print "$html\r\n";

my $root=HTML::TreeBuilder->new_from_content($html);

my $layer=0;

&parserLookDown($root,$layer);

sub isOnList{
  my $currentPos=shift;
  my $count=0;

  foreach(@getList){
    if($_ =~ /$currentPos/){
      #print "$currentPos/\t$_\n";
      $count++;
    }
  }

  return $count;
}

sub parserLookDown{
  my $root=shift;
  my $layer=shift;
  $layer++;
  my @tables=$root->look_down(_tag=>'table');
  for my $i(0 .. @tables-1){
    my $tmp=$tables[$i]->as_trimmed_text;
    my @trs=$tables[$i]->look_down(_tag=>'tr');
    for my $j(0 .. @trs-1){
      my @tds=$trs[$j]->look_down(_tag=>'td');
      for my $k(0 .. @tds-1){
 if($tds[$k]->as_HTML =~ /table/){
   &parserLookDown($tds[$k],$layer);
 }
 my $tmp=$tds[$k]->as_trimmed_text;
 $_=~s/\ //g;
 if(@getList > 0){
   my $currentPos="$layer,$i,$j,$k";
   if(&isOnList($currentPos) > 0){
    print "$tmp,";
   }
 }else{
   print "($layer,$i,$j,$k)$tmp,";
 }
      }
      if(@getList <= 0){
 print "\r\n";
      }
    }
  }
}

$root->delete;