ARCHIV

$ 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.

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ý
} 

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ý
}

#!/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)),
        $_;
}

#!/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,
        $_;
}

#!/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,
        $_;
}