view release on metacpan or  search on metacpan

lib/App/Widget/HierSelector.pm  view on Meta::CPAN

######################################################################
## $Id: HierSelector.pm 10070 2007-10-10 18:55:12Z spadkins $
######################################################################

package App::Widget::HierSelector;
$VERSION = (q$Revision: 10070 $ =~ /(\d[\d\.]*)/)[0];  # VERSION numbers generated by svn

use App;
use App::Widget;
@ISA = ( "App::Widget" );

use strict;

=head1 NAME

App::Widget::HierSelector - A generic hierarchical view

=head1 SYNOPSIS

   use App::Widget::HierSelector;

   $name = "tree";
   $w = App::Widget::HierSelector->new($name);
   print $w->html();

=cut

######################################################################
# CONSTANTS
######################################################################

######################################################################
# ATTRIBUTES
######################################################################
# {node}{number}{type}       # whether open or closed
# {node}{number}{open}       # 1=open 0=closed
# {node}{number}{value}      #
# {node}{number}{label}      #
# {node}{number}{icon}       # icon to use (default, closed)
# {node}{number}{openicon}   # icon to use when open (optional)
# {node}{number}{hovericon}  # icon to use when cursor over icon

# INPUTS FROM THE ENVIRONMENT

=head1 DESCRIPTION

This class implements a generic hierarchical view such as is useful
for a TreeSelector, a Menu, a ToolbarSet, or an IconPaneSelector.
The main function of a HierSelector is to display a hierarchical set of
data and allow the user to generate events based on that view.

=cut

######################################################################
# INITIALIZATION
######################################################################

# uncomment this when I need to do more than just call SUPER::_init()
sub _init {
    &App::sub_entry if ($App::trace);
    my $self = shift;
    $self->SUPER::_init(@_);
    &App::sub_exit() if ($App::trace);
}

######################################################################
# EVENTS
######################################################################

# Usage: $widget->handle_event($wname, $event, @args);
sub handle_event {
    &App::sub_entry if ($App::trace);
    my ($self, $wname, $event, @args) = @_;
    my ($nodenumber, $x, $y);

    my $node = $self->node_list(1);

    if ($event eq "open") {
        ($nodenumber, $x, $y) = @args;
        $node->{$nodenumber}{open} = 1;
    }
    elsif ($event eq "open_exclusively") {
        ($nodenumber, $x, $y) = @args;
        $self->open_exclusively($nodenumber);
    }
    elsif ($event eq "close") {
        ($nodenumber, $x, $y) = @args;
        $node->{$nodenumber}{open} = 0;
    }
    elsif ($event eq "select") {
        ($nodenumber, $x, $y) = @args;
        $self->set("selected", $nodenumber);  # save node number
        # intentionally bubble "select" event to the container
        if ($wname =~ /^(.*)-([^.]+)$/) {
            my $parent = $1;
            my $result = $self->{context}->widget($parent)->handle_event($wname, $event, @args);
            return $result;
        }
    }
    else {
        return $self->SUPER::handle_event($wname, $event, @args);
    }
    &App::sub_exit() if ($App::trace);
    return 1;
}

sub select_first {
    &App::sub_entry if ($App::trace);
    my $self = shift;
    my $node = $self->node_list();
    
    my ($nodebase, $nodeidx, $nodenumber, $nodenumberfound, $nodelevel);
    my (@nextnodebase, @nextnodeidx, @nextnodelevel);

    @nextnodebase  = ("");   # the next nodenumber to check is "$nodebase$nodeidx" (nodenumber = "1" is first)
    @nextnodeidx   = (1);    # check nodenumber "1" next
    @nextnodelevel = (1);    # index into the resulting table that the folder icon will go

    my ($auth_key, $auth_name, $authorized);
    my $context = $self->{context};
    my $auth = $context->authorization();

    $nodenumberfound = "";
    while ($#nextnodebase > -1) {
        $nodebase  = pop(@nextnodebase);   # get info about next node to check
        $nodeidx   = pop(@nextnodeidx);
        $nodelevel = pop(@nextnodelevel);
        $nodenumber = "$nodebase$nodeidx"; # create its node number

        if (defined $node->{$nodenumber}) {      # if the node exists...

            $auth_name = $node->{$nodenumber}{auth_name};
            if (!$auth_name) {
                $authorized = 1;
            }
            else {
                if ($auth_name =~ m!^/!) {
                    $auth_key = $auth_name;
                }
                else {
                    $auth_key = "/App/SessionObject/$self->{name}/$auth_name";
                }
                $authorized = $auth->is_authorized($auth_key);
            }

            if ($nodelevel > 1 && $authorized) {  # we have found the first node below the uppermost level
                $nodenumberfound = $nodenumber;
                last;
            }

            push(@nextnodebase,    $nodebase);   #   let's search for the node's brother (same depth, next idx)
            push(@nextnodeidx,     $nodeidx+1);  #   (next idx)
            push(@nextnodelevel,   $nodelevel);  #   (same level)

            push(@nextnodebase,  "${nodenumber}."); #   let's search for the node's children (1 deeper, idx 1)
            push(@nextnodeidx,   1);                #   (idx is 1)
            push(@nextnodelevel, $nodelevel+1);     #   (1 deeper)
        }
    }
    if ($nodenumberfound) {
        $self->set("selected", $nodenumberfound);