Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic
 
PerlMonks  

Ordered Directory Listing CGI

by hiseldl (Priest)
on Feb 19, 2003 at 20:42 UTC ( #236808=sourcecode: print w/replies, xml ) Need Help??
Category: CGI Programming
Author/Contact Info hiseldl
Description:

Creates an HTML Table with a direcotry listing with sorted sub-directories first, followed by sorted file names, and they are all linked to their respective directories and files.

Use the "cols=X" GET parameter to change the number of columns.

Update: added description of splice. 2003-02-20. Thanks Aristotle for the suggestion.

#! perl.exe 

use CGI qw/:standard/;
use strict;

my $columns = param('cols') || 4;
my $offset = 0;

opendir(DIR, ".") || die "cannot opendir: $!";
foreach (sort readdir(DIR)) {
    next if /^\.\.?$/ || /~$/;
    my $d = -d "$_";
    splice(@_, $d?$offset++:@_, 0, b($d?"[ ":"",a({-href=>"$_"},$_),$d
+?" ]":"","\n"));
}
closedir DIR;

print
    header(-expires=>'now'),
    start_html('Directory Listing'),
    h1('Directory Listing'),
    table({-border=>0,-cellpadding=>5,-cellspacing=>5},
      map { Tr($_) }
      map { td( [ splice(@_,0,$columns) ] ) }
      0 .. (@_ / $columns)
      ),
    end_html;

__END__

# Here's an explanation of how the splice works:
#
# Tell @_ to pretend to be two arrays, @dirs and @files
# and simulate a push command for both arrays.
# In the splice documentation 
# <http://www.perldoc.com/perl5.6/pod/func/splice.html>
# it shows sample code to simulate push:
#
#     splice(@a,@a,0,$x,$y)
#
# Since we want to put the @dirs at the front and the
# @files at the back, we first tried:
#
#     unshift @_, $dirname     # put the dirname first
#     push    @_, $filename;   # put the filename last
#
# that fails because now our directories are in reverse
# order.  In order to keep the ordering of the dir names,
# there has to be a way to push to the middle of the 
# list.  The solution here is to keep an offset into
# the middle of the list where the new $dirname should
# be inserted and increment the offset every time one
# is added.  For the case of a filename we revert to
# the example above for a simulated push, or make the
# offset point to the end of the list.
# 

splice(@_,                 # this is our list 
       $d?$offset++:@_,    # if we have a dir, return
                           #   the current offset and
                           #   increment, otherwise 
                           #   return length of list
       0,                  # number of elements to replace

       # an html-ized version of the dir/file name
       # putting "[" and "]" around dirnames
       b($d?"[ ":"",a({-href=>"$_"},$_),$d?" ]":"","\n")
       );
Replies are listed 'Best First'.
Re: Ordered Directory Listing CGI
by Aristotle (Chancellor) on Feb 19, 2003 at 23:20 UTC

    Extraordinarily cute. ++ for creative use of splice. However, it borders on the obfuscatory, and I'd personally take a straightforward approach with the entire thing.

    Note that if you want to throw out the current and parent directory entries you should generally use \A and \z instead of ^ and $ though (the latter will match in front of a terminating newline in the filename) or simply use good oldfashioned eq.

    #!/usr/bin/perl -w use strict; use CGI qw/:standard/; my $columns = param('cols') || 4; my $offset = 0; # untested my (@dir, @file); push @{ -d ? \@dir : \@file }, a({-href=>$_},$_) for do { opendir my($dh), "." or die "cannot opendir: $!"; sort grep $_ ne '.' && $_ ne '..' && !/~\z/, readdir $dh; }; $_ = "[ $_ ]" for @dir; for (\@file, \@dir) { my @result; push @result, td([map b($_), splice(@$_,0,$columns)]) while @$_; @$_ = @result; } print header(-expires=>'now'), start_html('Directory Listing'), h1('Directory Listing'), table( {-border=>0,-cellpadding=>5,-cellspacing=>5}, map Tr($_), @dir, @file; ), end_html; __END__

    Makeshifts last the longest.

Re: Ordered Directory Listing CGI
by hiseldl (Priest) on May 15, 2005 at 02:43 UTC
    I've revisited this script and made some enhancements and cleaned it up so it is less obfuscated. (-:
    #!/usr/bin/perl -w use strict; use CGI qw/:standard/; $|=1; my $columns = param('c') || 4; opendir(DIR, ".") || die "cannot open dir: $!"; foreach (sort readdir(DIR)) { next if /~\z/ || $_ eq "ls.cgi" || $_ eq "." || $_ eq ".."; push @{ (-d) ? $_[0] : $_[1] }, (-d) ? b(a({href=>"$_"},"[ $_ ]")) : a({href=>"$_"},"$_"); } closedir DIR; # Combine dirs and files $_[3] = [ @{$_[0]}, @{$_[1]} ]; print header, start_html('Directory Listing'), h3('Directory Listing'), b("Dir Count: ".@{$_[0]}), b(", File Count: ".@{$_[1]}), table({-border=>0,-cellpadding=>5,-cellspacing=>5}, map Tr($_), grep { length($_) > 0 } map td([ splice @{$_[3]},0,$columns ]), @{$_[3]} ), end_html; __END__

    Most notably I've taken another look at Aristotle's code and replaced the cute splice with array refs which turns out to be useful in the output section. E.g. I've added a directory count and a file count.

    The other noticable part is that I've removed the 0 .. (@_ / $columns) and inserted a grep to eliminate extra list elements that cause extra TR elements (the initial reason I put that in there in the first place).

    And, yes, I cleaned up the exclusion logic to use eq, etc.

    Enjoy!

    Update: Yes, the grep is a hack, for a full treatize on this issue click here.

    --
    hiseldl
    What time is it? It's Camel Time!

      (-d) ? b(a({href=>"$_"},"[ $_ ]")) : a({href=>"$_"},"$_");
      You're failing to escape the HTML for your directory and filenames. This can lead to weird things when people have filenames like <b>. Simply import escapeHTML, and add that in the appropriate places:
      (-d) ? b(a({href=>"$_"},escapeHTML("[ $_ ]"))) : a({href=>"$_"},escape +HTML($_));

      -- Randal L. Schwartz, Perl hacker
      Be sure to read my standard disclaimer if this is a reply.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://236808]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (9)
As of 2021-01-24 23:09 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Notices?