Forum Debian Users Gang

winnetou · 2015-02-21 12:06:14

Czołgiem gangsterka mam zagwozdkę i nie mogę jej ogarnąć. Mam skrypta w perlu który m.in buduje sobie tablicę z listą katalogów na koncie usera. Przy czym
- nazwa katalogu nie może zaczynać się od kropki (katalogi ukryte są ble i ich nie chcemy na liście)
- katalogi *stats i logs są dyskwalifikowane
- katalog może zawierać tylko litery, cyfry oraz znaki - i _
- nie może być symlinkiem.

Z połową założeń sobie poradziłem bez większego problemu:

Kod:

## lista wszystkich katalogów z podanej ścieżki nie będących katalogami ukrytymi, 
## nie zawierające spacji i nie nazywających się *stats czy też logs
my @dirs = File::Find::Rule->new
                      ->directory
                      ->not_name (qr/^\.|(aw)?stats|logs|\s/ )
                      ->in ( $sciezka );

## usuwanie symlinków zrobiłem sobie w następnej pętli:
foreach my $dir (@subdirs) {
  if (not -l $dir){
    ### rób coś tam coś tam.
  }
}

Jest tylko jeden problem na liście nadal znajdują się katalogi o nazwać np: "dup@" czy też "cos+cos"...

Próbowałem do File::Find::Rule dodać coś takiego:

Kod:

my @dirs = File::Find::Rule->new
                      ->any ( File::Find::Rule->new->not_name (qr/^\.|(aw)?stats|logs|\s/ ) , 
                                   File::Find::Rule->new->name( qr/[a-zA-Z0-9\_\-\\]+/) )
                      ->in ( $sciezka);

Ale to też nie bangla. Obstawiam że da się tego regexpa z not_name jakoś ogarnąć żeby spełniał wszystkie założenia ale kończą mi się pomysły.

Tak samo podobno da się od razu wkliczyć symlinki (wg [url=http://search.cpan.org/~rclamp/File-Find-Rule-0.33/lib/File/Find/Rule.pm]dokumentacji[/url] jest opcja -X test ale nie umiem jej użyć ^^)

Spece od perla/regexpów proszeni o pomoc ;)

Jacekalex · 2015-02-21 12:31:35

Bez regexa działa, listując wszystko?
Ja bym radził podzielić robotę na szuklanie, i wyrzucanie z wyniku tego, co nie pasi, jako odrębne zadania.
Może troszkę wiecej kodu, ale łatwiej zakodzić i szukać błędów.

winnetou · 2015-02-21 13:06:48

Kod:

my @dirs = File::Find::Rule->new
                      ->directory
                      ->in ( $sciezka );

Działa ładnie znajduje _wszystkie_ katalogi i podkatalogi w danej ścieżce.
wersja

Kod:

my @dirs = File::Find::Rule->new
                      ->directory
                      ->not_name (qr/^\.|(aw)?stats|logs|\s/ )
                      ->in ( $sciezka );

też działa i z wyszukiwania wywala katalogi ukryte oraz stats, awstats i logs.

Dopiero taki łamaniec"

Kod:

foreach my $dir (@dirs){
  if (not ($dir =~ s/[#%&\$*+()\@]//g)) {;
    print $dir."\n\n";
  }
}

Załapał... ale wydaje mi się to "niekoszerne" :) Może ktoś coś jeszcze?

Jacekalex · 2015-02-21 13:23:20

Koszerne być nie musi, grunt, że robi co ma robić. ;)

Jakbyś zajrzał w kod źródłowy dowolnego Windowsa, to byś sobie pejsy razem z uszami odgryzł z wrażenia. :D
A mimo to ponad 95% ludziów kocha ten system, u niejednej laski po 30-stce dzieci nie znajdziesz, chłopa nie znajdziesz, nawet kota nie znajdziesz, ale Windows jest zawsze. :D

Ostatnio edytowany przez Jacekalex (2015-02-21 14:51:51)

winnetou · 2015-02-21 14:27:01

Ha! wiedziałem, że da się koszernie!
Po raz kolejny potwierdziło się, że do perla nie można na trzeźwo ;) Dopiero gorący prysznic i kawa po irlandzku z podwójną dawką whisky dały pogląd na sytuację!
Koszerny File::Find::Rule wygląda następująco:

