my %movies = get_hash(
  file => data_file('Movies','movies.txt'),
  headings => [qw(title alt_title series franchise start_year end_year media format wikipedia allmovie imdb tvcom flixster genre theme based_on company)],
);

my %series = get_hash(
  file => data_file('Movies','series.txt'),
  headings => [qw(title wikipedia allmovie programs)],
);

my %gems = get_hash(
  file => data_file,
  headings => [qw(gem image_mineral image_gemstone gemstone_library gemstone_gbg tradeshop)],
);

##</code><code>##

package Base::Data;
use strict;
use warnings FATAL => qw( all );
use base 'Exporter';
our @EXPORT_OK = qw(data_file data_directory get_hash alpha_array alpha_hash);

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

use Base::Roots qw(get_root);

sub data_file {
  my ($directory,$filename) = @_;
  
  my $file_name = basename($0);

  my $root_path = get_root('path');
  my $root_data = get_root('data');
  
  my $relative_path = File::Spec->abs2rel($file_name,$root_path);
     $relative_path =~ s/\.\w+$//;

  my $data;
  if ($directory && $filename) {
    $data = "$root_data/$directory/$filename";
  }
  else {
    $data = first {-e $_} map("$root_data/$relative_path.$_",qw(csv txt));
  }
  if (!defined $data) {
    die "No file associated with $relative_path.";
  }
  return $data;
}

sub data_directory {
  my ($dir) = @_;
  $dir =~ s/ /_/g;
  return get_root('data')."/$dir/";
}

# Written with rindolf in #perlcafe on freenode; golfed with the help of [GrandFather] of PerlMonks.
# Changed to accept named parameters to make it prettier to use.
# The parameters are file, headings, and a very optional sort.
sub get_hash {
  my %opt = @_;
  open(my $fh, '<', $opt{file}) or die("can't open $opt{file} $!");
  my $line_number = 0;
  my %hash;
  while (my $line = <$fh>) {
    ++$line_number;
    chomp $line;
    my @values = split(/\|/,$line);
    my $n = 0;
    $hash{$values[0]}{sort_number} = $line_number if $opt{sort};
    for my $heading (@{$opt{headings}}) {
      $hash{$values[0]}{$heading} = defined($values[$n]) ? $values[$n] : '';
      ++$n;
    }
  }
  return %hash;
}

sub first_alpha {
  my $alpha = shift;
  $alpha = ucfirst($alpha) if $alpha =~ /^\l./;
  $alpha =~ s/\s*\b(A|a|An|an|The|the)(_|\s)//xi;
  if ($alpha =~ /^\d/) {
    $alpha = "#";
#    $alpha =~ s/^([\d\.,]+).*/$1/;
#    $alpha =~ s/(\d),(\d)/$1$2/;
  }
  else {
    $alpha =~ s/^(.)(\w|\W)+/$1/;
  }
  return $alpha;
}

sub alpha_array {
  my ($org_list) = @_;
  my %alpha_hash;
  for my $org_value (@{$org_list}) {
    my $alpha = first_alpha($org_value);
    push @{$alpha_hash{$alpha}}, $org_value;
  }
  return %alpha_hash;
}

sub alpha_hash {
  my ($org_list) = @_;
  my %alpha_hash;
  for my $org_value (keys %{$org_list}) {
    my $alpha = first_alpha($org_value);
    $alpha_hash{$alpha}{$org_value} = $org_list->{$org_value};
  }
  return %alpha_hash;
}

1;

##</code><code>##

package Base::Roots;
use strict;
use warnings FATAL => qw( all );
use base 'Exporter';
our @EXPORT = qw(get_root);

my $server = $ENV{SERVER_NAME} ? $ENV{SERVER_NAME} : 'localhost';

my %hosts = (
  'localhost' => {
    path => q(C:/Documents and Settings/<ME>/My Documents/fantasy),
    link => q(http://localhost),
    user => q(<ME>),
    name => q(<ME>'s Domain),
    mail => q(<ME>@localhost),
  },
  'www.xecu.net' => {
    path => q(/ftp/pub/www/fantasy),
    link => q(http://www.xecu.net/fantasy),
    user => q(Fantasy),
    name => q(Fantasy's Realm),
    mail => q(fantasy@xecu.net),
  },
  'fantasy.xecu.net' => {
    path => q(/www/fantasy/public_html),
    link => q(http://fantasy.xecu.net),
    user => q(Fantasy),
    name => q(Fantasy's Realm),
    mail => q(fantasy@xecu.net),
  }
);

my $root_path = $hosts{$server}{path};

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

sub get_root {
  my ($host_key) = @_;
  return $hosts{$server}{$host_key};
}

1;