=head1 NAME

CFX5::DefFile::ProfileInterface - interface to profile storage in def files

=head1 SYNOPSIS

  use CFX5::DefFile::ProfileInterface;

  my $prof=CFX5::DefFile::ProfileInterface->new($deffile);
  $prof->insert_file('file.csv');

  my @files=$prof->file_list();
  for my $f (@files) {
    set_file_contents($f, $prof->get_file($f));
  }

=head1 DESCRIPTION

Routines for handling access to profile data stored in a CFX-5
definition (or results) file.

=cut

package CFX5::DefFile::ProfileInterface;

use strict;

use CFX5::Output qw(:all);
use CFX5::PathManip qw(basename dirname normalize_filename);

=head2 CONSTRUCTOR

=head3 new

  my $prof=CFX5::DefFile::ProfileInterface->new($deffile);

Constructs a new object.  The argument should be a CFX5::DefFile
object, from where the data will be taken.

=cut

sub new {
  my $this=shift;
  my $class=ref($this) || $this;
  my $self={};
  bless $self, $class;
  $self->{deffile}=shift;
  $self;
}

=head2 DATA ACCESS

=head3 def

Returns the CFX5::DefFile object

=cut

sub def { $_[0]->{deffile}; }

=head2 READING AND WRITING

=head3 delete_all

Deletes all existing profile data in the file.  Used by the solver
script before inserting new data.

=cut

sub delete_all {
  my $self=shift;
  return $self->def()->delete_dataset(what => 'G/PROF/*');
}

=head3 file_list

  my %files=$prof->file_list();

Retrieves a hash of all profile data files stored in the file.  The
key is the (user-visible) filename, and the value is some internal
data which you won't need to worry about! C<;-)>.

The list is rebuilt every time the call is made -- as the object
doesn't know whether the file is changing under it -- so if you know
it's not being changed, cache the result yourself.

=cut

sub file_list {
  my $self=shift;
  my $def=$self->def();

  # we should only ever have them at WHEN=0 -- if we just wrote them
  # into the def file -- or WHEN=n, if it's a res file.  Since the
  # user can't write them explicitly, we shouldn't ever get both.
  my @datasets=$def->have_dataset(what => 'G/PROF/*', 
                                  where => 'EVERY',
                                  when => '*');
  unless (@datasets) {
    return ();
  }

  # we have something, but all we know so far is the dataset names.
  # What we need is the file names to which they correspond.
  my %files;
  for my $dsloc (@datasets) {
    my $ds=$def->read_header(what => $dsloc->[0],
                             where => $dsloc->[1],
                             when => $dsloc->[2]);
    if (defined $ds) {
      # the file name should be in the FILENAME attribute
      my $fname=$ds->attribute('FILENAME');
      unless (defined $fname) {
        _error("Bad profile dataset", join(':', @$dsloc) . ": missing FILENAME attribute");
      } else {
        if ($files{$fname}) {
          _error("Duplicate datasets for profile file", $fname);
        } else {
          $files{$fname}=$dsloc;
        }
      }
    } else {
      _error("Error reading header for profile dataset", join(':', @$dsloc));
    }
  }

  %files;
}

sub insert_file {
  my $self=shift;
  my $file=shift;

  my $def=$self->def();

  my $ftrunc=basename($file);
  # we actually have slightly more than 64 chars to play with, but 64
  # is a good limit.
  if (length($ftrunc) > 64) {
    $ftrunc=substr($ftrunc, 0, 64);
  }

  # find a spare internal name for the file.  We enforce that names
  # are unique in a case-independent set -- mostly because it's just
  # clearer -- so we need to remap the file names in the hash to all
  # have the same case before we start.
  my %current=$self->file_list();
  for my $k (keys %current) {
    $current{lc($k)} = $current{$k};
  }

  my $internal_filename=do {
    my $c='';
    while (exists $current{lc($ftrunc.$c)}) {
      ++$c;
    }
    $ftrunc.$c;
  };

  # find a datatset name.  These are arbitary here, so I'll just
  # number them.
  my $dsname=do {
    my $c=0;
    while ($def->have_dataset(what => "G/PROF/$c")) {
      ++$c;
    }
    "G/PROF/$c";
  };

  _debug("Storing profile file $file as $internal_filename in dataset $dsname");

  # right, that's it now, stick it in and we're done.
  # store_text_dataset will signal its own errors, so we just need to
  # return its return value.
  $def->store_text_dataset($file,
                           what => $dsname, where => 'EVERY', when => 0,
                           FILENAME => $internal_filename);
}

sub extract_file {
  my $self=shift;
  my $internal_file=shift;
  my $output_file=shift;

  my %files=$self->file_list();

  # we treat these case-insensitively, so again, we re-map the file
  # list to all-lowercase.
  for my $k (keys %files) {
    $files{lc($k)} = $files{$k};
  }

  unless (exists $files{lc($internal_file)}) {
    _error("The profile file $internal_file is not stored in this file");
    return '';
  }

  # the value in the files hash is the what/where/when information for
  # the dataset, so we can now just read it.
  my @www=@{$files{lc($internal_file)}};
  # take the shortcut in CFX5::DefFile and send it straight to the
  # file.  If $output_file is '-' this will send it to stdout.
  $self->def()->extract_text_dataset($output_file,
                                     what => $www[0],
                                     where => $www[1],
                                     when => $www[2]);
}

1;
