meer perlerig, ofwel korter, sneller, minder leesbaar ;)

This commit is contained in:
Ward Wouts 2001-07-31 13:20:35 +00:00
parent 99453e294c
commit 00e82e9bb6

View file

@ -13,18 +13,13 @@ use IO::File;
use File::Copy;
use POSIX qw(tmpnam);
$DEBUG = 0;
#Read current dir
opendir(DIRHANDLE, ".") or die "couldn't open .: $!";
while ( defined ($filename = readdir(DIRHANDLE)) ) {
if ($DEBUG) { print "Inside . is something called $filename\n"; }
push @dir, "$filename\n";
}
closedir(DIRHANDLE);
@source = sort @dir;
if ($DEBUG) { print @source; }
# make tempfiles and install handler to remove them
do { $target_name = tmpnam() }
@ -42,8 +37,6 @@ open $target, $target_name or die "Couldn't open tempfile: $target_name: $!";
@target = <$target>;
close ($target);
if ($DEBUG) { print @target; }
unless ( scalar(@source) == scalar(@target) ) {
die "Aborting. Source and target list don't have the same number of lines.\n";
}
@ -62,10 +55,9 @@ if (@unsafe = &check_safety(\@source, \@target)) {
&move_files(\@source, \@target);
# call EDITOR or vi with filename
# edit($filename);
sub edit {
my $filename = shift;
$editor = defined $ENV{EDITOR} ? $ENV{EDITOR} : "vi";
@editor = ("$editor", "$filename");
@editor = (defined $ENV{EDITOR} ? $ENV{EDITOR} : "vi", shift);
system(@editor) == 0
or die "System @editor failed: $?";
}
@ -75,33 +67,26 @@ sub edit {
# move_files(\@source, \@target)
sub move_files {
my ($from, $to) = @_;
my($i, $source, $target);
$i=0;
while ( $i < scalar(@$from) ) {
my ($i, $source, $target);
for ( $i=0; $i < scalar(@$from); $i++ ) {
$source=$from->[$i];
chomp($source);
$target=$to->[$i];
chomp($target);
unless ( $source eq $target ) {
if ($DEBUG) { print "mv $source $target\n"; }
chomp($source);
chomp($target);
move("$source", "$target")
or die "move failed: $!";
}
$i++;
}
return 1;
}
# returns 0 if all entries in @target_list are unique. 1 if not.
sub check_unique (@target_list){
my(@target_list, %seen, @uniqu);
@target_list = @_;
%seen = ();
my @uniqu;
my @target_list = @_;
my %seen = ();
@uniqu = grep { ! $seen{$_} ++ } @target_list;
unless (scalar(@uniqu) == scalar(@target) ) {
return 1;
}
return 0;
return (scalar(@uniqu) != scalar(@target))
}
# compares one array of file names to another, making sure files
@ -111,35 +96,22 @@ sub check_unique (@target_list){
# returns an array of unsafe line numbers
sub check_safety {
my ($from, $to) = @_;
my($i, $j, $source, $target, @danger);
$i=0;
while ( $i < scalar(@$from) ) {
$source=$from->[$i];
chomp($source);
$j=0;
while ( $j < scalar(@$to) ) {
$target=$to->[$j];
chomp($target);
if (($source eq $target) && ($i != $j)) {
my ($i, $j, @danger);
for ( $i=0 ; $i < scalar(@$from) ; $i++ ) {
for ( $j=0; $j < scalar(@$to); $j++ ) {
if (($from->[$i] eq $to->[$j]) && ($i != $j)) {
push @danger, $i;
}
$j++;
}
$i++;
}
return @danger;
}
# generate random filename, which does not exist
sub rand_file {
my (@chars, $filename, $exists);
@chars=( "A" .. "Z", "a" .. "z", 0 .. 9);
$exists = 1;
while ($exists) {
$filename = join("", @chars[ map { rand @chars } ( 1 .. 8 ) ]);
$exists = -e $filename;
}
my $filename;
my @chars=( "A" .. "Z", "a" .. "z", 0 .. 9);
while ( -e ($filename = join("", @chars[ map { rand @chars } ( 1 .. 8 ) ]))) {}
return $filename;
}