applescript⇒perl連携

applescript内でperl実行
そんなことが出来る。
やってみました。

#! applescript
--UpdateMailLabel
--メールアドレスからラベルを判定し設定する
--create date: 2009/08/20 auth:koizumi ver 1.0

property MAX_COUNT : 10000 --ループ最大値

tell application "Address Book"
	activate
	--アドレス毎ループ
	repeat with i from 1 to MAX_COUNT
		if i > (count of every person) then exit repeat
		set tmp_person to item i of every person
		
		--メールアドレス毎ループ
		repeat with j from 1 to MAX_COUNT
			if j > (count of emails of tmp_person) then exit repeat
			set tmp_email to item j of emails of tmp_person
			log "befor:" & label of tmp_email as string
			
			--メールラベル取得
			set tmp_label to get_email_label(value of tmp_email as string) of me
			
			if (tmp_label ≠ "") then
				--ラベルが空文字以外⇒ラベル設定
				set label of tmp_email to tmp_label
			end if
			
			log "after:" & label of tmp_email as string
		end repeat
	end repeat
end tell

--メールアドレスに対応するラベルを取得
--str_email:メールアドレス[String]
--returns:ラベル[String]
--remarks:
--	以下の場合は空文字返却場合、空文字返却
--	[判定出来ない, ラベルがstr_emailと同一]
on get_email_label(str_email)
	
	set label to ""
	
	if regex_match("/ezweb/", str_email) of me then
		set label to "au"
	else if regex_match("/i.softbank.jp$/", str_email) of me then
		set label to "iphone"
	else if regex_match("/mac.com$/", str_email) of me then
		set label to ".mac"
	else if regex_match("/.com$/", str_email) of me then
		set label to regex_replace("/.+@(.+).com$/$1/", str_email) of me
	else if regex_match("/[a-z]{2,2}.jp$/", str_email) of me then
		set label to regex_replace("/.+@(.+).[a-z]{2,2}.[a-z]{2,2}$/$1/", str_email) of me
	end if
	
	--str_emailと同一の場合は空文字
	if label = str_email then set label to ""
	
	return label
	
end get_email_label

--targetがregexにマッチするか判定
--regex:正規表現[String]
--target:対象となる文字列[String]
--returns:判定結果[bool]
--remarks:perl実行で判定、regexはperl正規表現に対応する文字列
on regex_match(regex, target)
	set command to "$target = q/" & target & "/; if ($target =~ " & regex & "){ print q/1/; }else{ print q/0/; }" --※引数を使用してperlコマンド生成
	set str_result to exec_perl(command) of me
	return (str_result = "1")
end regex_match

--targetをregexで置換
--regex:正規表現[String]
--target:対象となる文字列[String]
--returns:置換後文字列[String]
--remarks:perl実行で判定、regexはperl正規表現に対応する文字列
on regex_replace(regex, target)
	set command to "$target = q/" & target & "/; $target =~ s" & regex & "; print $target;" --※引数を使用してperlコマンド生成
	set str_result to exec_perl(command) of me
	return str_result
end regex_replace

--commandをperlで実行
--command:perl実行コマンド[String]
--returns:実行結果[String]
on exec_perl(command)
	set one_liner to "perl -e '" & command & "'" as Unicode text
	set str_result to do shell script one_liner --※shell実行
	--TODO:エラー処理
	return str_result
end exec_perl

set result to do shell script command

でshellでcommandを実行してresultに返ってくる
> commandをperlワンライナーにして実行
てな。

# ただ、applescript内でエスケープ記号が使えない。（構文エラーになってしまう...）

↑普通に重ねたらいけるようだ。
http://developer.apple.com/jp/technotes/tn2065.html
# 昨日いけなかった気がしたんだけども...