# Attibute Definitions:

#

#  name: Text - name of file, dir, ...

#  ext: Text - file extension

#  no_ext: Text - name without ext

#  full: Text - full path name

#  abs: Text - absolute path name

#

#  M,age: Number - Age of file (in days)

#                   [since script started says man(perlfunc)??]

#  cre,create: Date (see age)

#  A,acc_in_days: Number - Last access time in days

#  acc,access: Date (see A)

#    set with utime()

#  f,is_file: Boolean

#  d,is_dir: Boolean

#  l,is_link: Boolean

#  p,is_pipe: Boolean

#  e,exists: Boolean

#  z,is_zero: Boolean - whether size equals zero bytes

#  r,readable: Boolean

#  w,writable: Boolean

#  x,executable: Boolean

#  o,owned: Boolean - whether it is owned (by effective uid)

#

#---------------------------------------------------------------------------

# Todo: 

# - implement abs(): absolute filepath

# - support links: use lstat(), @link 

# - flags: -R,-W,-X,-O (by real uid/gid instead of effective uid,

#          -S (is_socket), -b (block special file), -c (char. special file),

#          -t  Filehandle is opened to a tty.

#          -u  File has setuid bit set.

#          -g  File has setgid bit set.

#          -k  File has sticky bit set.

#          -T  File is a text file.

#          -B  File is a binary file (opposite of -T).

#          -C  inode change time in days.

#              set with utime() ??

#

# stat() fields:

#

#         0 dev      device number of filesystem

#         1 ino      inode number

#         2 mode     file mode  (type and permissions)

#	    add mode_str ??: "rwxr-xr--"

#         3 nlink    number of (hard) links to the file

#         4 uid      numeric user ID of file's owner

#           add uname

#         5 gid      numeric group ID of file's owner

#           add gname

#         6 rdev     the device identifier (special files only)

# x       7 size     total size of file, in bytes

# -       8 atime    last access time since the epoch

# -       9 mtime    last modify time since the epoch

# -      10 ctime    inode change time (NOT creation time!) since the epoch

#        11 blksize  preferred block size for file system I/O

#        12 blocks   actual number of blocks allocated

package XML::XQL::DirXQL;

use strict;

use XML::XQL;

use XML::XQL::Date;

sub dirxql

{

    my ($context, $list, $filepath) = @_;

    $filepath = XML::XQL::toList ($filepath->solve ($context, $list));

    my @result;

    for my $file (@$filepath)

    {

	push @result, XML::XQL::DirDoc->new (Root => $file->xql_toString)->root;

    }

    \@result;

}

XML::XQL::defineFunction ("dirxql", \&XML::XQL::DirXQL::dirxql, 1, 1);

package XML::XQL::DirNode;

# extended by: DirDoc, DirAttr, DirElem (File, Dir), FileContents

use vars qw{ @ISA $SEP };

@ISA = qw{ XML::XQL::Node };

# Directory path separator (default: Unix)

$SEP = "/";

if ((defined $^O and

     $^O =~ /MSWin32/i ||

     $^O =~ /Windows_95/i ||

     $^O =~ /Windows_NT/i) ||

    (defined $ENV{OS} and

     $ENV{OS} =~ /MSWin32/i ||

     $ENV{OS} =~ /Windows_95/i ||

     $ENV{OS} =~ /Windows_NT/i))

{

    $SEP = "\\";	# Win32

}

elsif  ((defined $^O and $^O =~ /MacOS/i) ||

	(defined $ENV{OS} and $ENV{OS} =~ /MacOS/i))

{

    $SEP = ":";		# Mac

}

sub isElementNode { 0 }

sub isTextNode    { 0 }

sub xql_parent    { $_[0]->{Parent} }

#sub xql_document { $_[0]->{Doc} }

sub xml_xqlString { $_[0]->toString }

sub xql

{

    my $self = shift;

    # Odd number of args, assume first is XQL expression without 'Expr' key

    unshift @_, 'Expr' if (@_ % 2 == 1);

    my $query = new XML::XQL::Query (@_);

    $query->solve ($self);

}

sub xql_sortKey

{

    my $key = $_[0]->{SortKey};

    return $key if defined $key;

    $key = XML::XQL::createSortKey ($_[0]->{Parent}->xql_sortKey, 

				    $_[0]->xql_childIndex, 1);

#print "xql_sortKey $_[0] ind=" . $_[0]->xql_childIndex . " key=$key str=" . XML::XQL::keyStr($key) . "\n";

    $_[0]->{SortKey} = $key;

}

