# $Id$
package OAR::Schedulers::ResourceTree;

use warnings;
use strict;
#use Data::Dumper;
use Storable qw(dclone);
#use Time::HiRes qw(gettimeofday);

###############################################################################
#                       RESOURCE TREE MANAGEMENT                              #
###############################################################################

# Prototypes
sub new();
sub destroy($);
sub clone($);
sub add_child($$$$);
sub get_children_list($);
sub is_node_a_leaf($);
sub get_father($);
sub get_current_resource_name($);
sub get_current_resource_value($);
sub get_current_children_number($);
sub get_current_level($);
sub get_max_available_children($);
sub set_needed_children_number($$);
sub get_needed_children_number($);
sub delete_subtree($);
sub get_previous_brother($);
sub get_next_brother($);
sub get_initial_child($);
sub get_last_child($);


###############################################################################

sub get_tree_leafs($);
sub get_tree_leafs_vec($);
sub delete_tree_nodes_with_not_enough_resources($);
sub delete_unnecessary_subtrees($);
sub delete_tree_nodes_with_not_enough_resources_and_unnecessary_subtrees($$);

###############################################################################

# Create a tree
# arg : number of needed children
# return the ref of the created tree
sub new(){
    my $tree_ref;
    $tree_ref->[0] = undef ;                    # father ref
    $tree_ref->[1] = undef ;                    # ref of a hashtable with all initial children
    $tree_ref->[2] = undef ;                    # name of the resource
    $tree_ref->[3] = undef ;                    # value of this resource
    $tree_ref->[4] = 0 ;                        # level indicator
    $tree_ref->[5] = 0 ;                        # needed children number :
                                                #   -1 means ALL (Alive + Absent + Suspected resources)
                                                #   -2 means BEST (Alive resources at the time)
    $tree_ref->[6] = 0 ;                        # maximum available children
    $tree_ref->[7] = undef ;                    # previous brother ref
    $tree_ref->[8] = undef ;                    # next brother ref
    $tree_ref->[9] = undef ;                    # first child ref
    $tree_ref->[10] = 0 ;                       # current children number
    $tree_ref->[11] = undef ;                   # last child ref
    $tree_ref->[12] = [] ;                      # array with all tree node refs (only on the first tree node)

    return($tree_ref);
}

# Destroy data structure and tell Perl that the corresponding memory can be
# reused
# arg : ROOT tree ref
sub destroy($){
    my $tree_ref = shift;

    if (defined($tree_ref->[12])){
        foreach my $n (@{$tree_ref->[12]}){
            undef(@{$n});
            undef($n);
        }
        undef(@{$tree_ref});
        undef($tree_ref);
    }
}

# clone the tree
# arg : tree ref
# return a copy of the tree ref
sub clone($){
  my $tree_ref = shift;
  return(dclone($tree_ref));
}


# return 1 if node is a leaf (no child)
# otherwise retuurn 0
sub is_node_a_leaf($){
    my $tree_ref = shift;

    if ($tree_ref and $tree_ref->[9]){
        return(0);
    }else{
        return(1);
    }
}

# add a child to the given tree ref (if child resource name is undef it seems
# that this child is a leaf of the tree)
# arg : tree ref, resource name, resource value, tree root ref
# return the ref of the child
sub add_child($$$$){
    my $tree_ref = shift;
    my $resource_name = shift;
    my $resource_value = shift;
    my $tree_root_ref = shift;   # First node of the tree

    my $tmp_ref;
    if (!defined($tree_ref->[1]->{$resource_value})){
        # Create a new tree node
        $tmp_ref = [ $tree_ref, undef, $resource_name, $resource_value, $tree_ref->[4] + 1, 0, 0, undef, undef, undef, 0, undef ];
        push(@{$tree_root_ref->[12]}, $tmp_ref);
        
        $tree_ref->[1]->{$resource_value} = $tmp_ref;
        $tree_ref->[6] += 1;
        $tree_ref->[10] += 1;

        # Add new brother
        if ($tree_ref->[9]){
            $tmp_ref->[8] = $tree_ref->[9];
            $tree_ref->[9]->[7] = $tmp_ref;
        }
        $tree_ref->[9] = $tmp_ref;
        # Init last child
        if (!$tree_ref->[11]){
            $tree_ref->[11] = $tmp_ref;
        }
    }else{
        $tmp_ref = $tree_ref->[1]->{$resource_value};
    }
    
    return($tmp_ref);
}

