1 # BEGIN BPS TAGGED BLOCK {{{
5 # This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
6 # <sales@bestpractical.com>
8 # (Except where explicitly superseded by other copyright notices)
13 # This work is made available to you under the terms of Version 2 of
14 # the GNU General Public License. A copy of that license should have
15 # been provided with this software, but in any event can be snarfed
18 # This work is distributed in the hope that it will be useful, but
19 # WITHOUT ANY WARRANTY; without even the implied warranty of
20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
21 # General Public License for more details.
23 # You should have received a copy of the GNU General Public License
24 # along with this program; if not, write to the Free Software
25 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
26 # 02110-1301 or visit their web page on the internet at
27 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
30 # CONTRIBUTION SUBMISSION POLICY:
32 # (The following paragraph is not intended to limit the rights granted
33 # to you to modify and distribute this software under the terms of
34 # the GNU General Public License and is only of importance to you if
35 # you choose to contribute your changes and enhancements to the
36 # community by submitting them to Best Practical Solutions, LLC.)
38 # By intentionally submitting any modifications, corrections or
39 # derivatives to this work, or any other work intended for use with
40 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
41 # you are the copyright holder for those contributions and you grant
42 # Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
43 # royalty-free, perpetual, license to use, copy, create derivative
44 # works based on those contributions, and sublicense and distribute
45 # those contributions and any derivatives thereof.
47 # END BPS TAGGED BLOCK }}}
49 package RT::Interface::Web::Menu;
55 use base qw/Class::Accessor::Fast/;
57 use Scalar::Util qw(weaken);
59 __PACKAGE__->mk_accessors(qw(
60 key title description raw_html escape_title sort_order target class
65 RT::Interface::Web::Menu - Handle the API for menu navigation
71 Creates a new L<RT::Interface::Web::Menu> object. Possible keys in the
72 I<PARAMHASH> are L</parent>, L</title>, L</description>, L</path>,
73 L</raw_html>, L<escape_title>, L</sort_order>, L</class>, L</target> and
74 L</active>. See the subroutines with the respective name below for
81 my $args = ref($_[0]) eq 'HASH' ? shift @_ : {@_};
83 my $parent = delete $args->{'parent'};
84 $args->{sort_order} ||= 0;
86 # Class::Accessor only wants a hashref;
87 my $self = $package->SUPER::new( $args );
89 # make sure our reference is weak
90 $self->parent($parent) if defined $parent;
98 Sets or returns the string that the menu item will be displayed as.
100 =head2 escape_title [BOOLEAN]
102 Sets or returns whether or not to HTML escape the title before output.
106 Gets or sets the parent L<RT::Interface::Web::Menu> of this item; this defaults
107 to null. This ensures that the reference is weakened.
109 =head2 raw_html [STRING]
111 Sets the content of this menu item to a raw blob of HTML. When building the
112 menu, rather than constructing a link, we will return this raw content. No
120 $self->{parent} = shift;
121 weaken $self->{parent};
124 return $self->{parent};
128 =head2 sort_order [NUMBER]
130 Gets or sets the sort order of the item, as it will be displayed under
131 the parent. This defaults to adding onto the end.
133 =head2 target [STRING]
135 Get or set the frame or pseudo-target for this link. something like L<_blank>
137 =head2 class [STRING]
139 Gets or sets the CSS class the menu item should have in addition to the default
140 classes. This is only used if L</raw_html> isn't specified.
144 Gets or sets the URL that the menu's link goes to. If the link
145 provided is not absolute (does not start with a "/"), then is is
146 treated as relative to it's parent's path, and made absolute.
153 $self->{path} = shift;
154 $self->{path} = URI->new_abs($self->{path}, $self->parent->path . "/")->as_string
155 if defined $self->{path} and $self->parent and $self->parent->path;
156 $self->{path} =~ s!///!/! if $self->{path};
158 return $self->{path};
161 =head2 active [BOOLEAN]
163 Gets or sets if the menu item is marked as active. Setting this
164 cascades to all of the parents of the menu item.
166 This is currently B<unused>.
173 $self->{active} = shift;
174 $self->parent->active($self->{active}) if defined $self->parent;
176 return $self->{active};
179 =head2 child KEY [, PARAMHASH]
181 If only a I<KEY> is provided, returns the child with that I<KEY>.
183 Otherwise, creates or overwrites the child with that key, passing the
184 I<PARAMHASH> to L<RT::Interface::Web::Menu/new>. Additionally, the paramhash's
185 L</title> defaults to the I<KEY>, and the L</sort_order> defaults to the
186 pre-existing child's sort order (if a C<KEY> is being over-written) or
187 the end of the list, if it is a new C<KEY>.
189 If the paramhash contains a key called C<menu>, that will be used instead
190 of creating a new RT::Interface::Web::Menu.
198 my $proto = ref $self || $self;
200 if ( my %args = @_ ) {
202 # Clear children ordering cache
203 delete $self->{children_list};
206 if ( $child = $args{menu} ) {
207 $child->parent($self);
209 $child = $proto->new(
218 $self->{children}{$key} = $child;
220 $child->sort_order( $args{sort_order} || (scalar values %{ $self->{children} }) )
221 unless ($child->sort_order());
223 # URL is relative to parents, and cached, so set it up now
224 $child->path( $child->{path} );
227 my $path = $child->path;
230 if ( defined $path and length $path ) {
231 my $base_path = $HTML::Mason::Commands::r->path_info;
232 my $query = $HTML::Mason::Commands::m->cgi_object->query_string;
233 $base_path .= "?$query" if defined $query and length $query;
235 $base_path =~ s/index\.html$//;
236 $base_path =~ s/\/+$//;
237 $path =~ s/index\.html$//;
240 if ( $path eq $base_path ) {
241 $self->{children}{$key}->active(1);
246 return $self->{children}{$key};
251 Returns the first active child node, or C<undef> is there is none.
257 foreach my $kid ($self->children) {
258 return $kid if $kid->active;
266 Removes the child with the provided I<KEY>.
273 delete $self->{children_list};
274 delete $self->{children}{$key};
280 Returns true if there are any children on this menu
286 if (@{ $self->children}) {
296 Returns the children of this menu item in sorted order; as an array in
297 array context, or as an array reference in scalar context.
304 if ($self->{children_list}) {
305 @kids = @{$self->{children_list}};
307 @kids = values %{$self->{children} || {}};
308 @kids = sort {$a->{sort_order} <=> $b->{sort_order}} @kids;
309 $self->{children_list} = \@kids;
311 return wantarray ? @kids : \@kids;