Kod:

my @userdirs = File::Find::Rule->new
                      ->directory
                      ->not_name (qr/^\.|(aw)?stats|logs|\s|[#%&\$*+()\@]/ )
                      ->not_symlink
                      ->in ( $sciezka );

Time (s)	Query
0.00010	SET CHARSET latin2
0.00005	SET NAMES latin2
0.00135	SELECT u., g., o.logged FROM punbb_users AS u INNER JOIN punbb_groups AS g ON u.group_id=g.g_id LEFT JOIN punbb_online AS o ON o.ident='13.58.137.218' WHERE u.id=1
0.00107	REPLACE INTO punbb_online (user_id, ident, logged) VALUES(1, '13.58.137.218', 1714674235)
0.00055	SELECT * FROM punbb_online WHERE logged<1714673935
0.00108	DELETE FROM punbb_online WHERE ident='185.191.171.12'
0.00099	DELETE FROM punbb_online WHERE ident='3.17.162.247'
0.00093	SELECT topic_id FROM punbb_posts WHERE id=283369
0.00089	SELECT id FROM punbb_posts WHERE topic_id=27064 ORDER BY posted
0.00118	SELECT t.subject, t.closed, t.num_replies, t.sticky, f.id AS forum_id, f.forum_name, f.moderators, fp.post_replies, 0 FROM punbb_topics AS t INNER JOIN punbb_forums AS f ON f.id=t.forum_id LEFT JOIN punbb_forum_perms AS fp ON (fp.forum_id=f.id AND fp.group_id=3) WHERE (fp.read_forum IS NULL OR fp.read_forum=1) AND t.id=27064 AND t.moved_to IS NULL
0.00006	SELECT search_for, replace_with FROM punbb_censoring
0.00088	SELECT u.email, u.title, u.url, u.location, u.use_avatar, u.signature, u.email_setting, u.num_posts, u.registered, u.admin_note, p.id, p.poster AS username, p.poster_id, p.poster_ip, p.poster_email, p.message, p.hide_smilies, p.posted, p.edited, p.edited_by, g.g_id, g.g_user_title, o.user_id AS is_online FROM punbb_posts AS p INNER JOIN punbb_users AS u ON u.id=p.poster_id INNER JOIN punbb_groups AS g ON g.g_id=u.group_id LEFT JOIN punbb_online AS o ON (o.user_id=u.id AND o.user_id!=1 AND o.idle=0) WHERE p.topic_id=27064 ORDER BY p.id LIMIT 0,25
0.00147	UPDATE punbb_topics SET num_views=num_views+1 WHERE id=27064
Total query time: 0.0106 s

Forum Debian Users Gang

Ogłoszenie

#1 2015-02-21 12:06:14

winnetou - złodziej wirków ]:->

[+] [perl] znajdowanie katalogów o określonej nazwie File::Find::Rule

Kod:

Kod:

#2 2015-02-21 12:31:35

Jacekalex - Podobno człowiek...;)

Re: [+] [perl] znajdowanie katalogów o określonej nazwie File::Find::Rule

#3 2015-02-21 13:06:48

winnetou - złodziej wirków ]:->

Re: [+] [perl] znajdowanie katalogów o określonej nazwie File::Find::Rule

Kod:

Kod:

Kod:

#4 2015-02-21 13:23:20

Jacekalex - Podobno człowiek...;)

Re: [+] [perl] znajdowanie katalogów o określonej nazwie File::Find::Rule

#5 2015-02-21 14:27:01

winnetou - złodziej wirków ]:->

Re: [+] [perl] znajdowanie katalogów o określonej nazwie File::Find::Rule

Kod:

Stopka forum

Informacje debugowania