sub xql_node

{

    my $self = shift;

    $self->build unless $self->{Built};

    $self->{C};

}

sub getChildIndex

{

    my ($self, $kid) = @_;

    my $i = 0;

    for (@{ $self->xql_node })

    {

	return $i if $kid == $_;

	$i++;

    }

    return -1;

}

sub xql_childIndex

{

    $_[0]->{Parent}->getChildIndex ($_[0]);

}

# As it appears in the XML document

sub xql_xmlString

{

    $_[0]->toString;

#?? impl.

}

sub create_date_from_days

{

    my ($days, $srcNode) = @_;

    my $secs = int (0.5 + $days * 24 * 3600 );

    my $internal = Date::Manip::DateCalc ("today", "- $secs seconds");

    new XML::XQL::Date (SourceNode => $srcNode,

			Internal => $internal,

			String => $internal );

}

#------ WHITESPACE STUFF (DELETE??)

# Find previous sibling that is not a text node with ignorable whitespace

sub xql_prevNonWS

{

    my $self = shift;

    my $parent = $self->{Parent};

    return unless $parent;

    for (my $i = $parent->getChildIndex ($self) - 1; $i >= 0; $i--)

    {

	my $node = $parent->getChildAtIndex ($i);

	return $node unless $node->xql_isIgnorableWS;	# skip whitespace

    }

    undef;

}

# True if it's a Text node with just whitespace and xml::space != "preserve"

sub xql_isIgnorableWS

{

    0;

}

# Whether the node should preserve whitespace

# It should if it has attribute xml:space="preserve"

sub xql_preserveSpace

{

    $_[0]->{Parent}->xql_preserveSpace;

}

#---------------------------------------------------------------------------

package XML::XQL::DirDoc;		# The Document

use vars qw{ @ISA };

@ISA = qw{ XML::XQL::DirNode };

sub new

{

    my ($type, %hash) = @_;

    my $self = bless \%hash, $type;

    $self->{Root} = "." unless exists $self->{Root};

    my $dirname;

    if ($self->{Root} =~ /^(.+)\Q${XML::XQL::DirNode::SEP}\E(.+)$/)

    {

	$self->{Prefix} = $1;

	$dirname = $2;

    }

    else

    {

	$self->{Prefix} = "";

	$dirname = $self->{Root};

    }

    $self->{Dir} = new XML::XQL::Dir (TagName => $dirname, Parent => $self);

    $self->{Built} = 1;

    return $self;

}

sub xql

{

    shift->root->xql (@_);

}

sub root           { $_[0]->{Dir} }

sub isElementNode  { 0 }

sub xql_nodeType   { 9 }

sub xql_childCount { 1 }

sub fullname       { $_[0]->{Prefix} }

sub xql_sortKey    { "" }

sub xql_parent     { undef }

sub xql_nodeName   { "#document" }

sub depth          { 0 }

sub xql_node       { [ $_[0]->{Dir} ] }

sub xql_element

{

    my ($self, $elem) = @_;

    my $dir = $self->{Dir};

    if (defined $elem)

    {

	return [ $dir ] if $dir->{TagName} eq $elem;

    }

    else

    {

	return [ $dir ];

    }

}

# By default the elements in a document don't preserve whitespace

sub xql_preserveSpace

{

    0;

}

sub toString

{

    $_[0]->root->toString;

}

#----------------------------------------------------------------------------

package XML::XQL::DirAttrDef;	# Definitions for DirAttr nodes

sub new

{

    my ($type, %hash) = @_;

    bless \%hash, $type;

}

sub dump

{

    print $_[0]->toString . "\n";

}

sub toString

{

    my $self = shift;

    print "DirAttrDef $self\n";

    my $i = 0;

    for my $attrName ($self->in_order)

    {

	my $a = $self->{$attrName};

	print "[$i] name=$attrName"; $i++;

	print " order=" . $a->{Order};

	print " get=" . $a->{Get} if defined $a->{Get};

	print " set=" . $a->{Set} if defined $a->{Set};

	if (defined $a->{Alias})

	{

	    print " alias=" . join (",", @{ $a->{Alias} });

	}

	print "\n";

    }

    if (defined $self->{'@ALIAS'})

    {

	print "Alias: ";

	my $alias = $self->{'@ALIAS'};

	print join (",", map { "$_=" . $alias->{$_} } keys %$alias);

	print "\n";

    }

}

