#!/usr/bin/perl #demonstrates the usage of the HList widget. use strict; use CGI qw(:standard); use CGI::Widget::HList; use CGI::Widget::HList::Node; my $ROOT = '/home/allenday/public_html/dbrowse'; my %o = map {$_=>1} param("o"); my %c = map {$_=>1} param("c"); #lets make the tree my $root = CGI::Widget::HList::Node->new(); $root->name("curio/"); $root->link(\&alink); $root->close unless $o{$root->name}; descend($root,$ROOT); print header(); print start_html; my $hlist = CGI::Widget::HList->new(-root=>$root, -render_node=>\&nlink, ); print $hlist->html; print end_html; #recurse through directories sub descend { my($parent,$base) = @_; my @content = get_content($base); foreach my $c (@content){ my $daughter = CGI::Widget::HList::Node->new; $parent->add_daughter($daughter); $daughter->name("$base/$c"); $daughter->link(\&alink); next if -f "$base/$c"; $daughter->close unless $o{$c}; $daughter->pregnant(1) unless $o{$c}; descend($daughter,"$base/$c") if $o{$c}; } } sub nlink { my $node = shift; my $name = $node->name; $name =~ s!.+/(.+)!$1!; my %to = %o; my %tc = %c; my $img = $node->pregnant ? $hlist->img_close : $node->state ? $node->daughters ? $hlist->img_open : $hlist->img_leaf : $node->daughters ? $hlist->img_close : $hlist->img_leaf ; $to{$name} ? delete $to{$name} && $tc{$name}++ : $to{$name}++ ; my $o = keys %to ? ";o=".join ";o=",keys %to : '' ; my $c = keys %tc ? ";c=".join ";c=",keys %tc : '' ; my $return = a({-name=>$name}); $return .= ($node->daughters || $node->pregnant) ? a({-href=>script_name."?".$o.$c."#".$name},$img) : $img; return $return; } sub alink { my $node = shift; my $name = $node->name; $name =~ s!.+/(.+)!$1!; return font({-size=>"-1"}, "$name ".(sprintf "%8.2f",((stat $node->name)[7])/1048576)."MB") if -f $node->name; return font({-size=>"-1"},$name); } sub get_content { my $path = shift; my @return = (); opendir(D,$path); foreach my $d (readdir(D)){ next if $d =~ /^[\.]+$/; push @return, $d ; } closedir(D); return sort @return; }