複数の Perl モジュールを一発でインストール

- bundle を作成して Perl モジュールのインストールを簡単に
  http://hori-uchi.com/archives/000254.html

package Bundle::Foo;

$VERSION = '1.00';

1;

__END__

=head1 NAME

Bundle::Foo - foo

=head1 SYNOPSIS

perl -MCPAN -e 'install Bundle::Foo'

=head1 CONTENTS

Foo::bar

Hoge::Hoge

  こんな感じでモジュールを作って，

$ perl -MCPAN -e 'install Bundle::Foo'

  で，Foo::bar と Hoge::Hoge がインストールされる．こりゃ楽だ．

in_array()

  mixi で知ったんだが．
  これ便利かも．ただし，in_array() は大文字小文字を区別する．

- 例
  $a が "Mac", "NT", "Irix", "Linux" の時に何かする場合

if ($a == "Mac" || $a == "NT" || $a == "Irix" $a ==  "Linux") {
    print "hoge";
}

  としなくても

$os = array ("Mac", "NT", "Irix", "Linux");
if (in_array ($a, $os)) {
    print "hoge";
}

  でいける．

- in_array()
  http://www.php.net/in_array

Perl で配列の配列を作る

my (@a, @b);
push @a, [ @b ];

for my $aref ( @a ) {
    print "[ @$aref ]\n";
}

for my $i ( 0 .. $#a ) {
    print "$i: [ @{$a[$i]} ]\n";
}

for my $i ( 0 .. $#a ) {
    for my  $j ( 0 .. $#{$a[$i]} ) {
        print "$i: $j: $a[$i][$j]\n";
    }
}

- Perl で配列の配列を操作する
  http://perldoc.jp/docs/perl/5.6.1/perllol.pod

開いているファイルのショートカットをデスクトップに作る VBA マクロ

