lib/XML/XQL/DirXQL.pm - metacpan.org

# 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' ] );
$ATTRDEF->define_attr (Name => 'p', Get => \&XML::XQL::DirAttr::is_pipe, 
		       Alias => [ 'is_pipe' ] );

$ATTRDEF->define_attr (Name => 'e', Get => \&XML::XQL::DirAttr::it_exists, 
		       Alias => [ 'exists' ] );
$ATTRDEF->define_attr (Name => 'z', Get => \&XML::XQL::DirAttr::is_zero, 
		       Alias => [ 'is_zero' ] );
$ATTRDEF->define_attr (Name => 'r', Get => \&XML::XQL::DirAttr::readable, 
		       Alias => [ 'readable' ] );
$ATTRDEF->define_attr (Name => 'w', Get => \&XML::XQL::DirAttr::writable, 
		       Alias => [ 'writable' ] );
$ATTRDEF->define_attr (Name => 'x', Get => \&XML::XQL::DirAttr::executable, 
		       Alias => [ 'is_zero' ] );
$ATTRDEF->define_attr (Name => 'o', Get => \&XML::XQL::DirAttr::owned, 
		       Alias => [ 'owned' ] );

#dump_attr_def();

# mod => 0,
# create => 1,
# prot => 2,
# protn => 3,
# name => 4,
# path => 5,
# dir => 6,

sub isElementNode   { 1 }
sub xql_nodeType    { 1 }
sub xql_nodeName    { $_[0]->{TagName} }

sub dump_attr_def   { $ATTRDEF->dump; }
sub attrNames       { @{ $_[0]->{AttrDef}->{'@IN_ORDER'} } }
sub hasAttr         { exists $_[0]->{AttrDef}->{$_[1]} }

# Attributes set/get
sub full  		{ $_[0]->fullname }
sub abs      		{ $_[0]->abs }
sub no_ext		{ $_[0]->{TagName} }
sub set_no_ext		{ shift->set_name (@_) }
sub size		{ -s $_[0]->fullname }
sub age			{ -M $_[0]->fullname }
sub last_access_in_days	{ -A $_[0]->fullname }
sub is_file             { -f $_[0]->fullname }
sub is_dir              { -d $_[0]->fullname }
sub is_link             { -l $_[0]->fullname }
sub is_pipe             { -p $_[0]->fullname }
sub it_exists           { -e $_[0]->fullname }
sub is_zero             { -z $_[0]->fullname }
sub readable            { -r $_[0]->fullname }
sub writable            { -w $_[0]->fullname }
sub executable          { -x $_[0]->fullname }
sub owned               { -o $_[0]->fullname }

sub attr_alias    
{
    return undef unless defined $_[1];

    my $alias = $_[0]->{AttrDef}->alias ($_[1]);
    defined $alias ? $alias : $_[1];
}

sub create_path	# static
{
    my ($dir, $file) = @_;

    if ($dir =~ /\Q${XML::XQL::DirNode::SEP}\E$/)
    {
	return "$dir$file";
    }
    elsif ($dir eq "")	# e.g. when file is root directory '/'
    {
	return $file;
    }
    else
    { 
	return "$dir${XML::XQL::DirNode::SEP}$file";
    }
}

sub fullname
{ 
    my $pa = $_[0]->{Parent}->fullname;
    my $name = $_[0]->{TagName};
    create_path ($pa, $name);
}

#?? same as full name - for now
sub abs
{
    shift->fullname (@_);
}

sub parent_dir
{
    $_[0]->{Parent}->fullname;
}

# With 3 params, sets the specified attribute with $attrName to $attrValue.
# With 2 params, reinitializes the specified attribute with $attrName if
# it currently has a value.

sub update_attr
{
    my ($self, $attrName, $attrValue) = @_;

    if (@_ == 3)
    {
	my $attr = $self->getAttributeNode ($attrName);
	if (defined $attr && defined $attr->{Value})
	{
	    $attr->{Value} = $attrValue;
	}
    }
    else
    {
	return unless exists $self->{A}->{$attrName};
	my $a = $self->{A}->{$attrName};
	if (exists $a->{Value})
	{
	    delete $a->{Value};
	    $a->xql_value;	# reinitialize value
	}
    }
}

