#!/usr/bin/perl -w

use strict;
use Opt;
use Common;
package Sch;

 # edit this to change the list of default direcotories to find
 #  symbols, and source schematics
my @def_sym_dir_r = qw| /usr/share/gEDA/sym |; # or /usr/local/share/gEDA/sym /usr/local/share/lepton-eda/sym/
my @def_sym_dir = qw| _symbol sym include /usr/local/share/lepton-eda/sym/ |;
my @def_src_dir = qw/ _sub_page include /;

#use Data::Dumper;;

# list of used components, subsheets, and attributes
my %component;
my %source;
my %attribute;

# valid object types listed in sorting order
my $object_types = "vTCBVALHNUGPF#";

# sorting order for pin and component attributes
my @sort_attribute_pin       = qw/pinseq pinnumber pinlabel pintype/;
my @sort_attribute_component = qw/refdes footprint value/;


##############################
# generics

sub normalize_dirs(@) {
    # conv. to absolute paths and remove duplicates
    my @dir = @_;

    my @ndir = ();
    my %dup = ();

    for my $dir (@dir) {
	my $ndir = `readlink -e $dir`;
	chomp $ndir;
	#print "<$dir>\n<$ndir>\n";
	if (defined($dup{$ndir})) {
	    # ignore duplicates
	    next;
	} else {
	    $dup{$ndir} = 1;
	}
	push @ndir, $ndir;
    }
    @ndir;
}

