perl [-l] [-s] script_file [file...]
Perl はテキストフィルタとしての利用だけでなく、汎用なシステム操作記述言語としての利用に十分な組み込み関数や拡張モジュールが充実しており、シェル環境で足りない機能を外部コマンドとして拡充するだけの能力が備わっている。
Perl スクリプトを外部コマンドとして利用する為には、Unix 環境では以下のような行頭から始めればよい。
#!/usr/bin/perl :
また、コマンドラインオプションを指定するには、以下のように perl -s のように起動すれば、そのコマンドに指定したオプションが変数として定義されるようになる。
#!/usr/bin/perl -s :
Perl には多様な拡張モジュールが備わり、その上、CPAN では数多のサードパーティ製拡張モジュールが用意されている。インストール済みの拡張モジュールを利用するには、以下のようにする。
#!/usr/bin/perl use POSIX; :
また、モジュール名の後にリストを指定すると 'import' するサブルーチンや定数を限定できる。
代表的な Unix コマンドに相当する Perl スクリプトを以下にあげる。
Perl では '-l' オプションで print 関数で自動的に改行がなされ、$, = で配列やリストのフィールドセパレータがスペースになる。
' '
#!/usr/bin/perl -l
$, = ' ';
print @ARGV;
このように、echo と同じ perl スクリプトファイルは以上のようになる。
Perl における終了コードは特に明示しない限り、正常終了である。
#!/usr/bin/perl
このように、true と同じ perl スクリプトファイルは以上のようになる。
Perl における終了コードは 'exit' 関数で指定できる。ちなみに、GNU Awk では可能だが、Awk では終了コードを制御できない。
#!/usr/bin/perl exit 1;
このように、false と同じ perl スクリプトファイルは以上のようになる。
#!/usr/bin/perl -l -s use POSIX qw(strftime); print strftime "%c", $u ? gmtime : localtime;
このように、date と同じ perl スクリプトファイルは以上のようになる。
#!/usr/bin/perl -l use File::Basename qw(dirname); die "usage: dirname path\n" if (!defined $ARGV[0]); print dirname $ARGV[0];
このように、dirname と同じ perl スクリプトファイルは以上のようになる。
#!/usr/bin/perl -l
use File::Basename qw(basename);
die "usage: basename string [suffix]\n basename [-a] [-s suffix] string [...]\n" if (!defined $ARGV[0]);
if (defined $ARGV[1]) {
print basename $ARGV[0], $ARGV[1];
}
else {
print basename $ARGV[0];
}
このように、basename と同じ perl スクリプトファイルは以上のようになる。
#!/usr/bin/perl -l $name = (getpwuid($<))[0]; print $name;
このように、logname と同じ perl スクリプトファイルは以上のようになる。
#!/usr/bin/perl -s
if (!defined $ARGV[0]) {
$id = $>;
@gids = split(' ', $));
shift @gids if ($G);
}
else {
if ($ARGV[0] !~ /^\d+$/) {
($name, $id) = (getpwnam($ARGV[0]))[0, 2];
exit 1 if (!defined $name);
}
else {
$id = $ARGV[0];
}
($name, $gid) = (getpwuid($id))[0, 3];
exit 1 if (!defined $name);
@gids = ($gid);
while (($gname, $gid, $members) = (getgrent())[0, 2, 3]) {
@members = grep { $_ == $id } map { (getpwnam($_))[2] } split(' ', $members);
push(@gids, $gid) if (@members);
}
}
if ($G) {
$, = ' ';
if (!$n) {
print @gids if (@gids);
}
else {
print map { (getgrgid($_))[0] } @gids if (@gids);
}
}
elsif ($g) {
if (!$n) {
print $gids[0];
}
else {
$gname = (getgrgid($gids[0]))[0];
exit 1 if (!defined $gname);
print $gname;
}
}
elsif ($u) {
if (!$n) {
print $id;
}
else {
$name = (getpwuid($id))[0];
exit 1 if (!defined $name);
print $name;
}
}
else {
($name, $gid) = (getpwuid($id))[0, 3];
exit 1 if (!defined $name);
$gname = (getgrgid($gid))[0];
exit 1 if (!defined $gname);
printf "uid=%u(%s) gid=%u(%s) ", $id, $name, $gid, $gname;
print "groups=";
for ($i=0; $i<@gids; $i++) {
if (!$gnames{$gids[$i]}) {
$gname = (getgrgid($gids[$i]))[0];
print "," if ($i != 0);
printf "%u(%s)", $gids[$i], $gname;
$gnames{$gids[$i]} = $gname;
}
}
}
print "\n";
このように、id と同じ perl スクリプトファイルは以上のようになる。
#!/usr/bin/perl -s
use Time::Local qw(timelocal);
if (defined $r) {
@stat = stat($r);
}
else {
$time = time;
if (defined $t) {
if ($t =~ /(?:((?:\d{2})?\d{2}))?(\d{2})(\d{2})(\d{2})(\d{2})(?:\.(\d{2}))?$/) {
my ($CCYY, $MM, $DD, $hh, $mm, $SS) = ($1, $2, $3, $4, $5, $6);
if (defined $CCYY) {
if ($CCYY <= 99) {
$CCYY += (69 <= $CCYY) ? 1900 : 2000
}
}
else {
$CCYY = (localtime($time))[5] + 1900
}
$SS = 0 if (!defined $SS);
$time = timelocal($SS, $mm, $hh, $DD, $MM-1, $CCYY);
}
}
}
if ($a && $m || !$a && !$m) {
$atime = $r ? $stat[8] : $time;
$mtime = $r ? $stat[9] : $time;
}
elsif ($a) {
$atime = $r ? $stat[8] : $time;
}
elsif ($m) {
$mtime = $r ? $stat[9] : $time;
}
for (@ARGV) {
if ($c) {
utime($atime, $mtime, $_)
}
else {
if (! -e "$_") {
open(F, ">", "$_") || die "create failure for $_: $!";
close(F)
}
utime($atime, $mtime, $_) || die "touch failure for $_: $!"
}
}
このように、touch と同じ perl スクリプトファイルは以上のようになる。
`du` コマンドを実現するには 'opendir', 'readdir', 'closedir' 及び 'stat', 'lstat' を使えれば十分だ。
#!/usr/bin/perl use POSIX qw(ceil); %units = ('K'=> 1024, # KibiBytes'M'=> 1024*1024, # MebiBytes'G'=> 1024*1024*1024, # GibiBytes ); $S = 1; while (@ARGV) { if ($ARGV[0] eq'--') { shift; last } elsif ($ARGV[0] eq'-H') { $H = !0 } elsif ($ARGV[0] eq'-L') { $L = !0 } elsif ($ARGV[0] eq'-a') { $a = !0 } elsif ($ARGV[0] eq'-s') { $s = !0 } elsif ($ARGV[0] eq'-d'&& 1 < @ARGV) { shift; $d = $ARGV[0] } elsif ($ARGV[0] eq'-k') { $S = 2 } elsif ($ARGV[0] eq'-m') { $S = 2*1024 } elsif ($ARGV[0] eq'-g') { $S = 2*1024*1024 } elsif ($ARGV[0] eq'-h') { $h = !0 } else { last } shift } sub resize { my($size) = @_; if (!defined $h) { ceil($size/$S) } else { my $p; if (!($size < $units{'G'}/512)) { $p ='G'} elsif (!($size < $units{'M'}/512)) { $p ='M'} else { $p ='K'} my $s = $size/($units{$p}/512); $p ='B'if ($s < 1); my $f = "%3.0f"; $f = "%3.1f" if (!($s < 1) && $s < 10); sprintf($f, $s) . $p } } @total_sizes = (0); sub do_one { my($one) = @_; my $size; if (-d $one && ($L || (!$L && ! -l $one))) { return if (!(-r $one && -x $one)); push(@total_sizes, 0); opendir(my $DH, $one) || warn "cannot opendir $one: $!"; while (readdir($DH)) { next if ($_ eq'..'); next if ($_ eq'.'); do_one("$one/$_"); } closedir($DH); $size = pop(@total_sizes); print resize($size), "\t", $one, "\n" if ((!$s || ($s && @total_sizes-1 == 0)) && (!defined $d || (defined $d && !($d < @total_sizes-1)))); } else { return if (!(my @stat=($L && -e $one ? stat($one) : lstat($one)))); $size = $stat[12]; print resize($size), "\t", $one, "\n" if ($a); } $total_sizes[$#total_sizes] += $size } while (@ARGV) { do_one($ARGV[0]); shift }
このように、du と同じ perl スクリプトファイルは以上のようになる。