# パスワード付きのmdbファイルにアクセスする例
# PASSWORD というパスワードをもつ hoge.mdb に接続する。

use Win32::OLE;
my $password="PASSWORD";

# 接続文字列を作る
$connStr="Provider=Microsoft.Jet.OLEDB.4.0;";
$connStr.="Data Source=hoge.mdb;";
# 接続文字列にパスワードを追加
$connStr.="Jet OLEDB:Database Password=$password;" if($password ne "");

#アクセスのデータベースへの接続
$objDB=Win32::OLE->new("ADODB.Connection");
$objDB->Open($connStr);

#
# ここに読み書きその他の処理を書く。
#

# 接続を閉じる
$objDB->Close();
$objDB=undef();

#
# hoge.mdb に接続して、パスワードを変更。
#
use Win32::OLE;
$password="PASSWORD";       #変更前のパスワード
$newpassword="NEWPASSWORD"; #変更後のパスワード

# 接続文字列を作る
$connStr="Provider=Microsoft.Jet.OLEDB.4.0;";
$connStr.="Data Source=hoge.mdb;";
# 接続文字列にパスワードを追加
$connStr.="Jet OLEDB:Database Password=$password;" if($password ne "");

#アクセスのデータベースへの接続
$objDB=Win32::OLE->new("ADODB.Connection");
$objDB->{Mode}=12; # 排他モードにする。
$objDB->Open($connStr);

# パスワード変更
$newpassword="NULL" if($newpassword eq "");
$cmd=$objDB->Execute(
	"ALTER DATABASE PASSWORD $newpassword $password"
 );

# 接続を閉じる
$objDB->Close();
$objDB=undef();

use strict;
use Win32::OLE;
use Win32;

my $strComputer=".";
my $wmi = Win32::OLE->GetObject(
  "WinMgmts:{impersonationLevel=impersonate}!//".
  "$strComputer\\root\\cimv2"
) or die;
my $colDiskDrives = $wmi->ExecQuery(
  "SELECT * FROM Win32_DiskDrive"
);
for my $disk (in $colDiskDrives) {
	next if $disk->{PNPDeviceID}!~/^usbstor/i;
	print "$disk->{PNPDeviceID}\n";
}

use Business::ISBN qw( isbn_to_ean ean_to_isbn );
$isbn_10="4873113008";
$isbn_13=isbn_to_ean($isbn_10); # 旧ISBN ---> 13桁ISBN
$isbn_10=ean_to_isbn($isbn_13); # 13桁ISBN ---> 旧ISBN

package MT::Plugin::RepeatStr;
use strict;
use MT::Template::Context;

MT::Template::Context->add_tag(RepeatStr=> \&repeat);

sub repeat {
	my($ctx, $arg)=@_;
	my $str = $arg->{str} x $arg->{kaisuu};
	$str;
}
1;

package MT::Plugin::Eval;
use strict;
use MT::Template::Context;

MT::Template::Context->add_tag(PerlEval=>\&perleval);

sub repeat {
	my($ctx, $arg)=@_;
	eval($arg->{eval});
}
1;

package MT::Plugin::YahooLink;
use strict;
use MT::Template::Context;

MT::Template::Context->add_tag(YahooLink=>\&yhlink);

sub yhlink {
	my $url="http://www.yahoo.co.jp/";
	"<a href='$url'>$url</a>";
}
1;

package MT::Plugin::ColorEzo;
use strict;
use MT::Template::Context;
MT::Template::Context->add_global_filter(
            ColorEzo=>\&ClrEzo  );
sub ClrEzo {
    my($text, $arg, $ctx) = @_;
    $text=~s/(tech-ezo)/<font color='$arg'>$1<\/font>/ig;
    $text;
}
1;

package MT::Plugin::ColorEzo;
use strict;
use MT::Template::Context;

# Global Filter RedEzo の定義
MT::Template::Context->add_global_filter(
	RedEzo => \&ChangeRedEzo);