# Store information about the number of needed children
sub set_needed_children_number($$){
    my $tree_ref = shift;
    my $needed_children_number = shift;

    $tree_ref->[5] = $needed_children_number;
}


# Get previous brother on the same level for the same father
sub get_previous_brother($){
    my $tree_ref = shift;

    if (!$tree_ref){
        return(undef);
    }else{
        return($tree_ref->[7]);
    }
}


# Get next brother on the same level for the same father
sub get_next_brother($){
    my $tree_ref = shift;

    if (! $tree_ref){
        return(undef);
    }else{
        return($tree_ref->[8]);
    }
}


# Get initial child ref
sub get_initial_child($){
    my $tree_ref = shift;

    if (! $tree_ref){
        return(undef);
    }else{
        return($tree_ref->[9]);
    }
}


# Get last child ref
sub get_last_child($){
    my $tree_ref = shift;

    if (! $tree_ref){
        return(undef);
    }else{
        return($tree_ref->[11]);
    }
}


# Get the ref of the father tree
# arg : tree ref
# return a tree ref
sub get_father($){
    my $tree_ref = shift;

    if (!$tree_ref || !$tree_ref->[0]){
        return(undef);
    }else{
        return($tree_ref->[0]);
    }
}


# Get the current resource name
# arg : tree ref
# return the resource name
sub get_current_resource_name($){
    my $tree_ref = shift;

    if (! $tree_ref){
        return(undef);
    }else{
        return($tree_ref->[2]);
    }
}


# Get the current resource value
# arg : tree ref
# return the resource value
sub get_current_resource_value($){
    my $tree_ref = shift;

    if (! $tree_ref){
        return(undef);
    }else{
        return($tree_ref->[3]);
    }
}


# Get the current children number
# arg : tree ref
# return the resource value
sub get_current_children_number($){
    my $tree_ref = shift;

    if ($tree_ref){
        return($tree_ref->[10]);
    }else{
        return(undef);
    }
}


# Get the current level indicator
# arg : tree ref
# return the level indicator
sub get_current_level($){
    my $tree_ref = shift;

    if ($tree_ref){
        return($tree_ref->[4]);
    }else{
        return(0);
    }
}


# Get the maximum available number of children
# (just after the creation of the tree)
# arg : tree ref
# return an integer >= 0
sub get_max_available_children($){
    my $tree_ref = shift;
    
    if ($tree_ref){
        return($tree_ref->[6]);
    }else{
        return(0);
    }
}


# Get the number of needed children
# arg : tree ref
# return the number of needed children
sub get_needed_children_number($){
    my $tree_ref = shift;

    if ($tree_ref){
        return($tree_ref->[5]);
    }else{
        return(0);
    }
}


# Delete a subtree
# arg : tree ref to delete
# return father tree ref
sub delete_subtree($){
    my $tree_ref = shift;
    
    return(undef) if (! $tree_ref);

    my $father_ref = $tree_ref->[0];

    my $prev_brother = $tree_ref->[7];
    my $next_brother = $tree_ref->[8];

    if (! $prev_brother){
        if ($father_ref){
            $father_ref->[9] = $next_brother;   # update father first child
        }
    }else{
        $prev_brother->[8] = $next_brother;     # update next brother
    }

    if (! $next_brother){
        if ($father_ref){
            $father_ref->[11] = $prev_brother;  # update father last child
        }
    }else{
        $next_brother->[7] = $prev_brother;     # update previous brother
    }
    
    if ($father_ref and $father_ref->[1]){
        $father_ref->[10] -= 1;
        return($father_ref);
    }else{
        return(undef);
    }
}