' 開いているファイルのショートカットをデスクトップに作る
Sub CreateShortCut()
    
    Dim WSH As Object
    Dim objShortCut As Object
    
    ' ファイルが開かれているかどうか
    If Documents.Count = 0 Then
        MsgBox "ファイルが開かれていません。", vbExclamation
        Exit Sub
    End If
    
    ' ファイルが一回でも保存されているかどうか
    If Len(ActiveDocument.FullName) = 0 Then
        MsgBox "ファイルが保存されていません。ファイルを保存してください。", vbExclamation
    End If
    
    Set WSH = CreateObject("WScript.Shell")
    
    ' デスクトップにショートカットを作成
    Set objShortCut = WSH.CreateShortCut(WSH.SpecialFolders("Desktop") & "\" & ActiveDocument.Name & ".lnk")
    With objShortCut
        .TargetPath = ActiveDocument.FullName
        .WorkingDirectory = ActiveDocument.Path
        .Save
    End With
    
End Sub

テキストファイルを Gmail にバックアップする

  主にテキストファイルを Gmail にバックアップするつもりででっち上げてみたが，車輪の再開発のような気がしてならない．

#!/usr/bin/env perl

use strict;
use Net::SMTP;
use MIME::Entity;
use File::MMagic;
use Getopt::Long;
use Encode qw/from_to/;
use Encode::Guess qw/euc-jp shiftjis 7bit-jis/;
use Compress::Zlib;
use FileHandle;
use File::Basename;

# SMTP サーバ
my $mailhost = 'smtp.server';

my $from    = $ENV{USER};
my $subject = "";
my @files   = ();

# コマンドライン引数
Getopt::Long::config('bundling');
my $gor = GetOptions(
            'f|from=s'    => \$from,
            's|subject=s' => \$subject,
            'a|attach=s@' => \@files,
);

if (@ARGV == 0 or $gor == 0) {
    print << "USAGE";
usage: $0 mailto [options]
    -f, --from=MAIL         mail from
    -s, --subject=SUBJECT   subject
    -a, --attach=FILE       attachment file(s)
USAGE
    ;
    exit;
}

my $to = shift;

my $smtp = Net::SMTP->new($mailhost) or die;
$smtp->mail($from);
$smtp->to($to);

my $mime = MIME::Entity->build(
    From    => tojis($from),
    To      => tojis($to),
    Subject => tojis($subject),
    Data    => [""]
);

# 添付ファイルのデータを構築
my $mm = new File::MMagic;
for my $file (@files) {
    my $type = $mm->checktype_filename($file);
    my $path = "";
    my $data = "";
    my $name = "";

    # ファイルタイプが 'text/plain' のときは，gzip で圧縮する
    if ($type eq 'text/plain') {
        my $fh = new FileHandle($file);
        $data = join("", $fh->getlines());
        # 圧縮
        deflateInit(-Level => Z_BEST_COMPRESSION);
        $data = Compress::Zlib::memGzip($data);
        $type = 'application/x-gzip';
        # ファイル名を取得
        fileparse_set_fstype('VMS');
        $name = basename($file, "") . '.gz';
    } else {
        $path = $file;
    }

    $mime->attach(
        Path     => $path,
        Type     => $type,
        Data     => $data,
        Filename => $name,
        Encoding => 'Base64'
    );
}

$smtp->data();
$smtp->datasend($mime->stringify);
$smtp->dataend();
$smtp->quit;

#
# エンコードを jis に変換
#
sub tojis {
    my ($data) = @_;
    my $enc = guess_encoding($data);

    from_to($data, $enc->name, 'jis');
    return $data;
}

正多角形のオートシェイプを作成する PowerPoint のマクロ

'
' DrawPolygon
' 正多角形のオートシェイプを作成する
'
' angle:  角の数
' radius: 半径 (px)
' lines:  中心から各頂点までの線を引くかどうか - 規定値 True (引く)
' orig_x: 画面上での原点 X (px) - 規定値 360px
' orig_y: 画面上での原点 Y (px) - 規定値 270px
'
Public Sub DrawPolygon(angle As Long, radius As Single, Optional lines As Boolean = True, _
                       Optional orig_x As Single = 360#, Optional orig_y As Single = 270#)
    
    Const PI As Single = 3.1415926535 ' 円周率
    
    Dim x()  As Single
    Dim y()  As Single
    Dim Sp   As Shapes
    Dim i As Long
    
    ReDim x(angle)
    ReDim y(angle)
    
    ' 各角の座標の決定
    For i = 0 To angle - 1
        x(i) = orig_x + Cos(2 * PI * i / angle) * radius
        y(i) = orig_y - Sin(2 * PI * i / angle) * radius
    Next
    
    Set Sp = ActiveWindow.Selection.SlideRange.Shapes
    
    ' 多角形を作成
    With Sp.BuildFreeform(msoEditingAuto, x(angle - 1), y(angle - 1))
        For i = 0 To angle - 1
            .AddNodes msoSegmentLine, msoEditingAuto, x(i), y(i)
        Next
        .ConvertToShape.Fill.Visible = msoFalse
    End With
    
    If lines Then
        ' 中心から頂点までの線をひく
        For i = 0 To angle - 1
            Sp.addLine orig_x, orig_y, x(i), y(i)
        Next
    End If
    
End Sub

Perl 5.8.x で文字コードの自動判別と変換

use Encode qw/from_to/;
use Encode::Guess qw/euc-jp shiftjis 7bit-jis/;

my $data = 'データ';
my $enc  = guess_encoding($data);
my $from = $enc->name;
my $to   = 'euc-jp';

from_to($data, $from, $to);

print $data;

- Encode
  http://perldoc.com/perl5.8.0/lib/Encode.html

- Encode::Guess
  http://www.perldoc.com/perl5.8.0/lib/Encode/Guess.html

Vim で PHP 関数の辞書を作成する方法についてのメモ

  http://www.asahi-net.or.jp/~wv7y-kmr/memo/vim_php.html

<?php
$functions = get_defined_functions();
sort( $functions['internal'] );
echo implode( "\n", $functions['internal'] );
?>

class の中で preg_replace_callback() を使うときに，コールバック関数の呼び出し方

array($this, 'callback')

  がポイント．

<?php
class foo {
    function bar() {
        print preg_replace_callback($pattern, array($this, 'callback'), $string);
    }
    
    function callback($matches) {
        return ...;
    }
}
?>

コマンドラインから使える世界時計

  http://namazu.org/~satoru/diary/20040920.html#p01

- Solaris 用はこちら

#! /bin/zsh
cd /usr/share/lib/zoneinfo
zdump **/*(.)