2

PerlのFile::Findモジュールを使用して、ファイル、ディレクトリ、およびリンクをスキャンしています。とりわけ、私が書いているユーティリティが壊れた（File :: Findの用語でぶら下がっている）シンボリックリンクを報告することを望んでいます。理論的には、これは、壊れたリンクが見つかったときに呼び出されるサブルーチンを作成し、find次のような適切な値のハッシュ参照を使用してメソッドを呼び出すことによってサポートされます。

my %options = (
   wanted            => \&ProcessFile,
   follow            => 1,
   follow_skip       => 2,
   dangling_symlinks => \&Dangling
);

find(\%options, @ARGV);

これをテストするために意図的に壊れたリンクを作成したにもかかわらず、File::Findは決してサブルーチンを呼び出しませんDangling。この機能を除いて、他のすべてが機能します。つまり、ProcessFileサブが期待どおりに呼び出され、リンクがたどられます。

4

3 に答える 3

2

test.pl私のホームディレクトリに作成：

#!/usr/bin/perl

use File::Find;

my %options = ( wanted => \&ProcessFile,
                follow => 1,
                follow_skip => 2,
                dangling_symlinks => \&Dangling );

find(\%options, @ARGV);

sub ProcessFile {
  print "ProcessFile ($File::Find::name in $File::Find::dir)\n";
}

sub Dangling {
  my ($name, $dir) = @_;
  print "Dangling ($name in $dir)\n";
}

それで：

    $ chmod 755 test.pl

    $ mkdir / tmp / findtest
    $ cd / tmp / findtest
    $ ln -s / tmp / doesnotexist linkylink
    $〜/test.pl。

結果：

ProcessFile（。in。）
ぶら下がり（./のlinkylink）
ProcessFile（./linkylink in。）
于 2009-03-26T18:16:47.080 に答える
2

ぶら下がっているシンボリックリンクがどのような動作を示すかを簡単にテストしましたが、シンボリックリンクの定義は私が理解できる限りであることがわかりました

  1. -l は true を返します
  2. -e は undef # を返します。なぜなら、-e はリンクされたファイルに作用するからです

したがって、File::Find::Rule を使用してやろうとしていることは比較的単純です。

#!/usr/bin/perl 

use strict;
use warnings;
use File::Find::Rule ();

my @files = File::Find::Rule->symlink->exec(sub{ !-e $_ })->in('/tmp/test');

print "$_,\n" for @files;

このコード スニペットは、壊れたシンボリック リンクをすべて検出することができました。

私が実行したテストでこれを結論付けたい場合：

#!/usr/bin/perl 

use strict;
use warnings;
use File::Path ();
use Carp       ();

my $testdir = "/tmp/test";

# Generating test

# Making Dirs
dirmk($_)
  for (
    qw(
    /realdir/
    /deleteddir/
    )
  );

#"Touching" some files
generate($_)
  for (
    qw(
    /realfile
    /deletedfile
    /realdir/realfile
    /realdir/deletedfile
    /deleteddir/afile
    )
  );

# Symlink them
{
    lns( '/realfile',            '/realfile_symlink' );
    lns( '/deletedfile',         '/deletedfile_symlink' );
    lns( '/realdir',             '/realdir_symlink' );
    lns( '/deleteddir',          '/deleteddir_symlink' );
    lns( '/realdir/realfile',    '/realdir_realfile_symlink' );
    lns( '/realdir/deletedfile', '/realdir_deletedfile_symlink' );
    lns( '/deleteddir/afile',    '/deleteddir_file' );
}

# Make the deletions
del($_)
  for (
    qw(
    /deletedfile
    /deleteddir/afile
    /realdir/deletedfile
    /deleteddir/
    )
  );

statify($_)
  for (
    '', qw(
    /realfile
    /realfile_symlink
    /deletedfile_symlink
    /realdir
    /realdir_symlink
    /deleteddir_symlink
    /realdir/realfile
    /realdir_realfile_symlink
    /realdir_deletedfile_symlink
    /deleteddir_file
    )
  );

sub statify {
    my $fn = $testdir . shift;
    printf(
        "r: %3s e: %3s s: %3s f: %3s d: %3s l: %3s | %s \n",
        -r $fn || 0,
        -e $fn || 0,
        -s $fn || 0,
        -f $fn || 0,
        -d $fn || 0,
        -l $fn || 0,
        $fn
    );

}

sub generate {
    my $fn = $testdir . shift;
    open my $fh, '>', $fn or Carp::croak("Error Creating $fn $! $@");
    print $fh "This is $fn \n";
    close $fh or Carp::carp("Error on close for $fn $! $@");
    return;
}

sub lns {
    my $x = $testdir . shift;
    my $y = $testdir . shift;
    if ( -e $y ) {
        unlink $y;
    }
    symlink $x, $y or Carp::croak("Error ln $x => $y , $! $@");
}

sub del {
    my $fn = $testdir . shift;
    if ( -f $fn ) {
        unlink $fn;
    }
    if ( -d $fn ) {
        rmdir $fn;
    }
}

sub dirmk {
    my $fn = $testdir . shift;
    File::Path::mkpath($fn);
}

そして、ここに出力がありました：

r: 1 e: 1 s: 220 f: 0 d: 1 l: 0 | /tmp/テスト
r: 1 e: 1 s: 28 f: 1 d: 0 l: 0 | /tmp/test/実ファイル
r: 1 e: 1 s: 28 f: 1 d: 0 l: 1 | /tmp/test/realfile_symlink
r: 0 e: 0 s: 0 f: 0 d: 0 l: 1 | /tmp/test/deletedfile_symlink
r: 1 e: 1 s: 60 f: 0 d: 1 l: 0 | /tmp/test/realdir
r: 1 e: 1 s: 60 f: 0 d: 1 l: 1 | /tmp/test/realdir_symlink リンク
r: 0 e: 0 s: 0 f: 0 d: 0 l: 1 | /tmp/test/deleteddir_symlink
r: 1 e: 1 s: 36 f: 1 d: 0 l: 0 | /tmp/test/realdir/realfile
r: 1 e: 1 s: 36 f: 1 d: 0 l: 1 | /tmp/test/realdir_realfile_symlink
r: 0 e: 0 s: 0 f: 0 d: 0 l: 1 | /tmp/test/realdir_deletedfile_symlink
r: 0 e: 0 s: 0 f: 0 d: 0 l: 1 | /tmp/test/deleteddir_file
于 2009-03-26T20:07:43.707 に答える
1

私は使用中を見るのが好きですFile::Find::Ruleが、ここでは違いはありません。

そうは言っても、

$ mkdir test
$ cd test
$ ln -s a b
$ perl -w -MFile::Find -e'find({wanted=>sub{print"wanted $_\n"},dangling_symlinks=>sub{print"dangling $_[0] in $_\n"},follow=>1},".")'
wanted .
dangling b in .
wanted b

私のために働きます。

なにperl -MFile::Find -e'print"$File::Find::VERSION\n"'？

アップデート

PerlのRTを調べてみると、＃28929：File :: Find follow_fast=>1がぶら下がっているシンボリックリンクを失っています。これは明らかにFile::Find、Perl 5.8.7以前（および5.9.x開発ラインの5.9.1以前）にバンドルされている1.07以前に影響します。

システム管理者にPerlまたは少なくともいくつかのモジュールを更新するように説得することをお勧めします（そして、File::Find::Ruleそれらがそこにある間に追加します）が、それができない場合は、独自$PERL5LIBに作成して更新されたモジュールをそこに配置できます。

于 2009-03-26T18:22:02.790 に答える