Portál AbcLinuxu, 8. května 2024 12:47
sort { $a =~ tr[/][] <=> $b =~ tr[/][] || $a cmp $b; } @flisttohle je docela blizko, ale stejne to udela nakonec spatne .. zde najdete .. ps. abych Vam usetril praci, tak kodem nize vytvorite @foo ::
#!/usr/bin/env perl use warnings; use strict; use File::Find; sub build_flist { my($fpath); our(@flist); $fpath = shift; # chdir("$fpath"); @flist = ""; find(\&wanted, "$fpath"); sub wanted { my($found); $found = $File::Find::name; push(@flist, "$found"); }; # return sort { # $a =~ tr[/][] <=> $b =~ tr[/][] || $a cmp $b; # } @flist; return @flist; }; my $action = $ARGV[0]; print "$_\n" foreach(build_flist("$action")); exit;
$rootdir/$singlefiles .. -> $rootdir/$nextdir1/$singlefiles .. -> $rootdir/$nextdir2/$singlefiles ..btw. delam to proto, ze na ruznych operacnich systemech co pouzivam mi File::Find dela jinej defaultni order a ja ho potrebuju explicitne sesortovat ..
sort { $a =~ tr[/][\xff]; $b =~ tr[/][\xff]; $a cmp $b; }To za předpokladu, že nebudete mít unicode, v opačném případě si tam dejte nějaký jiný znak, který je dostatečně "vzadu". Pokud by se v názvech souborů objevil ten znak \xff, tak můžete použít místo substituce rotaci:
sort { $a =~ tr[/-\xff][0-\xff/]; $b =~ tr[/-\xff][0-\xff/]; $a cmp $b; }
root/file1 root/file2 root/dir1 root/dir1/file1 root/dir1/file1 root/dir1/sdir1 root/dir1/sdir1/file1 .. filex root/dir2 root/dir2/file1 .. filex root/dir2/sdir .. blah .. root/dirx/sdirx.*/filex
Já vidím problém v tom, jak poznat rozdíl mezi root/file1 a root/dir1. Pokud by třeba dir měla na konci vždy /, tak by při tom porovnávání se dalo udělat něco jako
sort{ if (($a ~= /\/$/ ) && !($b ~= /\/$/)) { return 1; } elseif ( !($a ~= /\/$/ ) && ($b ~= /\/$/)) {return -1;} else {return $a cmp $b; } }
Kód jsem netestoval (nemám ho teď kde pustit), takže to berte jenom jako námět.
#!/usr/bin/env perl use warnings; use strict; use File::Find; sub build_flist { my($fpath); our(@flist, @dlist, @overall); $fpath = shift; @flist = ""; @dlist = ""; @overall = ""; find(\&wanted, "$fpath"); ## vytvorime dve pole, jedno obsahuje jen adresare (@dlist) ## a druhe soubory (@flist) sub wanted { my $found = $File::Find::name; push(@dlist, $found) if(-d "$found"); push(@flist, $found) if(-f "$found"); }; # kvulli pop()ovani je reverzne sortneme @dlist = sort @dlist; @flist = sort {$b cmp $a} @flist; ## zacneme vytvaret finalni pole @overall, do ktereho se snazime ## spojit obe pole s adresari a soubory, ## `for(1 .. @dlist)` pouzivame misto `foreach(@dlist)` abychom se ## pop()em nezrali od ocasu .. zaroven si prelejvame jedno pole do ## druheho, misto abychom duplikovanim zabirali prilis pameti .. for(1 .. @dlist) { my $foo = pop(@dlist); push(@overall, "$foo") if($foo ne $overall[@overall - 1]); # a zde by mela prijit finalni finta: # vytvorime cyklus ktery >> dokud bude stejnej posledni pop()nutej # prvek do @overall ($foo) jako posledni prvek z pole se soubory # oriznutej o jmeno souboru takze zbyde adresar ($flist[@flist - 1] =~ s@/.[^/]+$@@) << # tak ten posledni prvek z @flist push()ne do @overall a pop()neme z @flist.. }; return @dlist; }; my $action = $ARGV[0]; print "$_\n" foreach(build_flist("$action")); exit;
#!/usr/bin/perl require 5.010_000; use strict; use warnings; use feature qw/switch say/; use autodie qw/opendir readdir/; # fetch arguments... my @dirs = sort @ARGV; @dirs = qw/./ unless scalar @dirs; my @output; # walk through directory queue... while (my $dir = shift @dirs) { # include this directory in output... push @output, $dir; # temporary array for directory objects # we use this to maintain the already sorted order... my @localdirs; # process all entries in this directory... opendir(my $dh, $dir); for my $obj (sort readdir($dh)) { # skip dot and dotdot... next if $obj ~~ [qw/. ../]; # figure out the full path and process it... given ("$dir/$obj") { # files go to output... when (-f) { push @output, $_ } # dirs go to temp. array... when (-d) { push @localdirs, $_ } } } # prepend found directories to the queue... unshift @dirs, @localdirs if scalar @localdirs; } say join("\n", @output);Žádné tajné triky :)
#!/usr/bin/env perl use warnings; use strict; use File::Find; our(@files, @dirs); my($input, @final, $foo, $bar); find(\&bingo, shift(@ARGV)); sub bingo { $_ = $File::Find::name; push(@files, $_) if -f; push(@dirs, $_) if -d; }; @files = sort(@files); @dirs = sort(@dirs); #### playground: while($input = shift(@ARGV)) { if($input eq 'd') { print "$_\n" foreach(@dirs); next; }; if($input eq 'f') { print "$_\n" foreach(@files); next; }; if($input eq 'a') { ## sorting is *very *very slow .. foreach(@dirs) { $foo = $_; push(@final, $foo); foreach(@files) { $bar = $_; $bar =~ s@/.[^/]*$@@; push(@final, $_) if($foo eq $bar); }; }; print "$_\n" foreach(@final); }; }; exit;
... or die
, místo smart match použijete grep
a místo given...when
použijete if...elsif
.
#!/usr/bin/perl use strict; use warnings; # fetch arguments... my @dirs = sort @ARGV; @dirs = qw/./ unless scalar @dirs; my @output; # walk through directory queue... while (my $dir = shift @dirs) { # include this directory in output... push @output, $dir; # temporary array for directory objects # we use this to maintain the already sorted order... my @localdirs; # process all entries in this directory... opendir(my $dh, $dir) or die "opendir $dir: $!\n"; my @entries = readdir($dh); die "readdir $dir: $!\n" unless scalar @entries; for my $obj (sort @entries) { # skip dot and dotdot... next if grep { $_ eq $obj } (qw/. ../); # figure out the full path and process it... my $fp = "$dir/$obj"; if (-f $fp) { # files go to output... push @output, $fp; } elsif (-d $fp) { # dirs go to temp. array... push @localdirs, $fp; } } # prepend found directories to the queue... unshift @dirs, @localdirs if scalar @localdirs; } print join("\n", @output), "\n";Opět dodávám, že jsem tento program na Vašem systému netestoval, takže si případné drobnosti dolaďte.
sort { (-d $a ? 0 : 1) <=> (-d $b ? 0 : 1) || split ('/', $a) <=> split ('/', $b) || $a cmp $b } @flist
my %dirs; sub wanted { %dirs{$File::Find::dir} = 1; ... };a miesto "-d $a" v sorte použiť "exists $dir{$a}" takisto môžete použiť:
my %dirs; sub wanted { push @{ $dirs{$File::Find::dir} }, $File::Find::name; }a btw, obyčajný
sort @list
nestačí?
my %files_in; for my $file (@files) { # Tady potřebujete mít soubory v aktuálním adresáři ve formátu "./soubor" # nebo to ještě nějak ošetřit pokud máte pouze "soubor" my ($dir_part) = ($file =~ m{^(.*)/.*?$}); push @{$files_in{$dir_part}}, $file; }(V podstatě to samé co dělal barney už při findování.) Pak byste tu strukturu vypsal (použil) nějak takto:
for my $dir (sort keys %dirs_to_files) { print $dir, "\n", join("\n", sort @{$files_in{$dir}}), "\n"; }(Opět nezkoušeno.)
sort keys %dirs_to_files
má být sort keys %files_in
.
sub build_flist { my ($fpath) = @_; my %dirs; find (sub { push @{ $dirs{$File::Find::dir} }, $File::Find::name; }, $fpath); @$_ = sort @$_ for values %dirs; my @head = @{ delete $dirs{$fpath} }; my @flist; while (my $d = shift @head) { push @flist, $d; unshift @head, @{ delete $dirs{$d} } if exists $dirs{$d}; } @flist } $\ = "\n"; print for build_flist ($ARGV[0])
sub build_flist { my ($fpath) = @_; my @r; find (sub { push @r, $File::Find::name; }, $fpath); return sort @r; }Čili jednak překombinované a jednak to nedělá to co to má dělat A přečtěte si někdy aspoň knihu perl best practices, za některé výtvory (
@$_ = sort @$_ for values %dirs
) bych střílel...
Tiskni Sdílej:
ISSN 1214-1267, (c) 1999-2007 Stickfish s.r.o.