sub set_name
{
    my ($self, $text) = @_;
    my $fullName = $self->fullname;
    my $newName = create_path ($self->parent_dir, $text);

    if (rename ($fullName, $newName))
    {
	$self->{TagName} = $text;
	$self->update_attr ('name', $text);
	$self->update_attr ('ext');
	$self->update_attr ('no_ext');

	return 1;
    }
    else
    {
	warn "set_name: could not rename $fullName to $newName";
	return 0;
    }
}

sub ext
{
    my $name = $_[0]->{TagName};
    $name =~ /\.([^.]+)$/;
#    print "ext name=$name ext=$1\n";
    return $1;
}

sub set_ext
{
    my ($self, $text) = @_;
#    print "set_ext $text\n";
    my $no_ext = $self->no_ext;
    $self->set_name (length ($text) ? "$no_ext.$text" : $no_ext);
}

sub no_ext
{
    my $name = $_[0]->{TagName};
    $name =~ /^(.+)\.([^.]+)$/;
#    print "no_ext name=$name no_ext=$1\n";
    return $1;
}

sub set_no_ext
{
    my ($self, $text) = @_;
#    print "set_no_ext $text\n";
    my $ext = $self->ext;
    $self->set_name (length ($ext) ? "$text.$ext" : $text);
}

sub xql_attribute
{
    my ($node, $attrName) = @_;
    if (defined $attrName)
    {
	my $attr = $node->getAttributeNode ($attrName);
	defined ($attr) ? [ $attr ] : [];
    }
    else
    {
	my @attr;
	for my $name ($node->attrNames)
	{
	    push @attr, $node->getAttributeNode ($name);
	}
	\@attr;
    }
}

sub getAttributeNode
{
    my ($self, $attrName) = @_;
    $attrName = $self->attr_alias ($attrName);

    return undef unless $self->hasAttr ($attrName);

    my $attr = $_[0]->{A}->{$attrName} ||= 
	new XML::XQL::DirAttr (Parent => $self, Name => $attrName);
    $attr;
}

sub attrIndex
{
    $_[0]->{AttrDef}->order ($_[1]);
}

sub toString       
{ 
    my ($self, $depth) = @_;
    my $indent = "  " x $depth;
    my $str = $indent;
    my $tagName = $self->{TagName};

    my $tfp = $self->tag_for_print;

    $str .= "<$tfp name=\"$tagName\"";

    for my $attrName ($self->attrNames)
    {
	next unless exists $self->{A}->{$attrName};

#?? don't print un-retrieved attributes - for now	
	my $attr = $self->{A}->{$attrName};
	next unless $attr->is_defined;
	
	$str .= " " . $attr->toString;
    }

    my $kids = $self->print_kids ? $self->xql_node : [];
    if (@$kids)
    {
	$str .= ">\n";
	for (@$kids)
	{
	    $str .= $_->toString ($depth + 1);
	}
	$str .= $indent . "</dir>\n";
    }
    else
    {
	$str .= "/>\n";
    }
}

#----------------------------------------------------------------------------
package XML::XQL::Dir;	# Element node
use vars qw{ @ISA $ATTRDEF };
@ISA = qw( XML::XQL::DirElem );

$ATTRDEF = $XML::XQL::DirElem::ATTRDEF->clone;
$ATTRDEF->define_attr (Name => 'd', Get => \&XML::XQL::DirAttr::is_dir, 
		       Alias => [ 'is_dir' ] );
#dump_attr_def();

sub tag_for_print { "dir" }
sub print_kids    { 1 }
sub dump_attr_def { $ATTRDEF->dump }

sub new
{
    my ($type, %hash) = @_;
    $hash{AttrDef} = $ATTRDEF;
    bless \%hash, $type;
}

