#!perl -lw
# Version 0.02
# A perl version of Gareth's listalf.
# Somewhat slower.
# Considereably more hackable.

use strict;
use RISCOS::Throwback;
use RISCOS::File ':DEFAULT', '/glob/';
use RISCOS::Filespec;
use RISCOS::Chunkfile;
use RISCOS::AOF;
use RISCOS::ALF;
use RISCOS::Time qw (time2utc time2local);
# Keep paths intact (eg Unix:o.UnixLib
glob_control (&fileglob_PrintOriginalPath);

use Getopt::Std;

use vars qw(%opt $VERSION);

$VERSION = 0.02;
getopts ('?nmtsoyiclv', \%opt);

$opt{'m'}= $opt{'n'} = 1 unless keys (%opt);

sub do_file
{
    my $file = shift;
    my $chunks = new RISCOS::Chunkfile shift;
    my $entry = shift;
    # So that name and data source can differ

    unless (defined $chunks) {
	warn "'$file' is not a chunkfile";
    }
    elsif ($chunks->Lookup ('OBJ_HEAD'))
    {
	# izza AOF
	warn "File '$file' is AOF\n";
    }
    elsif ($chunks->Lookup ('LIB_DIRY'))
    {
	if (my $library = new RISCOS::ALF $chunks) {
	    # izza ALF
	    if ($entry) {
		&do_alf ($library, $file, $library->Dir_Lookup ($entry));
	    } else {
		&do_alf ($library, $file, values %{$library->Dir});
	    }
	}
    }
    else
    {
	warn "'$file' is not a recognised chunkfile - contains "
	  . join (', ', keys %{$chunks->Index}) . ' chunks';
    }
}

sub do_alf ($$;@) {
    my $library = shift;
    my $file = shift;
    my $maxlen = 0;
    my $maxoff = 0;
    my $maxsize = 0;
    my $formatnum = 1 + int (log (2 + scalar @_) / log 10);
    my $count = 0;

    foreach (@_) {
	my ($len, $size, $off) = (length $_->Name(), $_->Chunk()->Length(),
				  $_->Chunk()->Offset());
	$maxlen = $len if $len > $maxlen;
	$maxsize = $size if $size > $maxsize;
	$maxoff = $off if $off > $maxoff;
	$count++;
    }
    if ($opt{'l'}) {
	print "Library file '$file':";
	print '  ALF version ', $library->Version;
	print '  contents updated ', scalar time2local $library->Time->Time;
	print '  symtable updated ', scalar time2local $library->Sym_Time->Time;
	print '  ', $count, ' member', $count == 1 ? '' : 's';
	print '-' x 60;
    }
    my $formatoff = 1 + int (log ($maxoff) / log 16);
    my $formatsize = 1 + int (log ($maxsize) / log 10);

    foreach (sort {$a->Index() <=> $b->Index()} @_) {
	# Reference to chunk data means "treat this as file to load"
	my (@line, $size);
	push @line, sprintf "%${formatnum}d", $_->Index() if $opt{'n'};
	push @line, sprintf "%-${maxlen}s", $_->Name() if $opt{'m'};
	if ($opt{'s'} or $opt{'o'}) {
	    my @so;
	    @so =
	      sprintf "%${formatsize}d", $_->Chunk->Length();
	    push @so,
	      sprintf "at &%0${formatoff}X", $_->Chunk->Offset();
	    push @line, join ' ', @so;
	}
	push @line, scalar time2local ($_->Time->Time) if $opt{'t'};

	if ($opt{'s'} or $opt{'i'} or $opt{'c'}) {
	    my $aof = new RISCOS::AOF \($_->Chunk->Data);
	    if ($aof) {
		if ($opt{'c'}) {
		    my @symbols;
		    foreach my $symbol (@{$aof->Symbols}) {
			push @symbols, $symbol->Name() if $symbol->Scope eq '';
		    }
		    print join ' : ', @line, (join ' ', @symbols);
		} elsif ($opt{'i'}) {
		    foreach my $symbol (@{$aof->Symbols}) {
			print join ' : ', @line, $symbol->Name()
			  if $symbol->Scope eq '';
		    }
		} else {
		    print join ' : ', @line;
		    foreach my $symbol (@{$aof->Symbols}) {
			print '       | ' . $symbol->Name()
			  if $symbol->Scope eq '';
		    }
		}
	    } else {
		warn 'Failed to extract symbols from ' . $_->Name();
		print join ' : ', @line if @line;
	    }
	} else {
	    print join ' : ', @line if @line;
	}
#	print "$file,", $_->Name(), ' : ', $_->Index();
	
    }
}

if ($opt{'v'}) {
    print STDERR "This is$0 version $VERSION";
    exit;
}

if ($opt{'?'}) {
    print STDERR <<"!!";
$0, version $VERSION
Options:
  -n --numbers     display chunk numbers
  -m --members     display membernames
  -t --timestamps  display timestamps of members
  -s --sizes       display sizes of members
  -o --offsets     display offsets of members within file
  -y --symbols     display symbol table
  -i --inline      display symbols on same line as other stuff
  -c --compact     ditto, with all symbols on one line
  -l --lib-info    display ALF version, library timestamp etc
  -v --version     print version number of this program
  If no options are given, -nm is assumed.
!!
  exit 0;
}
foreach (@ARGV)
{
    # Try to make the entry the longest comma free string possible
    my ($file, $entry) = ($_);

    # Found a comma? If so separate as it's probably a $file,$entry for ALF
    ($file, $entry) = /^(.*?),?([^,]*)$/ if tr/,//;

    my @files = glob ($file);

    @files = $file unless @files;	# Push pattern if unmatched

    foreach $file (@files)
    {
	do_file ($file, $file, $entry);
    }
}
