memo.xight.org

#!/usr/bin/perl
use strict;
use GD::Barcode::QRcode;
 
my $str         = $ENV{'HTTP_REFERER'};
my $header      = qq(Content-Type: image/png\n\n);
my $qr          = GD::Barcode::QRcode->new($str,{ ECC => 'L', Version => 2, ModuleSize =>2,})->plot->png;
print $header,$qr;
exit;

<img src="path/to/qr.cgi" width="97" height="97" alt="QRcode" />

#$oSelf->{Version} = $rhPrm->{Version} || 1;
$oSelf->{Version} = $rhPrm->{Version};

#!/usr/bin/perl
use strict;
use CGI;
use GD::Barcode::QRcode;
 
my $q		= new CGI;
my $str		= $q->param('q');
my $header	= qq(Content-Type: image/png\n\n);
my $qr		= GD::Barcode::QRcode->new($str)->plot->png;
print $header,$qr;
exit;

use Number::Phone::JP;
 
my $tel = Number::Phone::JP->new('012', '34567890');
print "This is valid!!\n" if $tel->is_valid_number;
 
$tel->set_number('098 7654 3210');
print "This is valid!!\n" if $tel->is_valid_number;
 
$tel->import(qw(mobile PHS));
$tel->set_number('090-0123-4567');
print "This is valid!!\n" if $tel->is_valid_number;

use Regexp::Assemble;
 
my $ra = Regexp::Assemble->new;
$ra->add( 'ab+c' );
$ra->add( 'ab+-' );
$ra->add( 'a\w\d+' );
$ra->add( 'a\d+' );
print $ra->re; # prints a(?:\w?\d+|b+[-c])

use CGI;
use Authen::TypeKey;
my $q = CGI->new;
my $tk = Authen::TypeKey->new;
$tk->token('typekey-token');
my $res = $tk->verify($q) or die $tk->errstr;

## In httpd.conf or .htaccess:
PerlModule Apache::AuthTypeKey
PerlSetVar TypeKeyPath /
PerlSetVar TypeKeyLoginScript /login.pl
 
## These documents require user to be logged in.
<Location /protected>
	AuthType          Apache::AuthTypeKey
	AuthName          TypeKey
	PerlAuthenHandler Apache::AuthTypeKey->authenticate
	require           valid-user
	PerlSetVar        TypeKeyToken your_token
</Location>
 
## This is the _return URL that the login.pl script should point to.
<Location /login-protected>
	AuthType    Apache::AuthTypeKey
	AuthName    TypeKey
	SetHandler  perl-script
	PerlHandler Apache::AuthTypeKey->login
	PerlSetVar  TypeKeyToken your_token
</Location>

#!/usr/bin/perl
use Email::Valid;
print (Email::Valid->address('user@example.com') ? 'yes' : 'no');

#!/usr/bin/perl
use Mail::CheckUser qw(check_email last_check);
 
my $email = 'user@example.com';
 
if(check_email($email)) {
	print "E-mail address <$email> is OK\n";
} else {
	print "E-mail address <$email> isn't valid: ", last_check()->{reason}, "\n";
}

use Data::Validate::Email qw(is_email is_email_rfc822);
 
if(is_email($suspect)){
	print "Looks like an email address\n";
} elsif(is_email_rfc822($suspect)){
	print "Doesn't much look like an email address, but passes rfc822\n";
} else {
	print "Not an email address\n";
}