sub build
{
    my ($self) = @_;
    my $dirname = $self->fullname;
#    print "dirname=$dirname\n";

    if (opendir (DIR, $dirname))
    {
	my @kids;

	my @f = readdir (DIR);
	closedir DIR;

	for my $f (@f)
	{
	    next if $f =~ /^..?$/;
#	    print "dirname=$dirname f=$f\n";

	    my $full = defined $dirname ? "$dirname${XML::XQL::DirNode::SEP}$f" : $f;
#	    print "dirname=$dirname full=$full\n";

	    if (-f $full)
	    {
		push @kids, XML::XQL::File->new (Parent => $self, 
						 TagName => $f
						);
	    }
	    elsif (-d _)
	    {
		push @kids, XML::XQL::Dir->new (Parent => $self, 
						TagName => $f
					       );
	    }
	}
	$self->{C} = \@kids;
	$self->{Built} = 1;
    }
    else
    {
	print "can't opendir $dirname: $!";
    }
}

sub xql_childCount
{
    my $self = shift;
    $self->build unless $self->{Built};
    my $ch = $self->{C};

    defined $ch ? scalar(@$ch) : 0;
}

#----------------------------------------------------------------------------
package XML::XQL::File;	# Element node
use vars qw{ @ISA $ATTRDEF };
@ISA = qw( XML::XQL::DirElem );

$ATTRDEF = $XML::XQL::DirElem::ATTRDEF->clone;
$ATTRDEF->define_attr (Name => 'f', Get => \&XML::XQL::DirAttr::is_file, 
		       Alias => [ 'is_file' ] );
$ATTRDEF->define_attr (Name => 'size', Get => \&XML::XQL::DirAttr::size, 
		       Alias => [ 's' ]);
#dump_attr_def();

sub new
{
    my ($type, %hash) = @_;
    $hash{AttrDef} = $ATTRDEF;
    bless \%hash, $type;
}

sub getChildIndex  { 0 }
sub xql_childCount { 1 }
sub contents       { $_[0]->build unless $_[0]->{Built}; $_[0]->{C}->[0] }
sub xql_text       { $_[0]->contents->xql_text }
sub xql_rawText    { $_[0]->contents->xql_text }
sub tag_for_print  { "file" }
sub print_kids     { 0 }
sub dump_attr_def  { $ATTRDEF->dump }

sub xql_rawTextBlocks
{
    my $self = shift;
    ( [ 0, 0, $self->xql_text ])
}

sub xql_setValue
{
    my ($self, $text) = @_;
    $self->contents->xql_setValue ($text);
}

sub xql_replaceBlockWithText
{
    my ($self, $start, $end, $text) = @_;
    if ($start == 0 && $end == 0)
    {
	$self->xql_setValue ($text);
    }
    else
    {
	warn "xql_setText bad index start=$start end=$end";
    }
}

sub build
{
    my $self = shift;
    push @{ $self->{C} }, XML::XQL::FileContents->new (Parent => $self);
    $self->{Built} = 1;
}

#----------------------------------------------------------------------------
package XML::XQL::FileContents;	# Text node
use vars qw{ @ISA };
@ISA = qw{ XML::XQL::DirNode };

sub new
{
    my ($type, %hash) = @_;
    bless \%hash, $type;
}

sub isTextNode     { 1 }
sub xql_nodeType   { 3 }
sub xql_nodeName   { "#contents" }
sub getChildIndex  { 0 }
sub xql_childCount { 0 }
sub xql_rawText    { $_[0]->xql_text }

sub xql_text
{
    my $self = shift;
    unless ($self->{Built})
    {
	local *FILE;
	local $/;	# slurp mode

	if (open (FILE, $self->{Parent}->fullname))
	{
	    $self->{Data} = <FILE>;
	    close FILE;
	}
	else
	{
#?? warning
	}
	$self->{Built} = 1;
    }
    $self->{Data};
}

sub xql_setValue
{
    my ($self, $text) = @_;

    my $filename = $self->{Parent}->fullname;
    local *FILE;
    if (open (FILE, ">$filename"))
    {
	print FILE $text;
	$self->{Data} = $text;
	$self->{Built} = 1;
	close FILE;
    }
    else
    {
	warn "xql_setValue could not open $filename for writing";
    }
}

return 1;
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)