sub clone

{

    my $self = shift;

    my $n = new XML::XQL::DirAttrDef;

    $n->{'@IN_ORDER'} = [ @{ $self->{'@IN_ORDER'} } ];

    for my $a (@{ $self->{'@IN_ORDER'} })

    {

	$n->{$a} = { %{ $self->{$a} } };

	$n->{$a}->{Alias} = [ @{ $self->{$a}->{Alias} } ]

	    if defined $self->{$a}->{Alias};

    }

    $n->{'@ALIAS'} = { %{ $self->{'@ALIAS'} } }

	    if defined $self->{'@ALIAS'};

    return $n;

}

sub in_order { defined $_[0]->{'@IN_ORDER'} ? @{ $_[0]->{'@IN_ORDER'} } : () }

sub alias    { $_[0]->{'@ALIAS'}->{$_[1]} }

sub order    { $_[0]->{$_[1]}->{Order} }

sub get      { $_[0]->{$_[1]}->{Get} }

sub set      { $_[0]->{$_[1]}->{Set} }

sub remove_attr

{

    my ($self, $name) = @_;

    next unless defined $self->{$name};

    my $order = $self->{$name}->{Order};

    my @in_order = $self->in_order;

    splice @in_order, $order, 1;

    # Reassign Order numbers

    for (my $i = 0; $i < @in_order; $i++)

    {

	$self->{$name}->{Order} = $i;

    }

    $self->{'@IN_ORDER'} = \@in_order;

    delete $self->{$name};

}

sub define_attr

{

    my ($self, %hash) = @_;

    my $name = $hash{Name};

    if (defined $self->{$name})

    {

	$hash{Order} = $self->{$name}->{Order} unless defined $hash{Order};

	$self->remove_attr ($name);

    }

    my @in_order = $self->in_order;

    $hash{Order} = -1

	if $hash{Order} >= @in_order;

    if ($hash{Order} == -1)

    {

	push @in_order, $name;

    }

    else

    {

	splice @in_order, $hash{Order}, 0, $name;

    }

    $self->{$name} = \%hash;

    # Reassign Order numbers

    for (my $i = 0; $i < @in_order; $i++)

    {

	$self->{$name}->{Order} = $i;

    }

    $self->{'@IN_ORDER'} = \@in_order;

    my @alias = defined $hash{Alias} ? @{ $hash{Alias} } : ();

    for (@alias)

    {

	$self->{'@ALIAS'}->{$_} = $name;

    }

}

#----------------------------------------------------------------------------

package XML::XQL::DirAttr;	# Attr node

use vars qw{ @ISA %GET_ATTR_FUNC %SET_ATTR_FUNC };

@ISA = qw{ XML::XQL::DirNode };

sub new

{

    my ($type, %hash) = @_;

    my $self = bless \%hash, $type;

    $self->{xql_value} = $self->{Parent}->{AttrDef}->get ($hash{Name});

    $self->{xql_setValue} = $self->{Parent}->{AttrDef}->set ($hash{Name});

    $self;

}

sub isElementNode  { 0 }

sub xql_nodeType   { 2 }

sub xql_nodeName   { $_[0]->{Name} }

sub xql_childIndex { $_[0]->{Parent}->attrIndex ($_[0]->{Name}) }

sub xql_childCount { 0 }

sub xql_node       { [] }

sub is_defined     { exists $_[0]->{Value} }

sub create	{ XML::XQL::DirNode::create_date_from_days ($_[0]->{Parent}->age, $_[0]) }

sub age		{ new XML::XQL::Number ($_[0]->{Parent}->age, $_[0]) }

sub size	{ new XML::XQL::Text ($_[0]->{Parent}->size, $_[0]) }

sub ext		{ new XML::XQL::Text ($_[0]->{Parent}->ext, $_[0]) }

sub no_ext	{ new XML::XQL::Text ($_[0]->{Parent}->no_ext, $_[0]) }

sub name	{ new XML::XQL::Text ($_[0]->{Parent}->name, $_[0]) }

sub full	{ new XML::XQL::Text ($_[0]->{Parent}->full, $_[0]) }

sub abs 	{ new XML::XQL::Text ($_[0]->{Parent}->abs, $_[0]) }

