HTML::Menu::Hierarchical::ItemInfo - Used by HTML::Menu::Hierarchical.

 HTML::Menu::Hierarchical::ItemInfo - Used by HTML::Menu::Hierarchical.
 Provides information about the menu item being processed.

 Created by HTML::Menu::Hierarchical objects.

 Information holder/gatherer representing one menu item.

 Returns true if the current item has child items in the
 configuration.  False otherwise.

 Returns true if the current item is the selected one.

 Returns true if the current item is in the path from the root of
 the hierarchy to the selected item.

 Returns the ItemInfo object corresponding to the selected menu
 item.

 Returns the level in the hierarchy where the selected menu item
 is located.  Levels start at zero.

 Returns the maximum level in the hierarchy to currently be
 displayed.

 Returns true if the current menu item is open, i.e., the current
 item has child items and is also in the open path.  Return false
 otherwise.

 Returns true if the current menu item is the first one to be
 displayed.

 Returns true if the current menu item is the last to be
 displayed.

 Returns true if the current menu item is the first of its
 siblings to be displayed, false otherwise.

 Returns true if the current menu item is the last of its
 siblings to be displayed, false otherwise.

 Returns the value of the 'info' field for the current menu item
 in the navigation configuration.

 Instead of getting the 'info' hash and then accessing a field
 within it, you may call a method to get that field directly.
 This is implemented with AUTOLOAD, so if you do something like

    my $text = $info_obj->getText;
    my $image_src = $info_obj->getImageSrc;

        or

    my $text = $info_obj->getText;
    my $image_src = $info_obj->get_image_src;

 you will be given back the corresponding values in the 'info'
 hash.

 Returns the 'name' field for the current menu item in the
 navigation configuration.  This is used to determine which menu
 item has been selected.

 Returns the ItemInfo object corresponding to the next displayed
 menu item.

 Returns the ItemInfo object corrsponding to the previously
 displayed menu item.

 Returns the level in the menu hierarchy where the current menu
 item is located.  Levels start at zero.

 Returns the info object for the current item's parent.

 URL encodes the given string.  This does full url-encoding, so a
 space is %20, not a '+'.

 Takes a hash containing key/value pairs and returns a
 url-encoded query string appropriate for adding to the end of a
 url.  If a value is an array, it is assumed to be a multivalued
 input field and is added to the query string as such.

 If you want to encode the query stirng in the new style
 recommended by the W3C (use a semicolon as a separator in place
 of ampersand), pass a true value for the new_style_url parameter
 when creating the HTML::Menu::Hierarchical object.  This will
 become the default in a later release.

 Decodes the given url-encoded string.

 Decodes the url-encoded query string and returns a hash contain
 key/value pairs from the query string.  If a field appears more
 than once in the query string, it's value will be returned as a
 reference to an array of values.

 Takes the key/value pairs in $var_hash and tacks them onto the
 end of $url as a query string.

 Escapes the given text so that it is not interpreted as HTML.

 Unescape the escaped text.

 E.g., unescapeHtml($html) becomes unescape_html($html)

 hasChildrenDisplayed() - tell whether or not the current item's
                          children will be displayed

 Please send bug reports/feature requests to don@owensnet.com.

 Don Owens <don@owensnet.com>

 Copyright (c) 2003 Don Owens

 All rights reserved. This program is free software; you can
 redistribute it and/or modify it under the same terms as Perl
 itself.

 $Id: ItemInfo.pm,v 1.30 2005/06/16 15:03:00 don Exp $

# -*-perl-*-
# Creation date: 2003-01-05 21:34:34
# Authors: Don
# Change log:
# $Id: ItemInfo.pm,v 1.30 2005/06/16 15:03:00 don Exp $
#
# Copyright (c) 2003 Don Owens
#
# All rights reserved. This program is free software; you can
# redistribute it and/or modify it under the same terms as Perl
# itself.
#
# The underscore separated versions of the methods added for
# version v0_03 by request.

use strict;
use Carp;

