#!/usr/bin/perl

# Midnight Commander XML extfs module
# By Peter A. Kerzum (kerzum at mail dot ru)
# Supports listing and copyout of elements / attributes
# Requires XML::Simple perl module (use perl -MCPAN -e 'install XML::Simple')

# Bugs:
# - XML elements may be heavily reformatted on copyout
# - Datetimes are not supported, so are file sizes for elements
# - '/' sign in attribute values is unconditionally translated to '-'
# - Low file size limit
# - Other may follow =)

use strict;
use XML::Simple;
use Data::Dumper;

my $mode=$ARGV[0];
my $arch=$ARGV[1];
my $path=$ARGV[2];
my $out=$ARGV[3];

# List implementation
sub show_element_entry($$)
{
    my ($path,$elem)=@_;

    my $size=0;
    print "dr-xr-xr-x 1 root root $size Feb 28 13:48 $path\n";
    # these pseudo-files are for copyout only
    print "-r--r--r-- 1 root root $size Feb 28 13:48 $path/.noattr.xml\n";
    print "-r--r--r-- 1 root root $size Feb 28 13:48 $path/.content.xml\n";

    unless(ref $elem)
    {
	# elem is document text
	my $list_text_maxlen=40;
	$elem=substr($elem,0,$list_text_maxlen-3).'...' if(length $elem > $list_text_maxlen);
	$elem=~s/\n/\\n/sg;
	$elem=~s!/!-!g;
	print "-r--r--r-- 1 root root $size Feb 28 13:48 $path/.text: $elem\n";
	return;
    }

    for my $e(keys %$elem)
    {
	my $ce=$elem->{$e};
	my $is_elem=undef;
	my $name=$e;

	if(ref $ce)
	{
	    # show this elem
	    show_element("$path/$e",$ce);
	}
	else
	{
	    # attr
	    if(length($ce)) { $name.=": $ce"; }
	    else { $name.=": (empty)"; }

	    # What to do with / in values?
	    $name=~s!/!-!g;
	    
	    $size=length $ce;
	    print "-r--r--r-- 1 root root $size Feb 28 13:48 $path/$name\n";
	}
    }
}

sub show_element($$)
{
    my ($path,$elem)=@_;
    die "show_element: awaiting array, got $elem for $path" unless ref $elem eq 'ARRAY';

    my $max=scalar @$elem;
    my $size=length "$max";
        
    my $cnt=undef;
    for my $e(@$elem)
    {
	my $npath=$path;
	if(defined $cnt) { $npath.=" - ".sprintf("%0${size}i",$cnt); }
#	die "show_element: awaiting array of hashes ($path), got $e" unless ref $e eq 'HASH';

#	if(ref $e eq 'HASH')
	{
	    show_element_entry($npath,$e);
	}
#	elsif(not ref $e) 

	$cnt||=0;
	$cnt++;
    }
}

# List
sub ls($;$)
{
    my ($file,$path)=@_;
    # my $doc=XMLin($file,ForceArray=>1,KeepRoot=>1,KeyAttr=>[]);
    my $doc=XMLin($file,ForceArray=>1,KeepRoot=>1,KeyAttr=>[]);
    print Dumper $doc if grep /-d/,@ARGV;

    die "root elem constraints" unless ref $doc eq 'HASH' and scalar keys %$doc == 1;
    show_element("",[$doc]);

    # print $path;
    # print "-r--r--r-- 1 root root 1024 Feb 28 13:48 path is $path\n";
    # print "-r--r--r-- 1 root root 1024 Feb 28 13:48 kiviosheet/zzz\n";
}

# Copyout implementation
sub cd($$)
{
    my ($elem,$dir)=@_;
    die "show_element: awaiting hash, got $elem for $path" unless ref $elem eq 'HASH';
    
    my $n=0;
    if($dir=~m/^(\S*) - (\d+)$/)
    {
	$dir=$1;
	$n=$2;
    }
    return ($elem->{$dir}[$n],$dir);
}

sub get_node_content($$)
{
    my ($file,$path)=@_;
    my $doc=XMLin($file,ForceArray=>1,KeepRoot=>1,KeyAttr=>[]);
    my $doc=$doc;

    my @path=split /\//,$path;

    my $cpe=undef;
    while(scalar @path>1)
    {
	$cpe=shift @path;
	($doc,$cpe)=cd($doc,$cpe);
    }    
    
    my $leaf=shift @path;
    die if @path;

    if($leaf=~m/^([^:]+): (.+)$/) { $leaf=$1; }

    my %options=(
	RootName=>$cpe,
	XMLDecl=>1,
	SuppressEmpty=>undef,
	AttrIndent=>1,
    );
    
    if($leaf eq '.content.xml') { return XMLout($doc,%options); }
    elsif($leaf eq '.noattr.xml') { return XMLout($doc,%options,(NoAttr=>1)); }
    elsif($leaf eq '.text') { return $doc; }
    # This could not happen in current extfs
    #    elsif(ref $doc->{leaf}) { $doc=cd($doc,$leaf); return Dumper $doc; }
    elsif(ref $doc->{leaf}) { die "copyout of element"; }
    else { return $doc->{$leaf}; }

}

# Copyout
sub co($$$)
{
    my ($arch,$path,$out)=@_;

    open O,">$out" or die "cant open output file";
    print O get_node_content($arch,$path);
    close O;
}

if($mode eq "list")
{
    ls($arch,$path);
    # print "-r--r--r-- 1 root root 1024 Feb 28 13:48 file1.xml\n";
}
elsif($mode eq 'copyout')
{
    co($arch,$path,$out);
}
else
{
    exit 1;
}