sub read_gafrc(;$@) {
    my $opt = shift;
    my @gafrc;

    if (@_) {
	@gafrc = @_;
    } elsif ($$opt{config}) {
	@gafrc = split(/,/, $$opt{config});
    } elsif (-f "~/.config/lepton/gafrc") {
	@gafrc = ("~/.config/lepton/gafrc");
    } elsif (-f "~/.config/gEDA/gafrc") {
	@gafrc = ("~/.config/gEDA/gafrc");
    } else {
	@gafrc = ("~/.gEDA/gafrc");
    }
    if (-f "gafrc") {
	push @gafrc, "gafrc";
    }

    Opt::debug($opt, "", "gafrc: %s\n", join(" ", @gafrc));

    my @sym_dir = ();
    my @sym_dir_r = ();
    my @src_dir = ();
    my @src_dir_r = ();

    for my $file (@gafrc) {
	my %var;
	$file =~ s/~/$ENV{HOME}/;
	Opt::debug($opt, "", "gafrc file: %s\n", $file);
	if (!open(FH, "<", $file)) {
	    next;
	}
	while (<FH>) {
	    s/\$\{HOME\}/$ENV{HOME}/;
	    tr/ \t/ /s;
	    s/^ //;
	    s/ $//;
	    chomp;
	    s/;.*//;
	    if (m/^\(define ([a-zA-Z]+) \((.+)\)\)/) {
		my $key = $1;
		my $var = $2;
		my @fld = split(/ /, $var);
		if ($fld[0] eq "readlink") {
		    my $ref = $var{$fld[1]} // $fld[1];
		    $var = `readlink -f $fld[1]`;
		    chomp $var;
		    $var{$key} = $var;
		} elsif ($fld[0] eq "dirname") {
		    my $ref = $var{$fld[1]} // $fld[1];
		    $var = `dirname $ref`;
		    chomp $var;
		    $var{$key} = $var;
		} elsif ($fld[0] eq "getenv") {
		    my $ref = $var{$fld[1]} // $fld[1];
		    $ref =~ s/^"//;
		    $ref =~ s/"$//;
		    $var = $ENV{$ref};
		    #chomp $var;
		    $var{$key} = $var;
		}
		Opt::debug($opt, "", "define: <%s> <%s>\n", $key, $var);
	    } elsif (m/^\(define \(([a-zA-Z]+) [a-zA-Z ]+\)/) {
		my $key = $1;
	    } elsif (m/\((component|source)-library(-search)? (.*)\)/) {
		my $type = $1;
		my $ss = $2;
		my $rest = $3;
		if (defined($ss)) {
		    if ($rest =~ m/^(.*) "([a-zA-Z\/_.]+)"$/) {
			$rest = $1;
			#print "<$rest>\n";
		    } else {
		    }
		} else {
		    $ss = "";
		}
		Opt::debug($opt, "", "\n$_\ntype <$type> ss <$ss> rest <$rest>\n");
		my $dir;
		if ($rest =~ m/^\(build-path ([a-zA-Z]+) \"([a-zA-Z\/_.]+)\"\)/) {
		    my $var = $var{$1} // "";
		    $dir = $var . "/" . $2;
		    Opt::debug($opt, "", "build-path: %s %s\n", $var, $dir);
		} elsif ($rest =~ m/^\"([a-zA-Z\/_.]+)\"$/) {
		    $dir = $1;
		    Opt::debug($opt, "", "build else: %s\n", $dir);
		} else {
		    err("ERR: unhandled input line <$_>");
		}
		if ($type eq "component" && $ss) {
		    push @sym_dir_r, $dir;
		} elsif ($type eq "component") {
		    push @sym_dir, $dir;
		} elsif ($type eq "source" && $ss) {
		    push @src_dir_r, $dir;
		} elsif ($type eq "source") {
		    push @src_dir, $dir;
		}
	    }
	}
	close(FH);
    }

    @sym_dir   = normalize_dirs(@sym_dir);
    @sym_dir_r = normalize_dirs(@sym_dir_r);
    @src_dir   = normalize_dirs(@src_dir);
    @src_dir_r = normalize_dirs(@src_dir_r);

    ( \@sym_dir, \@sym_dir_r, \@src_dir, \@src_dir_r );
}

sub rm_dup(@) {
    my %tm;
    for my $el (@_) {
	$tm{$el}++;
    }
    sort keys %tm;
}

sub find_sym_src_files($$$$) {
    my $sym_dir = shift;
    my $sym_dir_r = shift;
    my $src_dir = shift;
    my $src_dir_r = shift;

    my @sym;
    my @src;

    for my $dir (@$sym_dir){
	push @sym, Common::find($dir, '\*.sym', 1);
    }
    for my $dir (@$sym_dir_r){
	push @sym, Common::find($dir, '\*.sym');
    }
    for my $dir (@$src_dir){
	push @src, Common::find($dir  , '\*.sch', 1);
    }
    for my $dir (@$src_dir_r){
	push @src, Common::find($dir, '\*.sch');
    }
    @sym = rm_dup(@sym);
    @src = rm_dup(@src);

    ( \@sym, \@src );
}

sub basenameToFile($$) {
    my $sym = shift;
    my $src = shift;

    my %sym_avail;
    my %src_avail;

    for my $file (@$sym) {
	$file =~ m|/([^/]*)$|;
	my $bn = $1;
	if (!defined($sym_avail{$bn})) {
	    $sym_avail{$bn} = [];
	}
	push @{$sym_avail{$bn}}, $file;
    }

    for my $file (@$src) {
	$file =~ m|/([^/]*)$|;
	my $bn = $1;
	if (!defined($src_avail{$bn})) {
	    $src_avail{$bn} = [];
	}
	push @{$src_avail{$bn}}, $file;
    }

    ( \%sym_avail, \%src_avail );
}

sub sch_init($@) {
    my $opt = shift;
    my @gafrc = @_;

    my ( $sym_dir, $sym_dir_r, $src_dir, $src_dir_r ) = read_gafrc($opt,@gafrc);

    my @sym_dir   = ();
    my @sym_dir_r = ();
    my @src_dir   = ();
    my @src_dir_r = ();

    if (defined($$opt{symdir}) && $$opt{symdir}) {
	@sym_dir   = split(/,/, $$opt{symdir});;
    } else {
	@sym_dir   = @$sym_dir;
    }
    if (defined($$opt{symdirr}) && $$opt{symdirr}) {
	@sym_dir_r = split(/,/, $$opt{symdirr});;
    } else {
	@sym_dir_r = @$sym_dir_r;
    }
    if (defined($$opt{srcdir}) && $$opt{srcdir}) {
	@src_dir   = split(/,/, $$opt{srcdir});;
    } else {
	@src_dir   = @$src_dir;
    }
    if (defined($$opt{srcdirr}) && $$opt{srcdirr}) {
	@src_dir_r = split(/,/, $$opt{srcdirr});;
    } else {
	@src_dir_r = @$src_dir_r;
    }

    Opt::debug($opt, 10, "\n");
    Opt::debug($opt, 10, "sym_dir  : %s\n", join(" ", @sym_dir));
    Opt::debug($opt, 10, "sym_dir_r: %s\n", join(" ", @sym_dir_r));
    Opt::debug($opt, 10, "src_dir  : %s\n", join(" ", @src_dir));
    Opt::debug($opt, 10, "src_dir_r: %s\n", join(" ", @src_dir_r));

    my ($sym, $src) = find_sym_src_files( \@sym_dir, \@sym_dir_r, \@src_dir, \@src_dir_r );
    my ($sym_avail, $src_avail) = basenameToFile($sym, $src);

    ($sym, $src, $sym_avail, $src_avail);
}

##############################
# handling of [ list of objects ]

sub sch_parse(@) {
    my @line = @_;

    my $data = [];		# array of hash refs
    my @data  = ();
    my $nxt = {};		# last element in @$data
    my @nxt = ();
    my $attr = {};
    my @attr = ();

    my $Tcnt = 0;
    my $Hcnt = 0;
    my @Tdata = ();
    my @Hdata = ();

    for (@line) {
	my $line = $_;
	$line =~ s/\r$//;
	chomp $line;
	my @fld = split;

	if ($Tcnt) {
	    $Tcnt--;
	    push @Tdata, $line;
	    if ($Tcnt == 0) {
		# we could use ${$$nxt{fld}}[9], but in old format [9] didn't exist, it was assumed 1
		if (@Tdata == 1 && $Tdata[0] =~ m/^([^=]+)=(.*)$/) {
		    my $key = $1;
		    my $val = $2;
		    $attribute{$key}++;
		    $$attr{$key} = $val;
		}
		$$nxt{text} = [ @Tdata ];
		@Tdata = ();
	    }
	} elsif ($Hcnt) {
	    $Hcnt--;
	    push @Hdata, $line;
	    if ($Hcnt == 0) {
		$$nxt{path} = [ @Hdata ];
		@Hdata = ();
	    }
	} elsif ($line =~ m/^[$object_types]/) {
	    $nxt = { fld => [ @fld ] };
	    push @$data, $nxt;
	    if ($fld[0] eq "T") {
		$Tcnt = $fld[ 9];
		$Tcnt = 1 unless (defined($Tcnt));
	    } elsif ($fld[0] eq "H") {
		$Hcnt = $fld[13];
	    } elsif ($fld[0] eq "C") {
		$component{$fld[6]}++;
	    } else {
	    }
	} elsif ($line =~ m/^\[$/) {
	    if (defined($$nxt{att})) {
		print "ERR: attachment before embedded component\n";
	    }
	    if (defined($$nxt{emb})) {
		print "ERR: double embedded section, possible a missing component (\"C\") line\n";
		$nxt = { fld => [ "MISSING COMPONENT ?" ] };
		push @$data, $nxt;
	    }
	    push @data, $data;
	    $data = [];
	    $$nxt{emb} = $data;
	    push @nxt, $nxt;
	    $nxt = undef;
	} elsif ($line =~ m/^\]$/) {
	    $data = pop @data;
	    $nxt  = pop @nxt;
	} elsif ($line =~ m/^{$/) {
	    if (defined($$nxt{att})) {
		print "ERR: double attachment, possible a missing object\n";
		$nxt = { fld => [ "MISSING OBJECT ?" ] };
		push @$data, $nxt;
	    }
	    push @data, $data;
	    $data = [];
	    $$nxt{att} = $data;

	    push @attr, $attr;
	    $attr = {};
	    $$nxt{rev_att} = $attr;

	    push @nxt, $nxt;
	    $nxt = undef;

	} elsif ($line =~ m/^}$/) {
	    $data = pop @data;
	    $attr = pop @attr;
	    $nxt  = pop @nxt;
	} elsif ($line =~ m/^$/) {
	    $nxt = { fld => [ $line ] };
	    push @$data, $nxt;
	    $nxt = undef;
	} elsif ($line =~ m/^#/) {
	    $nxt = { fld => [ $line ] };
	    push @$data, $nxt;
	    $nxt = undef;
	} else {
	    print "ERR: $line\n";
	}
    }

    $data;
}

sub data2str($);
sub data2str($) {
    my $data = shift;
    my $str = "";

    for my $nxt (@$data) {
	next unless (defined($nxt));
	$str .= join(" ", @{$$nxt{fld}}) . "\n";
	if (defined($$nxt{text})) { $str .= join("\n", @{$$nxt{text}}) . "\n"; }
	if (defined($$nxt{path})) { $str .= join("\n", @{$$nxt{path}}) . "\n"; }
	if (defined($$nxt{emb})) {
	    $str .= "[\n";
	    $str .= data2str($$nxt{emb});
	    $str .= "]\n";
	}
	if (defined($$nxt{att})) {
	    $str .= "{\n";
	    $str .= data2str($$nxt{att});
	    $str .= "}\n";
	}
    }
    $str;
}

sub dataCopy($);
sub dataCopy($) {
    my $data = shift;
    my $copy = [];

    for my $nxt (@$data) {
	my $p = {};
	$$p{fld} = [ @{$$nxt{fld}} ];

	if (defined($$nxt{text   })) { $$p{text   } = [ @{$$nxt{text}} ]; }
	if (defined($$nxt{path   })) { $$p{path   } = [ @{$$nxt{path}} ]; }
	if (defined($$nxt{rev_att})) { $$p{rev_att} = { %{$$nxt{rev_att}} }; }
	if (defined($$nxt{emb    })) { $$p{emb    } = dataCopy($$nxt{emb}); }
	if (defined($$nxt{att    })) { $$p{att    } = dataCopy($$nxt{att}); }

	push @$copy, $p;
    }

    $copy;
}

sub data2Hash($) {
    my $data = shift;
    #print "ref($data): ", ref($data), "size: ", @$data+0, " data2Hash\n";

    my %Hash = ();
    for my $k (split "", $object_types) {
	$Hash{$k} = [];
    }

    for (my $ix = 0; $ix < @$data; $ix++) {
	my $fld = $$data[$ix]{fld};
	my $type = $$fld[0];
	push @{$Hash{$type}}, $ix;
    }
    %Hash;
}

sub get_glb_attr($$) {
    my $data = shift;
    my $Hash = shift;

    my @ix = @{$$Hash{T}};

    my %Attr = ();
    for my $ix (@ix) {
	my @text = @{$$data[$ix]{text}};
	if ($text[0] =~ m/^([^=]+)=(.*)$/) {
	    my $k = $1;
	    my $v = $2;
	    if (@text > 1) {
		shift @text;
		$v = $v . "\n" . join("\n", @text);
	    }
	    if (!defined($Attr{$k})) {
		$Attr{$k} = [];
	    }
	    push @{$Attr{$k}}, $v;
	    #print "$k = $v\n\n";
	}
    }

    %Attr;
}

##############################
# finding nets

sub findCNodes() {
    my $data = shift;
}
sub findNets($$) {
    my $data = shift;
    my $Hash = shift;

    my @N = $$Hash{N};

    for my $n (@N) {
	print;
    }
}

##############################
# sorting

sub dataSortInit(;$) {
    my $obj_type_order  = shift;

    if (!defined($obj_type_order )) { $obj_type_order  = $object_types; }
    my @order = split(//, $obj_type_order);
    my $order = { Common::revArr(@order) };
    $$order{""} = @order + 0;

    #print Dumper($order);
    $order;
}
sub dataSortAttributeInit() {
#    for my $v (@sort_attribute_pin) {
#	if (defined($v)) { delete($attribute{$v}); }
#    }

#    my @attribute = ( @sort_attribute_pin, sort keys %attribute );
    my @attribute = ( @sort_attribute_pin, @sort_attribute_component );
    %attribute = Common::revArr(@attribute);
}

sub dataSortPrepare($$;$$);
sub dataSortPrepare($$;$$) {
    # add $$data{sort} = ... to make sorting simple
    my $data   = shift; # [ list_of_objects ], returm value of parse_text()
    my $order  = shift; # object sort order, return value of dataSortInit()
    my $parent = shift;
    my $mtype  = shift;

    #if (!defined($parent)) { $parent = []; }
    if (!defined($mtype )) { $mtype  = ""; }
    my $ymax = 9999999;
    my $amax = (keys %attribute) + 0;

    for my $nxt (@$data) {
	my $type = $$nxt{fld}->[0];

	my $sort_top = $$order{$type} // 99999; # top sort value

	my $sort_mid = "";             # mid sort value
	if ($type eq "C") {
	    if      (defined($$nxt{rev_att}->{refdes})) {
		$sort_mid = $$nxt{rev_att}->{refdes};
	    } elsif (defined($$nxt{rev_att}->{footprint})) {
		$sort_mid = $$nxt{rev_att}->{footprint};
	    } else {
		$sort_mid = $$nxt{fld}->[6];
	    }
	} elsif ($type eq "P") {
	    if      (defined($$nxt{rev_att}->{pinnumber})) {
		$sort_mid = $$nxt{rev_att}->{pinnumber};
	    } elsif (defined($$nxt{rev_att}->{pinlabel})) {
		$sort_mid = $$nxt{rev_att}->{pinlabel};
	    } elsif (defined($$nxt{rev_att}->{pinseq})) {
		$sort_mid = $$nxt{rev_att}->{pinseq};
	    }
	} elsif ($type eq "T") {
	    my $cnt = $$nxt{fld}->[9];
	    if (!defined($cnt)) { $cnt = 1; }
	    if ($cnt == 1 && $$nxt{text}->[0] =~ m/^([^=]+)=(.*)$/) {
		my $key = $1;
		if ($parent && defined($attribute{$key})) {
		    $sort_mid = $attribute{$key};
		} else {
		    $sort_mid = $amax;
		}
	    }
	}

	my ($x, $y) = (0,0);        # low sort value
	if ($type =~ m/^[BVALNUTGPC]$/) {
	    $x = $$nxt{fld}->[1];
	    $y = $$nxt{fld}->[2];
	    #print "->", join(" ", @{$$nxt{fld}}), "\n";
	} elsif ($type eq "H" && defined($$nxt{path})) {
	    my $str = join( " ", @{$$nxt{path}} );
	    $str =~ tr/ \r\n, / /s;
	    if ( $str =~ m/^M (\d+) (\d+)/i ) {
		$x = $1;
		$y = $2;
	    }
	}
	# things above another goes first
	#if ($y) { $y = $ymax - $y; }

	# this is only sort order of the file, use the one which is convenient to read
	$$nxt{sort} = sprintf( "%02d %-6s %7d %7d", $sort_top, $sort_mid, $x, $y);
	if ($type eq "C") {
	    print join(" ", @{$$nxt{fld}}), "\n";
	    print "$$nxt{sort}\n";
	}
	if (defined($$nxt{emb}))  { dataSortPrepare( $$nxt{emb}, $order, $nxt, "emb" ); }
	if (defined($$nxt{att}))  { dataSortPrepare( $$nxt{att}, $order, $nxt, "att" ); }
    }

    0;
}

sub sort_data() {
    my $as = $$a{sort};
    my $bs = $$b{sort};

    $as cmp $bs;
}

sub dataSort($$) {
    my $data = shift;
    my $order = shift;

    dataSortAttributeInit();
    dataSortPrepare($data, $order);
    my @srt = sort sort_data @$data;

    for my $o (@srt) {
	my $srt;
	if (defined($$o{att})) {
	    $srt = [ sort sort_data @{$$o{att}} ];
	    $$o{att} = $srt;
	}
	if (defined($$o{emb})) {
	    my $srt = [ sort sort_data @{$$o{emb}} ];
	    $$o{emb} = $srt;
	}
    }

    @srt;
}

##############################
# testing

sub test_file($$) {
    my $file = shift;
    my $order = shift;

    my $cmd;
    my $res;

    my @line = Common::read_file($file);
    my $data = sch_parse(@line);

    my $copy = dataCopy($data);
    my @srt = dataSort($copy, $order);
    my $s2  = data2str(\@srt);
    Common::write_file("z2", $s2);
    $cmd = "diff -b -u <(sort $file) <(sort z2)";
    $res = `echo "$cmd" | /bin/bash`;
    print "$? $cmd\n$res";

    my $str = data2str($data);
    Common::write_file("zz", $str);
    $cmd = "diff -b -u $file zz";
    $res = `$cmd`;
    print "$? $cmd\n$res";
}

sub test(@) {
    my $order = dataSortInit();

    my @file = @_;
    for my $file (@file) {
	test_file($file, $order);
    }
}



1;

__END__

"vBVALHNUTGPCF#";

($type, $version, $fileformat_version) # v version

($type, $x, $y, $width, $height, $color, $width, $capstyle, $dashstyle, $dashlength, $dashspace, $filltype, $fillwidth, $angle1, $pitch1, $angle2, $pitch2) # B box
($type, $x, $y, $radius, $color, $width, $capstyle, $dashstyle, $dashlength, $dashspace, $filltype, $fillwidth, $angle1, $pitch1, $angle2, $pitch2) # V circle
($type, $x, $y, $radius, $startangle, $sweepangle, $color, $width, $capstyle, $dashstyle, $dashlength, $dashspace) # A arc
($type, $x1, $y1, $x2, $y2, $color, $width, $capstyle, $dashstyle, $dashlength, $dashspace) # L line

($type, $color, $width, $capstyle, $dashstyle, $dashlength, $dashspace, $filltype, $fillwidth, $angle1, $pitch1, $angle2, $pitch2, $numlines) # H path +lines

($type, $x1, $y1, $x2, $y2, $color) # N net
($type, $x1, $y1, $x2, $y2, $color, $ripperdir) # U bus

($type, $x, $y, $color, $size, $visibility, $show,_$name,_$value, $angle, $alignment, $num_lines) # T text +lines
($type, $x, $y, $width, $height, $angle, $mirrored, embedded) # G picture, +lines

($type, $x1, $y1, $x2, $y2, $color, $pintype, $whichend) # P pin
($type, $x, $y, $selectable, $angle, $mirror, $basename) # C component

($type, $character, $width, $flag) # F font, in font files only



sub tree_rm_dup($$) {
    #################### TODO
    my $dir_tree = shift;
    my $dir_list = shift;
    for my $top (@$dir_tree) {
	for my $dir (@$dir_list) {
	    next if (index($top,$dir,0) == 0);
	}
    }
}