###############################################################################

# delete_tree_nodes_with_not_enough_resources
# Delete subtrees that do not fit wanted resources
# args: tree ref
# side effect : modify tree data structure
sub delete_tree_nodes_with_not_enough_resources($){
    my $tree_ref = shift;

    #print("START delete_tree_nodes_with_not_enough_resources\n");
    # Search if there are enough values for each resource
    # Tremaux algorithm (Deep first)
    my $current_node = $tree_ref;
    do{
        if (defined(get_initial_child($current_node))){
            # Go to child
            $current_node = get_initial_child($current_node);
            #print("Go to CHILD =".get_current_resource_value($current_node)."\n");
        }else{
            # Treate leaf
            while(defined($current_node) and (!defined(get_next_brother($current_node)))){
                # Step up
                #print("Go to FATHER : ".get_current_resource_value($current_node)."\n") if (defined(get_current_resource_value($current_node)));
                if ((get_needed_children_number($current_node) > get_current_children_number($current_node))
                    or ((get_needed_children_number($current_node) == -1)                # ALL
                        and (get_max_available_children($current_node) > get_current_children_number($current_node)))
                    or ((get_needed_children_number($current_node) == -2)                # BEST
                        and (get_current_children_number($current_node) <= 0))
                ){
                    # we want to delete the root
                    return(undef) if ($tree_ref == $current_node);
                    #print("DELETE 1".get_current_resource_value($current_node)."\n");
                    # Delete sub tree that does not fit with wanted resources 
                    $current_node = delete_subtree($current_node);
                }else{
                    $current_node = get_father($current_node);
                }
            }
            if (defined(get_next_brother($current_node))){
                # Treate brother
                if ((get_needed_children_number($current_node) > get_current_children_number($current_node))
                    or ((get_needed_children_number($current_node) == -1)                # ALL
                        and (get_max_available_children($current_node) > get_current_children_number($current_node)))
                    or ((get_needed_children_number($current_node) == -2)                # BEST
                        and (get_current_children_number($current_node) <= 0))
                ){
                    #print("DELETE 2".get_current_resource_value($current_node)."\n");
                    # Delete sub tree that does not fit with wanted resources 
                    delete_subtree($current_node);
                }
                $current_node = get_next_brother($current_node);
                #print("Go to BROTHER : ".get_current_resource_value($current_node)."\n");
            }
        }
    }while(defined($current_node));

    if (!defined(get_initial_child($tree_ref))){
        return(undef);
    }else{
        return($tree_ref);
    }
}


# get_tree_leafs
# return a list of tree leafs
# arg: tree ref
sub get_tree_leafs($){
    my $tree = shift;

    my @result;
    return(@result) if (!defined($tree));
    
    # Search leafs
    # Tremaux algorithm (Deep first)
    my $current_node = $tree;
    do{
        if (defined(get_initial_child($current_node))){
            # Go to child
            $current_node = get_initial_child($current_node);
            #print("Go to CHILD =".get_current_resource_value($current_node)."\n");
        }else{
            # Treate leaf
            if (is_node_a_leaf($current_node) == 1){
                #push(@result, $node_name_pile[0]);
                push(@result, $current_node);
                #print("Leaf: ".get_current_resource_name($current_node)." = ".get_current_resource_value($current_node)."\n");
            }
            # Look at brothers
            while(defined($current_node) and (!defined(get_next_brother($current_node)))){
                # Step up
                $current_node = get_father($current_node);
                #print("Go to FATHER : ".get_current_resource_value($current_node)."\n") if (defined(get_current_resource_value($current_node)));
            }
            if (defined(get_next_brother($current_node))){
                # Treate brother
                $current_node = get_next_brother($current_node);
                #print("Go to BROTHER : ".get_current_resource_value($current_node)."\n");
            }
        }
    }while(defined($current_node));

    return(@result);
}