# Filter によって起動されるメソッド
sub ChangeRedEzo {
    my($text, $arg, $ctx) = @_;
    $text=~s/(tech-ezo)/<font color='red'>$1<\/font>/ig;
    $text;
}
1;

$line='A,BB,CCC,,D';
@values=split(/,/,$line);

$tmp=$line='"""北海道,札幌市""",ABC,"XX,XX","abc"';
$tmp=~s/(?:\x0D\x0A|[\x0D\x0A])?$/,/;
@values=map {/^"(.*)"$/?scalar($_=$1,s/""/"/g,$_):$_}
        ($tmp =~ /("[^"]*(?:""[^"]*)*"|[^,]*),/g);

use Text::CSV_XS;
$csv=Text::CSV_XS->new({binary=>1}); #create a object
$line='"北海道,札幌市",ABC,"XX,XX","""abc"""';
$status=$csv->parse($line);          #parse a string
@values=$csv->fields();              #get the fields
print join("\n",@values);

use LWP;
use HTML::LinkExtor;

$url="http://www.augustus.to/";
$browser = LWP::UserAgent->new;
$response = $browser->get($url);

$p = HTML::LinkExtor->new(\&callback,$url);
$p->parse($response->{_content});

sub callback {
    my($tag, %links) = @_;
    print "$tag @{[%links]}\n";
}

use LWP;
use HTML::LinkExtor;

$url="http://www.augustus.to/";
$browser = LWP::UserAgent->new;
$response = $browser->get($url);

$p = HTML::LinkExtor->new(unlink(),$url);
$p->parse($response->{_content});
for $x ($p->links){
    print join(" ", @{$x}),"\n";
}

use LWP;
use HTTP::Cookies;

$url="http://www.amazon.co.jp/"; #アクセスする URL
$file="cookies_amazon.txt";      #クッキーを保存するファイル

$browser = LWP::UserAgent->new;
$browser->cookie_jar({file =>$file, autosave=>1 });
$response = $browser->get($url);
print $response->{_content};

use LWP;
use HTTP::Request::Common;

$domain="www.augustus.to";
$port=80;
$realm="Auth_Test";   #領域名
$user="authtestuser"; #ユーザ名
$passwd="password";   #パスワード
$url="http://www.augustus.to/test/authtest/";

$browser = LWP::UserAgent->new;
$browser->credentials(
    "$domain:$port",$realm,$user,$passwd);
$response = $browser->get($url);
print $response->{_content};

構文１：シグナルを待つ
waitfor [/t TimeoutInSeconds] SignalName
SignalName という名のシグナルを待つ。シグナルが来るか、TimeoutInSeconds 秒経過するとこのコマンドは終了する。「/t TimeoutInSeconds」を省略したときは無期限にシグナルを待機し続ける。

構文２：シグナルを送る
waitfor [/s Computer [/u [Domain\]User [/p [Password]]]] /si SignalName
/s シグナルの送り先コンピュータ名またはIPを指定。規定値はローカルコンピュータ。
/si 送るシグナルの名前を指定。
/u 指定したユーザの権限で実行。 /p でパスワードも指定する。

これを使うと複数のバッチを同期させたり、複数のコンピュータの同期をバッチで行うことが可能である。
以前は同様のことをしたいときは、テンポラリのファイルを作成するなどして実現していたと聞く。 waitfor コマンドを使うと、ゴミも残らず、タイムアウトも指定できるなど利点が大きい。

例：
comp1 で foo1.bat, comp2 で foo2.bat を実行する。 foo2.bat の終了を foo1.bat の中で待つ。

##### comp1 / foo1.bat #####
echo comp2 の foo2.bat を待ちます。
waitfor foosignal
echo comp2 の foo2.bat は終わったようだ。

##### comp2 / foo2.bat #####
echo foo2.bat がスタートします。
////// 時間のかかる仕事 //////
waitfor /s comp1 /si foosignal