{   package HTML::Menu::Hierarchical::ItemInfo;

    use vars qw($VERSION $AUTOLOAD);
    $VERSION = do { my @r=(q$Revision: 1.30 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r };
    
    sub new {
        my ($proto, $item, $selected_path, $key, $parent, $params) = @_;
        my $self = bless {}, ref($proto) || $proto;
        $self->setItem($item);
        $self->_setSelectedPath($selected_path);
        $self->setKey($key);
        $self->setParent($parent);
        $self->_setParams($params);
        return $self;
    }

    sub hasChildren {
        my ($self) = @_;
        return $self->getItem()->hasChildren;
    }
    *has_children = \&hasChildren;

    sub isSelected {
        my ($self) = @_;
        my $key = $self->getKey;
        if ($self->getItem()->getName eq $self->getKey) {
            return 1;
        }
        
        return undef;
    }
    *is_selected = \&isSelected;

    sub isInSelectedPath {
        my ($self) = @_;
        my $selected_path = $self->_getSelectedPath;
        my $my_item = $self->getItem;

        foreach my $item (@$selected_path) {
            return 1 if $item == $my_item;
        }
        return undef;
    }
    *is_in_selected_path = \&isInSelectedPath;

    sub getSelectedItem {
        my ($self) = @_;
        my $selected_path = $self->_getSelectedPath;
        my $last_index = $#$selected_path;
        return undef if $last_index < 0;
        return $self->new($$selected_path[$last_index], $selected_path, $self->getKey);
    }
    *get_selected_item = \&getSelectedItem;
    *getSelectedItemInfo = \&getSelectedItem;
    *get_selected_item_info = \&getSelectedItem;

    sub getSelectedLevel {
        my ($self) = @_;
        my $selected_path = $self->_getSelectedPath;
        return $#$selected_path;
    }
    *get_selected_level = \&getSelectedLevel;

    sub getMaxDisplayedLevel {
        my ($self) = @_;
        my $selected_path = $self->_getSelectedPath;
        my $max_level = $#$selected_path;
        return $max_level if $max_level < 0;
        if ($$selected_path[$max_level]->hasChildren) {
            $max_level++;
        }
        return $max_level;
    }
    *get_max_displayed_level = \&getMaxDisplayedLevel;

    sub getStandardCallbackParams {
        my ($self) = @_;
        my $params = $self->_getParam('std_callback_params');
        unless (ref($params) eq 'HASH') {
            $params = {};
        }
        return $params;
    }
    
    sub _checkOpenAllFields {
        my ($self) = @_;

        if (exists($$self{_is_open_all})) {
            return $$self{_is_open_all};
        }

        my ($is_set, $val) = $self->_checkOpenField('open_all', '_is_open_all');
        if ($is_set) {
            return ($is_set, $val);
        }
        my $parent = $self;
        while ($parent = $parent->getParent) {
            my ($is_set, $val) = $parent->_checkOpenField('open_all', '_is_open_all');
            if ($is_set) {
                $$self{_is_open_all} = $val;
                return ($is_set, $val);
            }
        }

        $$self{_is_open_all} = undef;

        return (undef, undef);
    }

    sub _checkOpenField {
        my ($self, $field, $attr) = @_;
        unless (defined($field)) {
            $field = 'open';
            $attr = '_is_open';
        }

        if (my $open = $self->getOtherField($field)) {
            # simple case first
            unless (ref($open)) {
                $$self{$attr} = 1;
                return (1, 1);
            }
        
            # now allow for a subroutine reference
            if (ref($open) eq 'CODE') {
                my $rv = &$open();
                $$self{$attr} = $rv;
                return (1, $rv);
            } elsif (ref($open) eq 'ARRAY') {
                my ($obj, $func, @args) = @$open;
                my $rv;
                if (defined($obj)) {
                    $rv = $obj->$func(@args);
                } else {
                    $rv = &$func(@args);
                }
                $$self{$attr} = $rv;
                return (1, $rv);
            }
        }                       # end 'open' field check

        return (undef, undef);
    }

    sub isOpen {
        my ($self) = @_;
        if (exists($$self{_is_open})) {
            return $$self{_is_open};
        }

        return 1 if $self->_hasSetOpenAll;

        my ($is_set, $val) = $self->_checkOpenField;
        return $val if $is_set;

        ($is_set, $val) = $self->_checkOpenAllFields;
        return $val if $is_set;
        
        my $this_item = $self->getItem;
        unless ($this_item->hasChildren) {
            $$self{_is_open} = undef;
            return undef;
        }
        
        my $selected_path = $self->_getSelectedPath;
        my $name = $this_item->getName;
        
        foreach my $item (@$selected_path) {
            if ($item->getName eq $name) {
                # print $item->getName . " eq $name\n";
                $$self{_is_open} = 1;
                return 1;
            }
        }

        $$self{_is_open} = undef;
        return undef;
    }
    *is_open = \&isOpen;

    # added for v0_02
    sub isFirstDisplayed {
        my ($self) = @_;
        my $item = $self->getPreviousItem;
        if ($item) {
            return undef;
        } else {
            return 1;
        }
    }
    *is_first_displayed = \&isFirstDisplayed;

    # added for v0_02
    sub isLastDisplayed {
        my ($self) = @_;
        my $item = $self->getNextItem;
        if ($item) {
            return undef;
        } else {
            return 1;
        }
    }
    *is_last_displayed = \&isLastDisplayed;

    sub isFirstSiblingDisplayed {
        my ($info_obj) = @_;
        my $self = $info_obj;
        
        my $my_level = $self->getLevel;
        my $item = $self;
        while (1) {
            $item = $self->getPreviousItem;
            return 1 unless $item;
            my $level = $item->getLevel;
            return undef if $level > $my_level;
            return undef if $level == $my_level;
            return 1 if $level < $my_level;
        }
        
        return undef;
    }
    *is_first_sibling_displayed = \&isFirstSiblingDisplayed;

    sub isLastSiblingDisplayed {
        my ($self) = @_;
        my $my_level = $self->getLevel;
        my $item = $self;

        while (1) {
            $item = $item->getNextItem;
            return 1 unless $item;
            my $level = $item->getLevel;
            return 1 if $level < $my_level;
            return undef if $level == $my_level;
        }
        
        return undef;
    }

    *is_last_sibling_displayed = \&isLastSiblingDisplayed;

    sub getInfo {
        my ($self) = @_;
        return $self->getItem()->getInfo;
    }
    *get_info = \&getInfo;

    sub _getOtherFields {
        my ($self) = @_;
        return $self->getItem()->getOtherFields;
    }

    # get field from configuration that is at the same level as
    # the name and children fields
    sub getOtherField {
        my ($self, $field) = @_;
        my $fields = $self->_getOtherFields;
        return $$fields{$field};
    }

    sub getName {
        my ($self) = @_;
        return $self->getItem()->getName;
    }
    *get_name = \&getName;

    #####################
    # getters and setters

    sub getNextItem {
        my ($self) = @_;
        return $$self{_next_item};
    }
    *get_next_item = \&getNextItem;

    sub setNextItem {
        my ($self, $item) = @_;
        $$self{_next_item} = $item;
    }

    sub getPreviousItem {
        my ($self) = @_;
        return $$self{_previous_item};
    }
    *get_previous_item = \&getPreviousItem;

    sub setPreviousItem {
        my ($self, $item) = @_;
        $$self{_previous_item} = $item;
    }

    sub getKey {
        my ($self) = @_;
        return $$self{_key};
    }
    
    sub setKey {
        my ($self, $key) = @_;
        $$self{_key} = $key;
    }

    sub getLevel {
        my ($self) = @_;
        return $$self{_level};
    }
    *get_level = \&getLevel;

    sub setLevel {
        my ($self, $level) = @_;
        $$self{_level} = $level;
    }

    sub _getSelectedPath {
        my ($self) = @_;
        return $$self{_selected_path};
    }

    sub _setSelectedPath {
        my ($self, $path) = @_;
        $$self{_selected_path} = $path;
    }
    
    sub getItem {
        my ($self) = @_;
        return $$self{_item};
    }
    
    sub setItem {
        my ($self, $item) = @_;
        $$self{_item} = $item;
    }

    sub getParent {
        my ($self) = @_;
        return $$self{_parent};
    }

    sub setParent {
        my ($self, $parent) = @_;
        $$self{_parent} = $parent;
    }

    # added for v0_07
    sub _getParams {
        my ($self) = @_;
        return $$self{_params} || {};
    }

    # added for v0_07
    sub _setParams {
        my ($self, $params) = @_;
        $$self{_params} = $params;
    }

    # added for v0_08
    sub _getParam {
        my ($self, $param) = @_;
        my $params = $self->_getParams;
        return $$params{$param};
    }

    # added for v0_07
    sub _getTopMenuObj {
        my ($self) = @_;
        my $params = $self->_getParams;
        my $obj = $$params{top_menu_obj};
        return $obj;
    }

    # added for v0_07
    sub _hasSetOpenAll {
        my ($self) = @_;
        my $top_menu_obj = $self->_getTopMenuObj;
        return undef unless $top_menu_obj;

        return $top_menu_obj->hasParamSetOpenAll;
    }

    ###########
    # utilities

    sub urlEncode {
        my ($self, $str) = @_;

        $str =~ s|([^A-Za-z0-9_])|sprintf("%%%02x", ord($1))|eg;

        return $str;
    }
    *url_encode = \&urlEncode;

    sub urlEncodeVars {
        my ($self, $hash) = @_;
        my $string;
        my $var;
        my $vars = [ keys %$hash ];
        my @pairs;

        foreach $var (@$vars) {
            my $value = $$hash{$var};
            if (ref($value) eq 'ARRAY') {
                my $name = $self->urlEncode($var);
                foreach my $val (@$value) {
                    push(@pairs, $name . "=" . $self->urlEncode($val));
                }
            } else {
                push(@pairs, $self->urlEncode($var) . "=" . $self->urlEncode($$hash{$var}));
            }
        }

        return join($self->_getUrlSeparator, @pairs);
    }
    *url_encode_vars = \&urlEncodeVars;

    sub urlDecode {
        my ($self, $str) = @_;

        $str =~ tr/+/ /;
        $str =~ s|%([A-Fa-f0-9]{2})|chr(hex($1))|eg;

        return $str;
    }
    *url_decode = \&urlDecode;

    sub urlDecodeVars {
        my ($self, $query_string) = @_;
        my $pair;
        my $vars = {};

        foreach $pair (split /[;&]/, $query_string) {
            my ($name, $field) = map { $self->urlDecode($_) } split(/=/, $pair, 2);

            if (exists($$vars{$name})) {
                my $val = $$vars{$name};
                unless (ref($val) eq 'ARRAY') {
                    $val = [ $val ];
                    $$vars{$name} = $val;
                }
                push @$val, $field;
            } else {
                $$vars{$name} = $field;
            }
        }

        return wantarray ? %$vars : $vars;
    }
    *url_decode_vars = \&urlDecodeVars;

    sub _getUrlSeparator {
        my ($self) = @_;
        if ($self->_getParam('old_style_url')) {
            return '&';
        } elsif ($self->_getParam('new_style_url')) {
            return ';';
        } else {
            return '&';
        }
    }

    sub addArgsToUrl {
        my ($self, $url, $args) = @_;
        
        if ($url =~ /\?/) {
            $url .= $self->_getUrlSeparator unless $url =~ /\?$/;
        } else {
            $url .= '?';
        }

        my $arg_str;
        if (ref($args) eq 'HASH') {
            $arg_str = $self->urlEncodeVars($args);
        } else {
            $arg_str = $args;
        }

        $url .= $arg_str;
        return $url;
    }
    *add_args_to_url = \&addArgsToUrl;

    sub escapeHtml {
        my ($self, $text) = @_;
        
        $text =~ s/\&/\&/g;
        $text =~ s/</\&lt;/g;
        $text =~ s/>/\&gt;/g;
        $text =~ s/\"/\&quot;/g;
        $text =~ s/\$/\&dol;/g;

        return $text;
    }
    *escape_html = \&escapeHtml;

    
    sub unescapeHtml {
        my ($self, $text) = @_;
        $text =~ s/\&/\&/g;
        $text =~ s/\&lt;/</g;
        $text =~ s/\&gt;/>/g;
        $text =~ s/\&quot;/\"/g;
        $text =~ s/\&dol;/\$/g;

        return $text;
    }
    *unescape_html = \&unescapeHtml;

    sub AUTOLOAD {
        my $self = shift;
        
        my $method = $AUTOLOAD;
        $method =~ s/^.*::([^:]+)$/$1/;

        if ($method =~ /^get(.+)$/) {
            my $str = $1;
            if ($str =~ /_/) {
                $str =~ s/^_//;
                return $self->getInfo()->{$str};
            } elsif ($str =~ /^[A-Z]/) {
                $str = lcfirst($str);
                $str =~ s/([A-Z])/_\L$1/g;

                my $info = $self->getInfo;
                return $info->{$str} if $info;
                return undef;
            } else {
                return "invalid name";
            }
        }

        return "undefined method $method";
    }

}

1;

__END__