# get_tree_leafs_vec
# return a binary vector with the leaf resource_id AND a hashref with resource_id => tree_ref
# arg: root tree ref
sub get_tree_leafs_vec($){
    my $tree = shift;

    my $result_leafs_vec = '';
    my %result_leafs_hash = ();
    return($result_leafs_vec, \%result_leafs_hash) if (!$tree);
    
    # Search leafs
    # Tremaux algorithm (Deep first)
    my $current_node = $tree;
    do{
        if (get_initial_child($current_node)){
            # Go to child
            $current_node = get_initial_child($current_node);
            #print("Go to CHILD =".get_current_resource_value($current_node)."\n");
        }else{
            # Treate leaf
            if (is_node_a_leaf($current_node) == 1){
                vec($result_leafs_vec, get_current_resource_value($current_node), 1) = 1;
                $result_leafs_hash{get_current_resource_value($current_node)} = $current_node;
                #print("Leaf: ".get_current_resource_name($current_node)." = ".get_current_resource_value($current_node)."\n");
            }
            # Look at brothers
            while($current_node and (!get_next_brother($current_node))){
                # Step up
                $current_node = get_father($current_node);
                #print("Go to FATHER : ".get_current_resource_value($current_node)."\n") if (defined(get_current_resource_value($current_node)));
            }
            if (get_next_brother($current_node)){
                # Treate brother
                $current_node = get_next_brother($current_node);
                #print("Go to BROTHER : ".get_current_resource_value($current_node)."\n");
            }
        }
    }while($current_node);

    return($result_leafs_vec, \%result_leafs_hash);
}

# delete_unnecessary_subtrees
# Delete subtrees that are not necessary (watch needed_children_number)
# args: tree ref
# side effect : modify tree data structure
sub delete_unnecessary_subtrees($){
    my $tree_ref = shift;

    return($tree_ref) if (!defined($tree_ref));

    # Search if there are enough values for each resource
    # Tremaux algorithm (Deep first)
    my $current_node = $tree_ref;
    do{
        if ((get_needed_children_number($current_node) >= 0) and (get_needed_children_number($current_node) < get_current_children_number($current_node))){
            # Delete extra sub tree
            delete_subtree(get_initial_child($current_node));
        }else{
            if (defined(get_initial_child($current_node))){
                # Go to child
                $current_node = get_initial_child($current_node);
                #print("Go to CHILD =".get_current_resource_value($current_node)."\n");
            }else{
                # Look at brothers
                while(defined($current_node) and (!defined(get_next_brother($current_node)))){
                    # Step up
                    $current_node = get_father($current_node);
                    #print("Go to FATHER : ".get_current_resource_value($current_node)."\n") if (defined(get_current_resource_value($current_node)));
                }
                if (defined(get_next_brother($current_node))){
                    # Treate brother
                    $current_node = get_next_brother($current_node);
                    #print("Go to BROTHER : ".get_current_resource_value($current_node)."\n");
                }
            }
        }
    }while(defined($current_node));

    return($tree_ref);
}

