ゴミ置き場

• CGI.pm、CGI::Session、HTML::Template、Digest::MD5を使ったサンプル

書いている最中に仕様が変わってしまい無駄になってしまったが今後も使うかもしれないのでメモとして残しておく。

#!/usr/bin/perl -T

use strict;
use CGI;
use CGI::Session;
use HTML::Template;
use Digest::MD5;

my $cgi = new CGI;
my $session = new CGI::Session("driver:File", undef, {Directory=>'/tmp'});
my $CGISESSID = $session->id();

my $tmpl;

if('step1' eq $cgi->param('page')){
	if( is_valid($cgi->param('DOMAIN'), $cgi->param('COOKIE')) ){
		$session->param('is_valid', '1');
	}
	
	$tmpl = HTML::Template->new(filename => 'democlr_step1.tmpl');
	my $demodomains = get_demo_domains();
	$tmpl->param(DEMODOMAIN => $cgi->popup_menu(-name=>'demodomain', -values=>$demodomains, -default=>$$demodomains[0]) );
	$session->param('is_valid', '1');
}
elsif('step2' eq $cgi->param('page')){
	my $is_valid = $session->param('is_valid');
}
else{
}

my $ctx = Digest::MD5->new;
$ctx->add("mariners");

print $cgi->header(
	-type=>'text/html',
	-expires=>'+3d',
);
print $tmpl->output;

#print $q->start_html(-title=>'democlean', -bgcolor=>'#FFFFFF');
#print $ctx->hexdigest;
#print $q->end_html;

cleanup( "/www/a-mail/satoru.com/public_html/whatsnew" );

sub cleanup{
	my ( $dir ) = @_;
	$dir = untaint_filename( $dir );
	chdir( $dir ) or die "cant change dir: $dir";
	opendir(DIR, ".");
	my @tmp = sort readdir(DIR);
	my @file;
	foreach (@tmp){
		push @file, $_ if $_ ne '.' && $_ ne '..';
	}
	my $file;
	foreach $file (@file){
		if( -d $file ){
			cleanup($file);
			rmdir( untaint_filename($file) );
		}
		else {
			unlink( untaint_filename($file) );
		}
	}
	chdir( ".." ) or die "cant change dir: ..";
	return;
}

sub untaint_filename{
	my $re_filename =  qr/.*/;
	my $name = shift;
	die "$name is insecure" unless $name =~ /^($re_filename)$/;
	return $1;
}

sub is_valid{
	my($domain, $cookie)=@_;
	open(FH, "/www/script/data/userdb") || die "can't open /www/script/data/userdb .";
	while(<FH>){
		chomp;
		my ($dmn, $user, $ck) = split /,/;
		if($domain eq $dmn && $cookie eq $ck){
			return 1;
		}
	}
	0;
}

sub get_demo_domains{
	open(FH, "democlr.data") || die "can't open democlr.data .";
	my @demodomains;
	while(<FH>){
		chomp;
		push @demodomains, $_;
	}
	\@demodomains;
}

• md5のところだけ

use Digest::MD5;
print Digest::MD5->new()->add("ABCDE")->hexdigest;

• PerlでPOP3サーバーにアクセスしてメールを取り出すサンプル

use strict;
use Net::POP3;

my $host='pop.mail.yahoo.com';
my $username='yukio1980';
my $password='5963abc';

my $pop = Net::POP3->new($host);

if ($pop->login($username, $password) > 0) {
	my $msgnums = $pop->list;
	my $i=1;
	foreach my $msgnum (keys %$msgnums) {
		my $msg = $pop->get($msgnum);
		open(FH, ">$host" . "_" . "$i.eml");
		print FH <<END_OF_MAIL
@$msg
END_OF_MAIL
;
		close(FH);
		$i++;
	}
}
else {
	print "login failed.";
}

• gethostbyname の使い方

print join('.', unpack('C*', gethostbyname 'rukatan.com') );

• Encode.pm のfrom_to を使ったCGIのサンプル

euc-jpの文字列をutf-8に変換して表示する。

#!/usr/bin/perl

use strict;
use CGI;
use Encode qw(from_to);

my $q = new CGI;

print $q->header( -type=>'text/html', -charset=>'utf-8' );
my $s = $q->param('s');
from_to( $s, 'euc-jp', 'utf8');
print $s;

• LWP::UserAgent の使い方のサンプル

use LWP::UserAgent;

sub get_contents {
        my($url) = shift;
        my $ua = LWP::UserAgent->new;
        my $res = $ua->get($url);
        return $res->content;
}

• Net::FTP の使い方サンプル

#!/usr/bin/perl

use strict;
use Net::FTP;

if(@ARGV < 4 ){
	die "usage: perl putfile.pl ftphostname username password filepath", "\n";
	
}

putFile( $ARGV[0], $ARGV[1], $ARGV[2], $ARGV[3] );

sub putFile {
	my($hostname, $username, $password, $filepath)=@_;
	my $ftp = Net::FTP->new($hostname, Debug => 0);
	$ftp->login($username, $password) or die "Cant login $hostname, $username, $password";
	#$ftp->cwd("");
	#$ftp->get("that.file");
	$ftp->put($filepath) or die "couldnt put " . $filepath;
	$ftp->quit;
}