sub is_file	{ new XML::XQL::Boolean ($_[0]->{Parent}->is_file, $_[0]) }

sub is_dir	{ new XML::XQL::Boolean ($_[0]->{Parent}->is_dir, $_[0]) }

sub is_link	{ new XML::XQL::Boolean ($_[0]->{Parent}->is_link, $_[0]) }

sub is_pipe	{ new XML::XQL::Boolean ($_[0]->{Parent}->is_pipe, $_[0]) }

sub it_exists	{ new XML::XQL::Boolean ($_[0]->{Parent}->it_exists, $_[0]) }

sub is_zero	{ new XML::XQL::Boolean ($_[0]->{Parent}->is_zero, $_[0]) }

sub readable	{ new XML::XQL::Boolean ($_[0]->{Parent}->readable, $_[0]) }

sub writable	{ new XML::XQL::Boolean ($_[0]->{Parent}->writable, $_[0]) }

sub executable	{ new XML::XQL::Boolean ($_[0]->{Parent}->executable, $_[0]) }

sub owned	{ new XML::XQL::Boolean ($_[0]->{Parent}->owned, $_[0]) }

sub last_access_in_days

{

    new XML::XQL::Number ($_[0]->{Parent}->last_access_in_days, $_[0]);

}

sub last_access

{ 

  XML::XQL::DirNode::create_date_from_days ($_[0]->{Parent}->last_access_in_days, $_[0]);

}

sub toString       

{ 

    my $old = ""; #$_[0]->is_defined ? "" : " (undef)";

    my $val = $_[0]->xql_value->xql_toString; #exists $_[0]->{Value} ? $_[0]->{Value}->xql_toString : "(undef)";

    $_[0]->{Name} . "=\"$val$old\""

#?? encodeAttrValue

}

sub xql_value

{

    $_[0]->{Value} ||= &{ $_[0]->{xql_value} } (@_);

}

sub xql_setValue

{

    my ($self, $text) = @_;

    my $set = $_[0]->{xql_setValue};

    if (defined $set)

    {

	&$set ($self, $text);

    }

    else

    {

	warn "xql_setValue not defined for DirAttr name=" . $self->{TagName};

    }

}

sub set_name

{

    my ($attr, $text) = @_;

    $attr->{Parent}->set_name ($text);

}

sub set_ext

{

    my ($attr, $text) = @_;

    $attr->{Parent}->set_ext ($text);

}

sub set_no_ext

{

    my ($attr, $text) = @_;

    $attr->{Parent}->set_no_ext ($text);

}

#----------------------------------------------------------------------------

package XML::XQL::DirElem;	# File or Dir

use vars qw{ @ISA $ATTRDEF };

@ISA = qw( XML::XQL::DirNode );

$ATTRDEF = new XML::XQL::DirAttrDef;

$ATTRDEF->define_attr (Name => 'name', Get => \&XML::XQL::DirAttr::name, 

		       Set => \&XML::XQL::DirAttr::set_name);

$ATTRDEF->define_attr (Name => 'full', Get => \&XML::XQL::DirAttr::full);

$ATTRDEF->define_attr (Name => 'abs', Get => \&XML::XQL::DirAttr::abs);

$ATTRDEF->define_attr (Name => 'no_ext', Get => \&XML::XQL::DirAttr::no_ext, 

		       Set => \&XML::XQL::DirAttr::set_no_ext);

$ATTRDEF->define_attr (Name => 'ext', Get => \&XML::XQL::DirAttr::ext, 

		       Set => \&XML::XQL::DirAttr::set_ext);

$ATTRDEF->define_attr (Name => 'age', Get => \&XML::XQL::DirAttr::age, 

		       Alias => [ 'M' ] );

$ATTRDEF->define_attr (Name => 'create', Get => \&XML::XQL::DirAttr::create, 

		       Alias => [ 'cre' ] );

$ATTRDEF->define_attr (Name => 'A', Get => \&XML::XQL::DirAttr::last_access_in_days,

		       Alias => [ 'acc_in_days' ] );

$ATTRDEF->define_attr (Name => 'access', Get => \&XML::XQL::DirAttr::last_access, 

		       Alias => [ 'acc' ] );

# These should only be implemented for Link and Pipe resp. !!

$ATTRDEF->define_attr (Name => 'l', Get => \&XML::XQL::DirAttr::is_link, 

		       Alias => [ 'is_link' ] );