#!/usr/bin/perl

#==============================================================================#
package JTREE;
#==============================================================================#
#------------------------------------------------------------------------------#
sub new {
#------------------------------------------------------------------------------#
        my ($class, @data) = @_;
        my $ref = {};
        bless $ref, $class;
        $ref->init(@data);
        return $ref;
}

#------------------------------------------------------------------------------#
sub init {
#------------------------------------------------------------------------------#
        my ($ref, @data) = @_;
        %$ref = ('jtree_name',        0,
                'jtree_level',        0,
                'jtree_loop',        0
        );
        foreach $adata (@data) {
                $ref->add($adata,'');
        }
}

#------------------------------------------------------------------------------#
sub add {
#------------------------------------------------------------------------------#
        my ($ref, @data) = @_;
        if(@data) { %$ref = (%$ref,@data);}
}

#------------------------------------------------------------------------------#
sub add_point {
#------------------------------------------------------------------------------#
        my ($ref, @points) = @_;
        foreach my $apoint (@points) {
                if(! $ref->{$apoint}) {
                        my $apointh = new JTREE;
                        $ref->add($apoint,$apointh);
                        $ref->{$apoint}->add("jtree_name",$apoint);
                }
        }
}

#------------------------------------------------------------------------------#
sub read_treeline {
#------------------------------------------------------------------------------#
        my ($ref,$point,@data) = @_;

        $ref->add_point($point,@data);

        foreach my $ason (@data) {
                $ref->{$point}->add($ason,$ref->{$ason});
        }
}

#------------------------------------------------------------------------------#
sub base_keys {
#------------------------------------------------------------------------------#
        my ($ref) = @_;
        my @olist=();
        foreach my $akey (keys %$ref) {
                if( ref($ref->{$akey}) eq "JTREE" ) {
                        push(@olist,$akey);
                }
        }
        @olist;
}

#------------------------------------------------------------------------------#
sub base_check {
#------------------------------------------------------------------------------#
        my ($ref,$hier) = @_;

        if(!($ref->{'treg1'} > $hier)) {
                $ref->{'treg1'} = $hier;
        }
        foreach my $akey ($ref->base_keys()) {
                $ref->{$akey}->base_check($hier+1);
        }
}

#------------------------------------------------------------------------------#
sub correct_check {
#------------------------------------------------------------------------------#
        my ($ref,$correct) = @_;

        if($correct == 1) {
                $ref->{'correct'} += 3;
                $ref->correct_base();
        }
        elsif($correct == -1) {
                $ref->{'correct'} = -1;
        }
}

#------------------------------------------------------------------------------#
sub correct_base {
#------------------------------------------------------------------------------#
        my ($ref) = @_;
        if($ref->{'correct'} == 0) {
                $ref->{'correct'} = 1;
        }
        foreach my $akey ($ref->base_keys()) {
                $ref->{$akey}->correct_base();
        }
}

#------------------------------------------------------------------------------#
sub false_base {
#------------------------------------------------------------------------------#
        my ($ref) = @_;
        foreach my $akey ($ref->base_keys()) {
                if(  (-1<$ref->{$akey}->{'correct'})
                   &&($ref->{$akey}->{'correct'}< 2)
                ) {
                        return($akey);
                }
        }
        return ();
}

#------------------------------------------------------------------------------#
sub cpoint_check {
#------------------------------------------------------------------------------#
        my ($ref,$hier) = @_;

        my @bkeys = $ref->base_keys();
        if(! @bkeys) { $ref->{'cpoint'} = -1;}
        foreach my $akey (@bkeys) {
                if($ref->{$akey}->{'cpoint'} != -1) {
                        $ref->{$akey}->{'cpoint'} += 1;
                }
        }
}

#------------------------------------------------------------------------------#
sub loop_check {
#------------------------------------------------------------------------------#
        my ($ref,$hier) = @_;

        my @bkeys = $ref->base_keys();
        if($ref->{'loop'} < $hier) { $ref->{'loop'} = $hier;}
        foreach my $akey ($ref->base_keys()) {
                $ref->{$akey}->loop_check($hier+1);
        }
}

#------------------------------------------------------------------------------#
sub level_calc {
#------------------------------------------------------------------------------#
        my ($ref,$level) = @_;

        if($ref->{'jtree_level'} > $level) {
                return;
        }
        $ref->{'jtree_level'} = $level;
        $level ++;

        foreach my $akey (keys %$ref) {
                if($akey !~ /^jtree/) {
                        print "$ref->{'jtree_name'}:\n";
                        print "        $ref->{$akey}->{'jtree_name'}:$level\n";
                        $ref->{$akey}->level_calc($level);
                }
        }
}

#------------------------------------------------------------------------------#
sub level_print {
#------------------------------------------------------------------------------#
        my ($ref,$rkey) = @_;

        foreach my $akey (keys %$ref) {
                if($akey !~ /^jtree/) {
                        print "$ref->{'jtree_name'}:$ref->{'jtree_level'}\n";
                }
        }
}

#------------------------------------------------------------------------------#
sub find_driver {
#------------------------------------------------------------------------------#
        my ($ref) = @_;

        my @data = ();
        foreach my $akey (sort keys %$ref) {
                if($akey =~ /^jtree_/) { next;}
                elsif(ref($ref->{$akey}) eq "JTREE") {
                        push(@data,$ref->{$akey}->find_driver());
                }
        }
        if(! @data) {
                @data = ($ref->{'jtree_name'});
        }

        return @data;
}

#------------------------------------------------------------------------------#
sub jprint {
#------------------------------------------------------------------------------#
        my ($ref,$tab,$hier) = @_;
        if(! $hier) { $hier = 1;}
        else { $hier ++;}
        my $ctab = "";
        for(my $i=1;$i<$hier;$i++) { $ctab .= $tab;}
        my $oline = "$ref = (\n";
        foreach my $key (sort keys %$ref) {
                $oline .= "$ctab$tab\{$key\}=>";
                my $alist = $ref->{$key};
                if( ref($alist) eq "JTREE" ) {
                        $oline .= $alist->jprint($tab,$hier);
                }
                else {
                        $oline .= "$alist(".ref($alist).")\n";
                }
        }
        $oline .= "$ctab)\n";
        $oline;
}

#------------------------------------------------------------------------------#
sub remove {
#------------------------------------------------------------------------------#
        my ($ref, @keys) = @_;
        my @data = %$ref;
        %$ref = ();
        for($i=0;$i<$#data;$i+=2) {
                my $flag = 0;
                foreach $akey (@keys) { if($data[$i] eq $akey) { $flag = 1;} }
                if(! $flag) { $ref->add($data[$i],$data[$i +1]);}
        }
}

#------------------------------------------------------------------------------#
sub DESTROY {
#------------------------------------------------------------------------------#
        #rint "Destroy the object at @_.\n";
}

#------------------------------------------------------------------------------#
1;
#------------------------------------------------------------------------------#