#!/usr/bin/perl
use strict;
use warnings;
use diagnostics;

use Cwd;
use File::Find;
use File::Basename;

my $filename = basename($0);
my $dirname = getcwd;

my %directories = (
  '/ftp/pub/www/fantasy' => {
    link => 'http://www.xecu.net/fantasy',
    user => 'Fantasy',
    name => "Fantasy's Realm",
  },
  '/home/lady_aleena/var/www' => {
    link => 'http://lady_aleena.perlmonk.org',
    user => 'Lady Aleena',
    name => "Lady Aleena's Home",
  },
  'C:/Documents and Settings/<my name>/My Documents/fantasy' => {
    link => 'file:///C:/Documents and Settings/<my name>/My Documents/fantasy',
    user => '<my name>',
    name => "<my name>'s Place",
  },
);

sub get_rootdir {
  for my $dir (keys %directories) {
    return $dir if $dirname =~ /^\Q$dir/;
  }
}
my $rootdir = get_rootdir;
if (not exists $directories{$rootdir}) { die "You really screwed up." }
my $rootlink = $directories{$rootdir}{link};
my $rootuser = $directories{$rootdir}{user};
my $rootname = $directories{$rootdir}{name};

#@ARGV == 1 and -d $ARGV[0] or die "Usage: $0 path_name\n";
#( $rootdir = shift ) =~ s{(?<!/)$}{/};   # make sure path ends with "/"

my %tree;
$tree{$rootdir} = {};

find(\&wanted, $rootdir);

print_tree( \%tree, 0 );

sub wanted {
  local $_ = $File::Find::name;
  if ( -f ) {          # only work on data files (skip directories)
    s{\Q$rootdir\E}{}; # remove the rootdir string from the path name
    load_tree( $tree{$rootdir}, fileparse( $_ ));
  }
}

# recursively load the hash structure
# (first call gets top-level hashref, and file name, path from File::Basename::fileparse)

sub load_tree {
  my ( $href, $name, $path ) = @_;

  my @dirs = split /\//, $path;
  push @dirs, '.' if ( $dirs[$#dirs] ne '.' );

  my $key = shift @dirs;
  while ( @dirs and $key ne '.' and exists( $$href{"$key/"} )) {
    $href = $$href{"$key/"};
    $key = shift @dirs;
  }
  if ( $key ne '.' and ! exists( $$href{"$key/"} )) {
    $$href{"$key/"} = {};
    load_tree( $$href{"$key/"}, $name, join( '/', @dirs, '' ));
  }
  elsif ( $key eq '.' ) {
    push @{$$href{"$key/"}}, $name;
  }
}

# recursively print embedded lists

sub print_tree {
  my ( $href, $indent ) = @_;
  printf( "%s<ul>\n", '  ' x $indent );
  $indent++;
  if ( exists( $$href{'./'} )) {
    printf( "%s<li>%s</li>\n", '  ' x $indent, $_ )
      for ( @{$$href{'./'}} );
    delete $$href{'./'};
  }
  if ( keys %$href ) {
    for my $subdir ( sort keys %$href ) {
      printf( "%s<li>%s\n", '  ' x $indent,  $subdir);
      $indent++;
      print_tree( $$href{$subdir}, $indent );
      $indent--;
      printf( "%s</li>\n", '  ' x $indent );
    }
  }
  $indent--;
  printf( "%s</ul>\n", '  ' x $indent );
}