package Base::Roots;
use strict;
use warnings;
use base 'Exporter';
our @EXPORT_OK = qw(root root_directory get_data data_directory print_styles email file_text);

use Cwd;
use File::Basename;
use List::Util qw(first);

my $file_name = basename($0);
my $full_path = getcwd;

my %hosts = (
  'C:/Documents and Settings/ME/My Documents/fantasy' => {
    link => q(http://localhost),
    user => q(ME),
    name => q(ME's Domain),
    mail => q(ME@localhost),
  },
  '/ftp/pub/www/fantasy' => {
    link => q(http://www.xecu.net/fantasy),
    user => q(Fantasy),
    name => q(Fantasy's Realm),
    mail => q(fantasy@xecu.net),
  },
  '/home/lady_aleena/var/www' => {
    link => q(http://lady_aleena.perlmonk.org),
    user => q(Lady Aleena),
    name => q(Lady Aleena's Home),
    mail => q(lady_aleena@perlmonk.org),
  },
);

sub root_directory {
  my @dir = grep { $_ if $full_path =~ /^$_/ } keys %hosts;
  return pop @dir;
}

my $rootdir = root_directory();
die qq($rootdir is not on the list.) unless exists $hosts{$rootdir};

for my $host (keys %hosts) {
  $hosts{$host}{data} = $rootdir.'/files/data';
  for my $key qw(audio css images) {
    $hosts{$host}{$key} = $hosts{$host}{link}.'/files/'.$key;
  }
}

#email just returns an e-mail link depending on the server it is on.
sub email {
  return qq(<a href="mailto:$hosts{$rootdir}{mail}">$hosts{$rootdir}{user}</a>);
}

sub root {
  my ($var) = @_;
  return $hosts{$rootdir}{$var};
}

sub data_directory {
  my ($dir) = @_;
  return root('data')."/$dir/";
}

my $rootlink = root('link');

my $relative_path = $full_path.'/'.$file_name;
   $relative_path =~ s!^$rootdir!!;
   $relative_path =~ s!.p[lm]$!!;

#get_data searches the data directories for or takes parameters to get a data file.
sub get_data {
  my ($directory,$filename) = @_;
  my $data = $directory && $filename ? root('data')."/$directory/$filename" : first {-e $_} map("$rootdir/files/data/$relative_path.$_",qw(csv txt));
  return $data;
}

#get_styles and print_styles searches the css directories for all of the style sheets that go with a file.
my @relative_path_split = split("/",$relative_path);
my @styles = (root('css').'/main.css');

sub get_styles {
  my ($style_dir) = @_;
  while (@relative_path_split) {
    my $var = shift @relative_path_split;
    if (-f ("$style_dir$var.css")) {
      push @styles, "$style_dir$var.css";
    }
    get_styles("$style_dir$var/");
  }
}
get_styles($rootdir.'/files/css');

sub print_styles {
  for my $style (@styles) {
    $style =~ s!$rootdir!$rootlink!;
    print qq{\t<link rel="stylesheet" type="text/css" href="$style">\n};
  }
}

#file_text makes the printed file name more attractive and in one case adds a little punctuation, more may be added later.
sub file_text {
  my ($text) = @_;
     $text =~ s!$rootlink/!!;
     $text =~ s!\.\w{2,5}?$!!;
     $text =~ s!&!&amp;!g;
     $text =~ s!_(Mr|Mrs|Ms|Dr)_!_$1._!g;
     $text =~ s!_! !g;
  return $text;
}

1;