package TKL::File;

## $Id: File.pm,v 1.4 2004/05/25 08:43:43 sondberg Exp $

use Data::Dumper;
use TKL;
use XML::LibXSLT;
use Time::Local;
use strict;
use vars qw(@ISA);

@ISA = qw(TKL);


sub filename {  ## absolute path to the file
    return shift->{file};
}


sub portal_filename {
    my $self = shift;
    my $abs = $self->filename;
    my $root = $self->find_portal_root;
    
    $root =~ s/\//\\\//g;	## Replace / by \/
    $abs =~ s/^$root//;		## Remove the root part of the filename
    return $abs;
}

sub file_exists {
    my $self = shift;
    return ( -f $self->filename);
}

sub file_writable {
    my $self = shift;
    return ( -w $self->filename);
}


sub is_symlink {
    my $self = shift;
    return ( -l $self->filename);
}

   
sub get_timestamp {
## Returns timestamp for the record, currently you can extract
## timestamps for modified and created fields.

    my ($self, $which) = @_;
    my $doc_elem = $self->document_element;
    my $timestamp = $doc_elem->getAttribute($which); 

    if (defined($timestamp)) {
	my ($year, $month, $day) = ($timestamp =~ /^(\d+)[\-\/](\d+)[\-\/](\d+)/g);
	my ($hour, $min, $sec) = ($timestamp =~ /\G, (\d+):(\d+):(\d+)/);

	if ( !defined( $year )	||
	     !defined( $month ) ||
	     !defined( $day ) ) {

	    return undef;
	}

	if ( !defined( $hour )	||
	     !defined( $min )	||
	     !defined( $sec ) ) {

	    $hour = $min = $sec = 0;
	}
	
	return timelocal($sec, $min, $hour, $day, $month - 1, $year);
    } else {
	return undef;
    }
}
    


sub render {
    my ($self) = @_;
    my $doc_elem = $self->document_element;
    my $parser = $self->dom;
    my $xslt = new XML::LibXSLT;
    my $doc_elem_name = $doc_elem->nodeName();
    my $file = $self->filename;

    $file =~ s/[^\/]*$//;
    $file .= "$doc_elem_name.xsl";

    my $template = $self->locate_file($file);
    if (defined($template)) {
	my $style_doc = $parser->parse_file($template);
	my $stylesheet = $xslt->parse_stylesheet($style_doc);
	my $result = $stylesheet->transform($doc_elem->ownerDocument);
	return $stylesheet->output_string($result);
    } else {
	return $doc_elem->toString;
    }
}
    

sub get_base {
    my $self = shift;
    my $file = $self->filename;
    my @path = split(/\//, $file);
    
    return pop @path;
}


sub extract_schema {
    my $self = shift;
    my $file = $self->filename;

    my $root = $self->document_element($file);
    my $element_name = $root->nodeName();

    return "$element_name.$TKL::schema_suffix";
}



sub document_element {
    my $self = shift;

    unless (ref($self->{document_element}) eq "XML::LibXML::Node") {
	my $doc_elem = $self->SUPER::document_element($self->filename);
	$self->{document_element} = $doc_elem;
    }

    return $self->{document_element};
}


sub parse {
    my $self = shift;

    return $self->SUPER::parse($self->filename);
}

# Writes new content to the file
sub storefile {
    my $self = shift;
    my $dom = shift;
    # TODO: Should we update the modified attribute
    #       or is that for human modifications only?
    my $fn=$self->{file};
    my $xml= $dom->toString();
    open F, ">".$fn or croak("Could not open $fn for writing");
    print F $TKL::xml_header, "\n";
    print F $xml,"\n";
    close(F);

}

1;

__END__

=head1 NAME

TKL::File - Perl package implementing simple methods for accessing a TKL file.

=head1 SYNOPSIS

  use TKL::File;

  my $tkl = new TKL::File(filename => 'myfile.tkl');

=head1 DESCRIPTION

This is a package with various tools for manipulating, reading, writing and
parsing TKL files. 

=head2 Methods

Below is a list of the specialized file manipulation methods, besides those
you, of course have access to all the methods in the TKL base class.

=head3 filename

Get the name of the file, which this object is accessing:

  my $filename = $tkl->filename;

=head3 portal_filename

Get the filename of the file, which this object is accessing. Return the
path relative to the TKL portal root:

  my $relative_filename = $tkl->portal_filename;

=head3 file_exists, file_writable, is_symlink

Check various file attributes, i.e. for instance

  if ($tkl->file_exists) {
      ## The file exists
  }

=head3 get_timestamp

Return the file timestamps as specified in the document element attributes
created="xxxxx" and modified="yyyyy":

  my $created = $tkl->get_timestamp("created");
  my $modified = $tkl->get_timestamp("modified");

The Unix epoch time stamp is returned. If no time stamp information is found
of the requested type, undef is returned.

=head3 render

The fundamental notion of TKL is that we need an XSL transforming stylesheet
to present a TKL document. The association between TKL instance documents and
their transforming stylesheets goes through the document type. If the document
type is, for instance "link", a stylesheet link.xsl should be used to present
the record. The stylesheet "closest" to the TKL document is used. To be precice,
the method TKL::locate_file is used to find the stylesheet. When an
appropriate stylesheet is found, it is applied and the resulting document is
returned.

Since the mapping from TKL file to stylesheet is taken care of implicitly, this
rending method can be called simply by:

  my $result = $tkl->render;

=head3 get_base

Get the base name of the TKL file:

  my $base = $tkl->get_base;

=head3 extract_schema

Get the document type, a.k.a. the XML schame name for the TKL file in question:

  my $xsd = $tkl->extract_schema;

=head3 document_element

Return the DOM style document element node:

  my $doc_elem = $tkl->document_element;

The returned object $doc_elem is of the type XML::LibXML::Node.

=head3 parse

Parse the TKL file and return a nested-hash representation of the
DOM tree, see man page for TKL::parse. Call the method this way:

  my $href = $tkl->parse;

=head3 storefile

Converts the TKL file object instance into text and store it as the
filename in question.

=head1 AUTHOR

Anders Sønderberg Mortensen <sondberg@indexdata.dk>
Indexdata
2004/01/06

=head1 SEE-ALSO

Manual pages for the collection of DOM classes XML::LibXML::* and for the
packages TKL::*.

=cut