|
|
Tenhle díl se trochu nepovedl
|
20.9.2006 10:31
Hynek (Pichi) Vychodil
|
Na můj vkus je v příkladech trošku moc překlepů a hned v tom prvním
$ perl
use strict;
for (@ARGV){
next unless -e $arg;
}
Global symbol "$arg" requires explicit package name at - line 3.
Execution of - aborted due to compilation errors.
A stejná chyba se nám dílem vine jako pověstná červená nit. No a potom trocha elegance by taky neuškodila. Když mám zjišťovat typ souboru, tak jde použít naposledy zjišťovaný typ (ono to bude i rychlejší)
sub ziskej_typ_souboru {
my($soubor) = @_;
if (-d $soubor){return "d";} #adresář
elsif (-l _ ){return "l";} #symbolický odkaz
elsif (-f _ ){return "-";} #obyčejný soubor
elsif (-p _ ){return "p";} #roura
elsif (-b _ ){return "b";} #blokový
elsif (-c _ ){return "c";} #znakový
elsif (-S _ ){return "s";} #socket
else {return "?";} #neznamý
}
Dovedeno ad absurdum optimalizováno na rychlost
sub ziskej_typ_souboru ($) {
-d $_[0] && 'd' #adresář
|| -l _ && 'l' #symbolický odkaz
|| -f _ && '-' #obyčejný soubor
|| -p _ && 'p' #roura
|| -b _ && 'b' #blokový
|| -c _ && 'c' #znakový
|| -S _ && 's' #socket
|| '?' #neznamý
}Ale proč vlastně, když stat nám tuto informaci poskytne také? Stačí si jen přečíst nápovědu ke stat a máme to i znávodem. No a v neposlední řadě to zpracování práv, to už my málem vyrazilo dech. Co to jako má být to převádění na oktalové číslo? Slyšel někdy autor o binárních maskách. Vždyť to proboha už je v tom nejlepším možném tvaru se kterým se tak krásně a jednoduše pracuje.
#!/usr/bin/env perl
use strict;
use warnings;
use Fcntl ':mode';
use POSIX qw(strftime);
sub ziskej_typ_a_prava ($) {
local $_ = $_[0];
( S_ISDIR($_) && 'd' #adresář
|| S_ISLNK($_) && 'l' #symbolický odkaz
|| S_ISREG($_) && '-' #obyčejný soubor
|| S_ISFIFO($_) && 'p' #roura
|| S_ISBLK($_) && 'b' #blokový
|| S_ISCHR($_) && 'c' #znakový
|| S_ISSOCK($_) && 's' #socket
|| '?' #neznamý
)
.( $_ & S_IRUSR && 'r' || '-') #cteni vlastnik
.( $_ & S_IWUSR && 'w' || '-') #zapis vlastnik
.( $_ & S_ISUID #setuid
&& ($_ & S_IXUSR && 's' || 'S')
|| $_ & S_IXUSR && 'x' || '-' #exekuce vlastnik
)
.( $_ & S_IRGRP && 'r' || '-') #cteni skupina
.( $_ & S_IWGRP && 'w' || '-') #zapis skupina
.( $_ & S_ISGID #setgid
&& ($_ & S_IXGRP && 's' || 'S')
|| $_ & S_IXGRP && 'x' || '-' #exekuce skupina
)
.( $_ & S_IROTH && 'r' || '-') #cteni ostatni
.( $_ & S_IWOTH && 'w' || '-') #zapis ostatni
.( $_ & S_ISVTX #sticky
&& ($_ & S_IXOTH && 't' || 'T')
|| $_ & S_IXOTH && 'x' || '-' #exekuce ostatni
)
}
@ARGV = <*> unless @ARGV;
for (@ARGV) {
next unless -e;
my (
undef, undef, $mode, $odkazu, $uid, $gid,
undef, $velikost, undef, $mtime
) = stat;
printf "%10s %3s %7s %7s %10d %16s %s\n",
ziskej_typ_a_prava $mode,
$odkazu,
scalar getpwuid $uid,
scalar getgrgid $gid,
$velikost,
strftime("%Y-%m-%d %H:%M", localtime($mtime)),
$_;
}
P.S.: A proč mi ten engine žere prázdné řádky? |
|
|
|
|
Re: Tenhle díl se trochu nepovedl
|
21.9.2006 10:44
Hynek (Pichi) Vychodil
|
Méně knihoven, více práce s maskami a trošku rychlejší.#!/usr/bin/env perl
use strict;
use warnings;
sub get_by_mask ($@) {
my $mask = shift;
for my $type (@_) {
($_ & $mask) == $mask && return $type
} continue {
$mask <<= 1
}
() # vraceni niceho
}
sub ziskej_typ ($) {
local $_ = $_[0];
($_ & 0xa000) == 0xa000 && 'l' #link
|| get_by_mask(0x6000, qw(b s)) #blokove zarizeni nebo socket
|| get_by_mask(0x1000, qw(p c d -)) #normalni typy
|| '?' #neznamy
}
sub ziskej_prava ($) {
my $suidmask = 04000;
my $rightmask = 0400;
my $res = '';
for (qw(s s t)) {
for (qw(r w)) {
$res .= $_[0] & $rightmask && $_ || '-'; # cteni a zapis
} continue {
$rightmask >>= 1;
}
$res .= $_[0] & $suidmask # suid a sticky
&& ($_[0] & $rightmask && $_ || uc)
|| $_[0] & $rightmask && 'x' || '-'; # exekuce
$rightmask >>= 1; # dorovnani tretiho prubehu
} continue {
$suidmask >>= 1;
}
$res # vysledek
}
sub zjisti_cas ($) {
my (undef, $min, $hour, $mday, $mon, $year) = localtime($_[0]);
sprintf "%4d-%02d-%02d %02d:%02d",
$year + 1900,
$mon, $mday, $hour, $min
}
@ARGV = <*> unless @ARGV;
for (@ARGV) {
next unless -e;
my (
undef, undef, $mode, $odkazu, $uid, $gid,
undef, $velikost, undef, $mtime
) = stat;
printf "%1s%9s %3s %7s %7s %10d %16s %s\n",
ziskej_typ $mode,
ziskej_prava $mode,
$odkazu,
getpwuid($uid) || $uid,
getgrgid($gid) || $gid,
$velikost,
zjisti_cas $mtime,
$_;
} |
|
|
|
|
Re: Tenhle díl se trochu nepovedl
|
21.9.2006 11:07
Hynek (Pichi) Vychodil
|
Další pěkná a elegantní varianta#!/usr/bin/env perl
use strict;
use warnings;
sub ziskej_typ () {
-f && '-' #obyčejný soubor (radši nebudu spoléhat na -e u next unless)
|| -d _ && 'd' #adresář
|| -l && 'l' #symbolický odkaz (-l vyžaduje lstat)
|| -p _ && 'p' #roura
|| -b _ && 'b' #blokový
|| -c _ && 'c' #znakový
|| -S _ && 's' #socket
|| '?' #neznamý
}
sub ziskej_prava ($) {
my $suidmask = 04000;
my $rightmask = 0400;
my $res = '';
for (qw(s s t)) {
for (qw(r w)) {
$res .= $_[0] & $rightmask && $_ || '-'; # cteni a zapis
} continue {
$rightmask >>= 1;
}
$res .= $_[0] & $suidmask # suid a sticky
&& ($_[0] & $rightmask && $_ || uc)
|| $_[0] & $rightmask && 'x' || '-'; # exekuce
$rightmask >>= 1; # dorovnani tretiho prubehu
} continue {
$suidmask >>= 1;
}
$res # vysledek
}
sub zjisti_cas ($) {
my (undef, $min, $hour, $mday, $mon, $year) = localtime($_[0]);
sprintf "%4d-%02d-%02d %02d:%02d",
$year + 1900,
$mon, $mday, $hour, $min
}
@ARGV = <*> unless @ARGV;
for (@ARGV) {
next unless -e;
my (
undef, undef, $mode, $odkazu, $uid, $gid,
undef, $velikost, undef, $mtime
) = stat;
printf "%1s%9s %3s %7s %7s %10d %16s %s\n",
ziskej_typ,
ziskej_prava $mode,
$odkazu,
getpwuid($uid) || $uid,
getgrgid($gid) || $gid,
$velikost,
zjisti_cas $mtime,
$_;
} |
|
|
|
|
|
|
KOMENTARZE
|
|
Tylko zarejestrowani użytkownicy mogą dopisywać komentarze.
|
|
Szukanie oprogramowania
|
bootable [55]
linuxsoft.cz | Design:
www.megadesign.cz