# delete_tree_nodes_with_not_enough_resources_and_unnecessary_subtrees
# Delete subtrees that do not fit wanted resources and unnecessary one
# args: tree ref, bit vector with authorized leafs (resource_id)
# side effect : modify tree data structure
sub delete_tree_nodes_with_not_enough_resources_and_unnecessary_subtrees($$){
    my $tree_ref = shift;
    my $authorized_leafs_vec = shift;   # if undef then all resources are authorized

#    print("START delete_tree_nodes_with_not_enough_resources\n");

    # Record the current number of children that can be taken
    my %nb_children_validated;
    # Search if there are enough values for each resource
    # Tremaux algorithm (Deep first)
    my $current_node = $tree_ref;
    do{
        if (get_last_child($current_node)){
            # Go to child
            $nb_children_validated{$current_node} = 0;
            $current_node = get_last_child($current_node);
#            print("Go to CHILD : ".get_current_resource_name($current_node)."=".get_current_resource_value($current_node)."\n");
        }else{
            # Treate leaf
            if (defined($authorized_leafs_vec)
                and (is_node_a_leaf($current_node) == 1)
                and ($tree_ref != $current_node)
                and (get_current_resource_name($current_node) eq "resource_id")
                and (!vec($authorized_leafs_vec, get_current_resource_value($current_node), 1))
               ){
#                    print("DELETE LEAF : ".get_current_resource_name($current_node)."=".get_current_resource_value($current_node)."\n");
                    # This leaf is not available
                    my $tmp_prev = get_previous_brother($current_node);
                    $current_node = delete_subtree($current_node);
                    if ($tmp_prev){
                        $current_node = $tmp_prev;
                    }
            }else{
                while($current_node and (! get_previous_brother($current_node))){
                    if ((get_needed_children_number($current_node) > get_current_children_number($current_node))
                        or ((get_needed_children_number($current_node) == -1)                # ALL
                            and (get_max_available_children($current_node) > get_current_children_number($current_node)))
                        or ((get_needed_children_number($current_node) == -2)                # BEST
                            and (get_current_children_number($current_node) <= 0))
                        or (($tree_ref != $current_node)
                            and (get_needed_children_number(get_father($current_node)) > 0)
                            and ($nb_children_validated{get_father($current_node)} >= get_needed_children_number(get_father($current_node))))
                       ){
                        # we want to delete the root
                        return(undef) if ($tree_ref == $current_node);
#                       print("DELETE 2 : ".get_current_resource_name($current_node)."=".get_current_resource_value($current_node)."\n");
                        # Delete sub tree that does not fit with wanted resources 
                        $current_node = delete_subtree($current_node);
                    }else{
                        # Step up
                        $current_node = get_father($current_node);
                        $nb_children_validated{$current_node}++ if ($current_node);
#                       print("Go to FATHER : ".get_current_resource_name($current_node)."=".get_current_resource_value($current_node)." ($nb_children_validated{$current_node}/".get_needed_children_number($current_node).")\n") if (defined(get_current_resource_value($current_node)));
                    }
                }
    
                if ($current_node 
                    and ($tree_ref != $current_node)
                   ){
                    my $tmp_father = get_father($current_node);
                    if ((get_needed_children_number($tmp_father) > 0)
                        and ($nb_children_validated{$tmp_father} >= get_needed_children_number($tmp_father))
                       ){
                        # We have enough nodes at this stage
                        $current_node->[7] = undef;  # purge the rest of brothers
                        #$tmp_father->[10] = $nb_children_validated{$tmp_father} + 1;
#                       print("PURGE BROTHERS : ".get_current_resource_name($current_node)."=".get_current_resource_value($current_node)."($tmp_father->[10])\n");
                    }
                }
    
                if (get_previous_brother($current_node)){
                    # Treate brother
                    if ((get_needed_children_number($current_node) > get_current_children_number($current_node))
                        or ((get_needed_children_number($current_node) == -1)                # ALL
                            and (get_max_available_children($current_node) > get_current_children_number($current_node)))
                        or ((get_needed_children_number($current_node) == -2)                # BEST
                            and (get_current_children_number($current_node) <= 0))
                       ){
#                       print("DELETE 3 : ".get_current_resource_name($current_node)."=".get_current_resource_value($current_node)."\n");
                        # Delete sub tree that does not fit with wanted resources 
                        delete_subtree($current_node);
                    }elsif ($tree_ref != $current_node){
                        $nb_children_validated{get_father($current_node)}++;
                    }
                    $current_node = get_previous_brother($current_node) ;
                    $nb_children_validated{$current_node} = 0;
#                   print("Go to BROTHER : ".get_current_resource_name($current_node)."=".get_current_resource_value($current_node)."\n");
                }
            }
        }
    }while($current_node);
#    print("STOP delete_tree_nodes_with_not_enough_resources\n");

    if (! get_initial_child($tree_ref)){
        return(undef);
    }else{
        return($tree_ref);
    }
}

return 1;
