-sub __list_file
-{
- my $sock = shift;
- my $filename = shift;
-
- # Get the status information.
- my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
- $atime, $mtime, $ctime, $blksize, $blocks)
- = lstat $filename;
-
- # If the file has been removed since we created this
- # handle, then $dev will be undefined. Return immediately.
- return unless defined $dev;
-
- # Generate printable user/group.
- my $user = getpwuid ($uid) || "-";
- my $group = getgrgid ($gid) || "-";
-
- # Permissions from mode.
- my $perms = $mode & 0777;
-
- # Work out the mode using special "_" operator which causes Perl
- # to use the result of the previous stat call.
- $mode = (-f _ ? 'f' :
- (-d _ ? 'd' :
- (-l _ ? 'l' :
- (-p _ ? 'p' :
- (-S _ ? 's' :
- (-b _ ? 'b' :
- (-c _ ? 'c' : '?')))))));
-
- # Generate printable date (this logic is taken from GNU fileutils:
- # src/ls.c: print_long_format).
- my $time = time;
- my $fmt;
- if ($time > $mtime + 6 * 30 * 24 * 60 * 60 || $time < $mtime - 60 * 60) {
- $fmt = "%b %e %Y";
- } else {
- $fmt = "%b %e %H:%M";
- }
-
- my $fmt_time = strftime $fmt, localtime ($mtime);
-
- # Generate printable permissions.
- my $fmt_perms = join "",
- ($perms & 0400 ? 'r' : '-'),
- ($perms & 0200 ? 'w' : '-'),
- ($perms & 0100 ? 'x' : '-'),
- ($perms & 040 ? 'r' : '-'),
- ($perms & 020 ? 'w' : '-'),
- ($perms & 010 ? 'x' : '-'),
- ($perms & 04 ? 'r' : '-'),
- ($perms & 02 ? 'w' : '-'),
- ($perms & 01 ? 'x' : '-');
-
- # Printable file type.
- my $fmt_mode = $mode eq 'f' ? '-' : $mode;
-
- # If it's a symbolic link, display the link.
- my $link;
- if ($mode eq 'l') {
- $link = readlink $filename;
- die "readlink: $!" unless defined $link;
- }
- my $fmt_link = defined $link ? " -> $link" : "";
-
- # Display the file.
- my $line = sprintf
- ("%s%s%4d %-8s %-8s %8d %s %s%s\r\n",
- $fmt_mode,
- $fmt_perms,
- $nlink,
- $user,
- $group,
- $size,
- $fmt_time,
- $filename,
- $fmt_link);
- $sock->print ($line);
-}
-
-
-sub __get_file_list
-{
- my $dir = shift;
- my $wildcard = shift;
-
- opendir (DIRHANDLE, $dir)
- or die "Cannot open directory!!!";
-
- my @allfiles = readdir DIRHANDLE;
- my @filenames = ();
-
- if ($wildcard) {
- # Get rid of . and ..
- @allfiles = grep !/^\.{1,2}$/, @allfiles;
-
- # Convert wildcard to a regular expression.
- $wildcard = __wildcard_to_regex ($wildcard);
-
- @filenames = grep /$wildcard/, @allfiles;
- } else {
- @filenames = @allfiles;
- }
-
- closedir (DIRHANDLE);
-
- return sort @filenames;
-}
-
-
-sub __wildcard_to_regex
-{
- my $wildcard = shift;
-
- $wildcard =~ s,([^?*a-zA-Z0-9]),\\$1,g; # Escape punctuation.
- $wildcard =~ s,\*,.*,g; # Turn * into .*
- $wildcard =~ s,\?,.,g; # Turn ? into .
- $wildcard = "^$wildcard\$"; # Bracket it.
-
- return $wildcard;
-}
-
-