Perl サブルーチン集

sub get_query
{
	local(@pairs,$pair,$key,$value,$data);
	
	if ($ENV{"REQUEST_METHOD"} eq "POST")
	{
		read(STDIN,$data,$ENV{"CONTENT_LENGTH"});
	}
	else
	{
		$data=$ENV{"QUERY_STRING"};
	}
	
	@pairs=(split(/&/,$data),split(/&/,join("&",@ARGV)));
	%query=();
	foreach $pair (@pairs)
	{
		($key,$value)=split(/=/,$pair);
		$value=~tr/+/ /;
		$value=~s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
		
		$value=~s/</&lt;/g;
		$value=~s/>/&gt;/g;
		
		if ($value eq ()) { $value=""; }
		
		&jcode'h2z_sjis(*value);
		&jcode'convert(*value,"sjis");
		
		$query{$key}=$value;
	}
	
	%query;
}

%query=&get_query();

sub lock
{
	local($dev ,$ino ,$mode ,$nlink,$uid  ,$gid);
	local($rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks);
	local($lockfile);
	
	$lockfile=$_[0].".lock";
	while (-e $lockfile)
	{
		($dev ,$ino ,$mode ,$nlink,$uid  ,$gid,
		 $rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks)=stat($lockfile);
		if (time()-$ctime>$_[1]) { last; }
		sleep(1);
	}
	open(LOCK,">".$lockfile);
	close(LOCK);
}

sub unlock
{
	unlink $_[0].".lock";
}

&lock(ロックするファイル名,最長ロック時間);

&unlock(ロックしたファイル名);

$sendmail="/usr/lib/sendmail";
$system_mailer="mailer";

sub sendmail
{
	local($from,$to,$subject,$body);
	
	($from,$to,$subject,$body)=@_;
	
	open(MAIL,"|".$sendmail." -t");
	
	print MAIL "X-Mailer: ".$system_mailer."\n";
	print MAIL "Errors-To: ".$to."\n";
	print MAIL "To: ".$to."\n";
	print MAIL "From: ".$from."\n";
	print MAIL "Subject: ".(&jcode'jis($subject))."\n";
	print MAIL "Content-Transfer-Encoding: 7bit\n";
	print MAIL "Content-Type: text/plain\; charset=\"ISO-2022-JP\"\n";
	print MAIL "\n";
	print MAIL $body;
	
	close(MAIL);
}

&sendmail(送信元,送信先,タイトル,本文);

$system_agent="agent";

sub get_homepage
{
	local(%homepage,$address,$host,$path,$port);
	
	$address=$_[0];
	
	%homepage=();
	
	if ($address=~/^(http\:\/\/)([\.\-\:_0-9a-z]+)(\/[\/~&+%=\.\-\:_0-9a-z]*)$/g)
	{
		$host=$2;
		$path=$3;
	}
	else
	{
		$homepage{"error"}="不正なURLです。";
		
		return %homepage;
	}
	
	if ($host=~/^(.*)\:(\d*)$/g)
	{
		$host=$1;
		$port=$2;
	}
	else
	{
		$port=80;
	}
	
	$addr=(gethostbyname($host))[4];
	$name=pack("S n a4 x8",2,$port,$addr);
	socket(SOCKET,2,1,0);					# or 2,2,0
	if (!connect(SOCKET,$name))
	{
		$homepage{"error"}="接続に失敗しました。";
		
		return %homepage;
	}
	binmode(SOCKET);
	select(SOCKET);$|=1;select(stdout);
	
	print SOCKET "GET ".$path." HTTP/1.0\n";
	print SOCKET "Connection: close\n";
	print SOCKET "Host: ".$host."\n";
	print SOCKET "User-Agent: ".$system_agent."\n";
	print SOCKET "Referer: ".$this_url."\n";
	print SOCKET "Accept: text/html\n";
	print SOCKET "\n";
	
	$header=1;
	while ($line=<SOCKET>)
	{
		if ($header)
		{
			chop $line;
			chop $line;
			
			if (length($line)==0)
			{
				$header=0;
			}
			elsif ($line=~/^HTTP\/([\d\.]+) (\d+) (.+)$/g)
			{
				if ($2 ne "200")
				{
					$homepage{"error"}=$2." ".$3;
				}
			}
			elsif ($line=~/^(.+)\: (.+)$/g)
			{
				$homepage{$1}=$2;
			}
			else
			{
				print $line;
			}
		}
		else
		{
			$homepage{"body"}=$homepage{"body"}.$line;
		}
	}
	
	close(SOCKET);
	
	%homepage;
}

%homepage=&get_homepage(取得したいURLアドレス);