perl下载处理二进制数据(如tiff格式图片)的方法

perl对于文本的处理功能非常强大。而对于二进制流数据，比如图片，pdf等数据，我不太了解。今天把我项目中用到的perl代码列出来，供大家参考。

该项目任务是这样的，需求如下：

（1）从html中解析出下载地址，这个地址有很多个，从1-400不等。

（2）下载该地址，得到对应的图片数据，写入到本地中。

（3）然后把所有下载完后的tiff先合并为1个tiff，然后转化tiff为pdf。

（4）pdf为我们所需要的文件。删除其他所有目录下的tiff文件。

这里就出现了2个问题：

（1）刚开始下载的第一个tiff格式，会经常提示有个错误。可能是流数据的前几个字符标签有问题。无法预览，但是可以通过windows自带的图片进行查看。

（2）在删除最后的一个tiff文件时，总是提示权限不足。除非我删除其上一级目录。

 

暂时列出代码：

#! perl use File::Slurp; use File::Path; use LWP; use DBI; #my $dir = "F:/patentDown/"; #创建文件夹和图片的目录 print "请输入html所在的文件夹位置：例如E:/cnpat//n"; my $dir = <STDIN>; chomp $dir; my $browser = LWP::UserAgent->new(); opendir(AIMDIR,$dir) or die $!; #open(SUCCESS,">F:/cnpat/successedID.txt") or die $!; #相当于对每个数字生成相应的文件夹，比如65432，我们就生成6/54/32/ sub mkdirlevel($$){ $str = shift; $dir = shift; $length = length($str); if($length % 2 == 0){ #偶数位 $str =~ s/(/w{2})/$1///g; }else{ #奇数位，先取出第一位，然后剩下的每2位替换一次 $firstChar = substr($str,0,1); $leftChar = substr($str,1); $leftChar =~ s/(/w{2})/$1///g; $str = $firstChar."/".$leftChar; } return $dir.$str; } #获取公开说明书中的下载地址，把获取到的data输出到给定的目录地址。记住地址的最后有/ sub getPublicSpecification($$){ my $data = shift; my $location = shift; if($data =~ /<!--公开说明书form-->.*?<input name="picstr" type="hidden" id="picstr" value="(.*?)".*?<input name="PAGE" type="hidden" id="PAGE" value="(/d+)"/s){ my $url = $1; my $nums = $2; for($i=1;$i<=$nums;$i++){ # push(@urls,$url.$i); my $content = $browser->get($url.$i)->content(); #得到了每个pdf的链接地址 open(AIM,">".$location."/publicSpecification/".$i.".tiff") or die $!; binmode(AIM); print AIM $content; #把每个得到的tiff分别写到每个图形文件 } # print "_______________________________________________$location/n"; multiff2pdf($location."publicSpecification/","public"); } } #获取授权说明书中的下载地址 sub getAuthSpecification($$){ my $data = shift; my $location = shift; if($data =~ /<!--授权说明书form-->.*?<input name="picstr" type="hidden" id="picstr" value="(.*?)".*?<input name="PAGE" type="hidden" id="PAGE" value="(/d+)"/s){ my $url = $1; my $nums = $2; for($i=1;$i<=$nums;$i++){ my $content = $browser->get($url.$i)->content(); #得到了每个pdf的链接地址 open(AIM,">".$location."/authSpecification/".$i.".tiff") or die $!; binmode(AIM); print AIM $content; } # print "_______________________________________________$location/n"; multiff2pdf($location."authSpecification/","auth"); } } #传入一个文件夹目录，最后有/，读取当前文件夹目录中的所有tiff文件，然后把所有的tiff文件合并为1个tiff文件。 #最后将合并前的tiff文件删除。把合并后的tiff文件转化为pdf sub multiff2pdf($$){ my $dir = shift; #这里的目录最后有/ my $name = shift; # print $dir; my $nums=0; #用来计算一个文件夹下有多少个tiff文件 my $tiffcp = "soft/tiffcp.exe "; opendir(TIFF,$dir) or die $!; @files = grep(!/^/./.?$/,readdir TIFF); #用来获得非.或者..的文件 $nums = scalar(@files); #就可以知道该数组有多少个元素了 for($i=1;$i<=$nums;$i++){ $tiffcp .="$dir"."$i".".tiff "; } $tiffcp .="$dir"."only.tiff"; system($tiffcp); # print $tiffcp; # print "/n"; $tiff2pdf ="soft/tiff2pdf.exe $dir"."only.tiff -o $dir../(".$nums.")$name.pdf"; # print($tiff2pdf); # print "/n"; system($tiff2pdf); foreach $file(@files){ unlink $dir.$file; # print $dir.$file."/n"; # if(unlink $dir.$file){ # print "$dir.$file删除成功！/n"; # } } unlink $dir."only.tiff"; # unlink $dir.$nums.".tiff"; # while(my $tiffFile = readdir TIFF){ # if($tiffFile =~ //.tiff/){ # print $dir.$tiffFile."/n"; # unlink $dir.$tiffFile; #删除每个tiff文件 # } # } # deleteTiff($dir); } #删除该目录 sub deleteTiff($){ my $location = shift; rmtree($location); # opendir(DIR,$location) or die $!; # while(my $file=readdir DIR){ # if($file =~ //.tiff/){ # unlink $location.$file; # } # } } sub getTableValue($){ my $data = shift; # print $data; if($data =~ / <td/swidth="110"/sheight="20"/sbgcolor="/#C8D6EE"> 申请号： <//td>.*? <td/swidth="155"/sheight="20"/sbgcolor="/#FFFFFF"> (/d+) <//td>.*? <td/swidth="110"/sheight="20"/sbgcolor="/#C8D6EE"> 申请日： <//td>.*? <td/swidth="224"/sheight="20"/sbgcolor="/#FFFFFF"> (.*?) <//td>.*? <td/swidth="110"/sheight="20"/sbgcolor="/#C8D6EE"> 公开日：<//td>.*? <td/sheight="20"/sbgcolor="/#FFFFFF"> (.*?) <//td>.*? <td/swidth="110"/sheight="20"/sbgcolor="/#C8D6EE"> 公告日：<//td>.*? <td/sheight="20"/sbgcolor="/#FFFFFF"> (.*?) <//td>.*? <td/swidth="110"/sheight="20"/sbgcolor="/#C8D6EE"> 公开号： <//td>.*? <td/sheight="20"/sbgcolor="/#FFFFFF"> (.*?) <//td>.*? <td/swidth="110"/sheight="20"/sbgcolor="/#C8D6EE"> 公告号：<//td>.*? <td/sheight="20"/sbgcolor="/#FFFFFF">(.*?)<//td>.*? <td/swidth="110"/sheight="20"/sbgcolor="/#C8D6EE">授权日：<//td>.*? <td/sheight="20"/sbgcolor="/#FFFFFF">(.*?)<//td>.*? <td/swidth="110"/sheight="20"/sbgcolor="/#C8D6EE">授权公告日：<//td>.*? <td/sheight="20"/sbgcolor="/#FFFFFF">(.*?)<//td>.*? <td/swidth="110"/sheight="20"/sbgcolor="/#C8D6EE">专利类别：<//td>.*? <td/sheight="20"/sbgcolor="/#FFFFFF">/s*(.*?)<//td>.*? <td/swidth="110"/sheight="20"/sbgcolor="/#C8D6EE">国别省市代码：<//td>.*? <td/sheight="20"/sbgcolor="/#FFFFFF">(.*?)<//td>.*? <td/swidth="110"/sheight="20"/sbgcolor="/#C8D6EE">代理机构代码：<//td>.*? <td/sheight="20"/sbgcolor="/#FFFFFF">(/d+)<span.*? <td/swidth="110"/sheight="20"/sbgcolor="/#C8D6EE">代理人：<//td>.*? <td/sheight="20"/sbgcolor="/#FFFFFF">(.*?)<//td>.*? <td/swidth="110"/sheight="20"/sbgcolor="/#C8D6EE">发明名称：<//td>.*? <td/sheight="20"/scolspan="3"/sbgcolor="/#FFFFFF">(.*?)<//td>.*? <td/swidth="110"/sheight="20"/sbgcolor="/#C8D6EE">国际分类号：<//td>.*? <td/sheight="20"/scolspan="3"/sbgcolor="/#FFFFFF">(.*?)<//td>.*? <td/swidth="110"/sheight="20"/sbgcolor="/#C8D6EE">范畴分类号：<//td>.*? <td/sheight="20"/scolspan="3"/sbgcolor="/#FFFFFF">(.*?)<//td>.*? <td/swidth="110"/sheight="20"/sbgcolor="/#C8D6EE">发明人：<//td>.*? <td/sheight="20"/scolspan="3"/sbgcolor="/#FFFFFF">(.*?)<//td>.*? <td/swidth="110"/sheight="20"/sbgcolor="/#C8D6EE">申请人：<//td>.*? <td/sheight="20"/scolspan="3"/sbgcolor="/#FFFFFF">(.*?)<//td>.*? <td/swidth="110"/sheight="20"/sbgcolor="/#C8D6EE">申请人地址：<//td>.*? <td/sheight="20"/scolspan="3"/sbgcolor="/#FFFFFF">(.*?)<//td>.*? <td/swidth="110"/sheight="20"/sbgcolor="/#C8D6EE">邮编：<//td>.*? <td/sheight="20"/scolspan="3"/sbgcolor="/#FFFFFF">(.*?)<//td>.*? <td/sheight="20"/scolspan="4"/sbgcolor="/#C8D6EE">文摘：<//td>.*? <td/sheight="20"/scolspan="4"/sbgcolor="/#FFFFFF"><span/sclass="line18"/sstyle="padding:5px;">(.*?)<//span><//td>.*? <td/sheight="20"/scolspan="4"/sbgcolor="/#C8D6EE">主权利要求：<//td>.*? <td/sheight="20"/scolspan="4"/sbgcolor="/#FFFFFF"><span/sclass="line18"/sstyle="padding:5px;">(.*?)<//span><//td>.*? <td/sheight="20"/scolspan="4"/sbgcolor="/#C8D6EE">优先权项：<//td>.*? <td/sheight="20"/scolspan="4"/sbgcolor="/#FFFFFF"/sstyle="padding-left:10px;"/s>/s+(.*?)<//td>.*? <td/sheight="20"/scolspan="4"/sbgcolor="/#C8D6EE">PCT/s项<//td>.*? <td/sheight="20"/scolspan="4"/sbgcolor="/#FFFFFF"/sstyle="padding-left:30px;">/s+(.*?)/s+<//td>/s+<//tr>/s+<tr>/s+<td/sheight="20"/sbgcolor="#C8D6EE">法律状态： /xs){ my $applyNum = $1; #申请号 my $applyDate = $2; #申请日 my $publicDate = $3; #公开日 my $issueDate = $4; #公告日 my $openNum = $5; #公开号 my $notifyNum = $6; #公告号 my $authDate = $7; #授权日 my $authNotifyDate = $8; #授权公告日 my $patentType = $9; #专利类别 my $countryCode = $10; #国别省市代码 my $agentOrgCode = $11; #代理机构代码 my $agent = $12; #代理人 my $invention = $13; #发明名称 my $intelTypeNum = $14; #国际分类号 my $catagoryNum = $15; #范畴分类号 my $inventor = $16; #发明人 my $application = $17; #申请人 my $applyAddress = $18; #申请人地址 my $zip = $19; #邮编 my $digest = $20; #文摘 my $mainClaims = $21; #主权利要求 my $priorityItem = $22; #优先权项 my $pct = $23; #PCT项 my $dbh = DBI->connect("DBI:mysql:database=patent;host=192.168.200.254","dxy","p0o9i8u7"); $dbh->do("set names gb2312"); #注意这里的编码是根据你pl文件的编码格式来的。 my $sql = "insert into patent(applyNum,applyDate,publicDate,issueDate,openNum,notifyNum,authDate,authNotifyDate,patentType, countryCode,agentOrgCode,agent,invention,intelTypeNum,catagoryNum,inventor,application,applyAddress, zip,digest,mainClaims,priorityItem,pct) values ('$applyNum','$applyDate','$publicDate','$issueDate','$openNum','$notifyNum','$authDate','$authNotifyDate','$patentType','$countryCode', '$agentOrgCode','$agent','$invention','$intelTypeNum','$catagoryNum','$inventor','$application','$applyAddress','$zip','$digest','$mainClaims','$priorityItem','$pct')"; $dbh->do($sql); $dbh->disconnect(); # open(SQL,">F:/insert.sql") or die $!; # print SQL $sql; # print "/n/n/n/n/n"; ## print $22."====================>/n"; }else{ print "没有符合的匹配哦-------------------------------------->！/n" } } while($HTMLfile = readdir(AIMDIR)){ if($HTMLfile =~ /(/d*)/.html/){ $location = mkdirlevel($1."",$dir); #得到了每个文件的绝对路径 # print $location."publicSpecification"; mkdir($location); #生成相应的文件夹，用来存放下载后的每个pdf文件 mkdir($location."publicSpecification/"); mkdir($location."authSpecification/"); #生成相应的文件夹，用来存放下载后的每个pdf文件 my $data = read_file($dir.$HTMLfile); #现在读取的是html文件 getPublicSpecification($data,$location); getAuthSpecification($data,$location); getTableValue($data); } }

 

我可能会不停的进行修改这个程序吧。