Upgrade to 4.2.2
[usit-rt.git] / lib / RT / Interface / Web / Menu.pm
CommitLineData
84fb5b46
MKG
1# BEGIN BPS TAGGED BLOCK {{{
2#
3# COPYRIGHT:
4#
320f0092 5# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
84fb5b46
MKG
6# <sales@bestpractical.com>
7#
8# (Except where explicitly superseded by other copyright notices)
9#
10#
11# LICENSE:
12#
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
16# from www.gnu.org.
17#
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.
22#
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.
28#
29#
30# CONTRIBUTION SUBMISSION POLICY:
31#
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.)
37#
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.
46#
47# END BPS TAGGED BLOCK }}}
48
49package RT::Interface::Web::Menu;
50
51use strict;
52use warnings;
53
54
55use base qw/Class::Accessor::Fast/;
56use URI;
57use Scalar::Util qw(weaken);
58
59__PACKAGE__->mk_accessors(qw(
af59614d 60 key title description raw_html escape_title sort_order target class attributes
84fb5b46
MKG
61));
62
63=head1 NAME
64
65RT::Interface::Web::Menu - Handle the API for menu navigation
66
67=head1 METHODS
68
69=head2 new PARAMHASH
70
71Creates a new L<RT::Interface::Web::Menu> object. Possible keys in the
72I<PARAMHASH> are L</parent>, L</title>, L</description>, L</path>,
af59614d
MKG
73L</raw_html>, L<escape_title>, L</sort_order>, L</class>, L</target>,
74L<attributes>, and L</active>. See the subroutines with the respective name
75below for each option's use.
84fb5b46
MKG
76
77=cut
78
79sub new {
80 my $package = shift;
81 my $args = ref($_[0]) eq 'HASH' ? shift @_ : {@_};
82
83 my $parent = delete $args->{'parent'};
84 $args->{sort_order} ||= 0;
85
86 # Class::Accessor only wants a hashref;
87 my $self = $package->SUPER::new( $args );
88
89 # make sure our reference is weak
90 $self->parent($parent) if defined $parent;
91
92 return $self;
93}
94
95
96=head2 title [STRING]
97
98Sets or returns the string that the menu item will be displayed as.
99
100=head2 escape_title [BOOLEAN]
101
102Sets or returns whether or not to HTML escape the title before output.
103
104=head2 parent [MENU]
105
106Gets or sets the parent L<RT::Interface::Web::Menu> of this item; this defaults
107to null. This ensures that the reference is weakened.
108
109=head2 raw_html [STRING]
110
111Sets the content of this menu item to a raw blob of HTML. When building the
112menu, rather than constructing a link, we will return this raw content. No
113escaping is done.
114
115=cut
116
117sub parent {
118 my $self = shift;
119 if (@_) {
120 $self->{parent} = shift;
121 weaken $self->{parent};
122 }
123
124 return $self->{parent};
125}
126
127
128=head2 sort_order [NUMBER]
129
130Gets or sets the sort order of the item, as it will be displayed under
131the parent. This defaults to adding onto the end.
132
133=head2 target [STRING]
134
135Get or set the frame or pseudo-target for this link. something like L<_blank>
136
137=head2 class [STRING]
138
139Gets or sets the CSS class the menu item should have in addition to the default
140classes. This is only used if L</raw_html> isn't specified.
141
af59614d
MKG
142=head2 attributes [HASHREF]
143
144Gets or sets a hashref of HTML attribute name-value pairs that the menu item
145should have in addition to the attributes which have their own accessor, like
146L</class> and L</target>. This is only used if L</raw_html> isn't specified.
147
84fb5b46
MKG
148=head2 path
149
150Gets or sets the URL that the menu's link goes to. If the link
151provided is not absolute (does not start with a "/"), then is is
152treated as relative to it's parent's path, and made absolute.
153
154=cut
155
156sub path {
157 my $self = shift;
158 if (@_) {
dab09ea8
MKG
159 if (defined($self->{path} = shift)) {
160 my $base = ($self->parent and $self->parent->path) ? $self->parent->path : "";
161 $base .= "/" unless $base =~ m{/$};
162 my $uri = URI->new_abs($self->{path}, $base);
163 $self->{path} = $uri->as_string;
164 }
84fb5b46
MKG
165 }
166 return $self->{path};
167}
168
169=head2 active [BOOLEAN]
170
171Gets or sets if the menu item is marked as active. Setting this
172cascades to all of the parents of the menu item.
173
174This is currently B<unused>.
175
176=cut
177
178sub active {
179 my $self = shift;
180 if (@_) {
181 $self->{active} = shift;
182 $self->parent->active($self->{active}) if defined $self->parent;
183 }
184 return $self->{active};
185}
186
187=head2 child KEY [, PARAMHASH]
188
189If only a I<KEY> is provided, returns the child with that I<KEY>.
190
191Otherwise, creates or overwrites the child with that key, passing the
192I<PARAMHASH> to L<RT::Interface::Web::Menu/new>. Additionally, the paramhash's
193L</title> defaults to the I<KEY>, and the L</sort_order> defaults to the
194pre-existing child's sort order (if a C<KEY> is being over-written) or
195the end of the list, if it is a new C<KEY>.
196
197If the paramhash contains a key called C<menu>, that will be used instead
198of creating a new RT::Interface::Web::Menu.
199
200
201=cut
202
203sub child {
204 my $self = shift;
205 my $key = shift;
206 my $proto = ref $self || $self;
207
208 if ( my %args = @_ ) {
209
210 # Clear children ordering cache
211 delete $self->{children_list};
212
213 my $child;
214 if ( $child = $args{menu} ) {
215 $child->parent($self);
216 } else {
217 $child = $proto->new(
218 { parent => $self,
219 key => $key,
220 title => $key,
221 escape_title=> 1,
222 %args
223 }
224 );
225 }
226 $self->{children}{$key} = $child;
227
228 $child->sort_order( $args{sort_order} || (scalar values %{ $self->{children} }) )
229 unless ($child->sort_order());
230
231 # URL is relative to parents, and cached, so set it up now
232 $child->path( $child->{path} );
233
234 # Figure out the URL
235 my $path = $child->path;
236
237 # Activate it
238 if ( defined $path and length $path ) {
239 my $base_path = $HTML::Mason::Commands::r->path_info;
240 my $query = $HTML::Mason::Commands::m->cgi_object->query_string;
dab09ea8 241 $base_path =~ s!/+!/!g;
84fb5b46
MKG
242 $base_path .= "?$query" if defined $query and length $query;
243
244 $base_path =~ s/index\.html$//;
245 $base_path =~ s/\/+$//;
246 $path =~ s/index\.html$//;
247 $path =~ s/\/+$//;
248
249 if ( $path eq $base_path ) {
250 $self->{children}{$key}->active(1);
251 }
252 }
253 }
254
255 return $self->{children}{$key};
256}
257
258=head2 active_child
259
260Returns the first active child node, or C<undef> is there is none.
261
262=cut
263
264sub active_child {
265 my $self = shift;
266 foreach my $kid ($self->children) {
267 return $kid if $kid->active;
268 }
269 return undef;
270}
271
272
273=head2 delete KEY
274
275Removes the child with the provided I<KEY>.
276
277=cut
278
279sub delete {
280 my $self = shift;
281 my $key = shift;
282 delete $self->{children_list};
283 delete $self->{children}{$key};
284}
285
286
287=head2 has_children
288
289Returns true if there are any children on this menu
290
291=cut
292
293sub has_children {
294 my $self = shift;
295 if (@{ $self->children}) {
296 return 1
297 } else {
298 return 0;
299 }
300}
301
302
303=head2 children
304
305Returns the children of this menu item in sorted order; as an array in
306array context, or as an array reference in scalar context.
307
308=cut
309
310sub children {
311 my $self = shift;
312 my @kids;
313 if ($self->{children_list}) {
314 @kids = @{$self->{children_list}};
315 } else {
316 @kids = values %{$self->{children} || {}};
317 @kids = sort {$a->{sort_order} <=> $b->{sort_order}} @kids;
318 $self->{children_list} = \@kids;
319 }
320 return wantarray ? @kids : \@kids;
321}
322
403d7b0b
MKG
323=head2 add_after
324
325Called on a child, inserts a new menu item after it and shifts any other
326menu items at this level to the right.
327
328L<child> by default would insert at the end of the list of children, unless you
329did manual sort_order calculations.
330
331Takes all the regular arguments to L<child>.
332
333=cut
334
335sub add_after { shift->_insert_sibling("after", @_) }
336
337=head2 add_before
338
339Called on a child, inserts a new menu item at the child's location and shifts
340the child and the other menu items at this level to the right.
341
342L<child> by default would insert at the end of the list of children, unless you
343did manual sort_order calculations.
344
345Takes all the regular arguments to L<child>.
346
347=cut
348
349sub add_before { shift->_insert_sibling("before", @_) }
350
351sub _insert_sibling {
352 my $self = shift;
353 my $where = shift;
354 my $parent = $self->parent;
355 my $sort_order;
356 for my $contemporary ($parent->children) {
357 if ( $contemporary->key eq $self->key ) {
358 if ($where eq "before") {
359 # Bump the current child and the following
360 $sort_order = $contemporary->sort_order;
361 }
362 elsif ($where eq "after") {
363 # Leave the current child along, bump the rest
364 $sort_order = $contemporary->sort_order + 1;
365 next;
366 }
367 else {
368 # never set $sort_order, act no differently than ->child()
369 }
370 }
371 if ( $sort_order ) {
372 $contemporary->sort_order( $contemporary->sort_order + 1 );
373 }
374 }
375 $parent->child( @_, sort_order => $sort_order );
376}
377
84fb5b46 3781;