6b351e94b1c93aed022c750bc386f8aa61003116
[usit-rt.git] / lib / RT / Interface / Web / Menu.pm
1 # BEGIN BPS TAGGED BLOCK {{{
2 #
3 # COPYRIGHT:
4 #
5 # This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
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
49 package RT::Interface::Web::Menu;
50
51 use strict;
52 use warnings;
53
54
55 use base qw/Class::Accessor::Fast/;
56 use URI;
57 use Scalar::Util qw(weaken);
58
59 __PACKAGE__->mk_accessors(qw(
60     key title description raw_html escape_title sort_order target class
61 ));
62
63 =head1 NAME
64
65 RT::Interface::Web::Menu - Handle the API for menu navigation
66
67 =head1 METHODS
68
69 =head2 new PARAMHASH
70
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
75 each option's use.
76
77 =cut
78
79 sub 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
98 Sets or returns the string that the menu item will be displayed as.
99
100 =head2 escape_title [BOOLEAN]
101
102 Sets or returns whether or not to HTML escape the title before output.
103
104 =head2 parent [MENU]
105
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.
108
109 =head2 raw_html [STRING]
110
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
113 escaping is done.
114
115 =cut
116
117 sub 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
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.
132
133 =head2 target [STRING]
134
135 Get or set the frame or pseudo-target for this link. something like L<_blank>
136
137 =head2 class [STRING]
138
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.
141
142 =head2 path
143
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.
147
148 =cut
149
150 sub path {
151     my $self = shift;
152     if (@_) {
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};
157     }
158     return $self->{path};
159 }
160
161 =head2 active [BOOLEAN]
162
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.
165
166 This is currently B<unused>.
167
168 =cut
169
170 sub active {
171     my $self = shift;
172     if (@_) {
173         $self->{active} = shift;
174         $self->parent->active($self->{active}) if defined $self->parent;
175     }
176     return $self->{active};
177 }
178
179 =head2 child KEY [, PARAMHASH]
180
181 If only a I<KEY> is provided, returns the child with that I<KEY>.
182
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>.
188
189 If the paramhash contains a key called C<menu>, that will be used instead
190 of creating a new RT::Interface::Web::Menu.
191
192
193 =cut
194
195 sub child {
196     my $self  = shift;
197     my $key   = shift;
198     my $proto = ref $self || $self;
199
200     if ( my %args = @_ ) {
201
202         # Clear children ordering cache
203         delete $self->{children_list};
204
205         my $child;
206         if ( $child = $args{menu} ) {
207             $child->parent($self);
208         } else {
209             $child = $proto->new(
210                 {   parent      => $self,
211                     key         => $key,
212                     title       => $key,
213                     escape_title=> 1,
214                     %args
215                 }
216             );
217         }
218         $self->{children}{$key} = $child;
219
220         $child->sort_order( $args{sort_order} || (scalar values %{ $self->{children} })  )
221             unless ($child->sort_order());
222
223         # URL is relative to parents, and cached, so set it up now
224         $child->path( $child->{path} );
225
226         # Figure out the URL
227         my $path = $child->path;
228
229         # Activate it
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;
234
235             $base_path =~ s/index\.html$//;
236             $base_path =~ s/\/+$//;
237             $path =~ s/index\.html$//;
238             $path =~ s/\/+$//;
239
240             if ( $path eq $base_path ) {
241                 $self->{children}{$key}->active(1);
242             }
243         }
244     }
245
246     return $self->{children}{$key};
247 }
248
249 =head2 active_child
250
251 Returns the first active child node, or C<undef> is there is none.
252
253 =cut
254
255 sub active_child {
256     my $self = shift;
257     foreach my $kid ($self->children) {
258         return $kid if $kid->active;
259     }
260     return undef;
261 }
262
263
264 =head2 delete KEY
265
266 Removes the child with the provided I<KEY>.
267
268 =cut
269
270 sub delete {
271     my $self = shift;
272     my $key = shift;
273     delete $self->{children_list};
274     delete $self->{children}{$key};
275 }
276
277
278 =head2 has_children
279
280 Returns true if there are any children on this menu
281
282 =cut
283
284 sub has_children {
285     my $self = shift;
286     if (@{ $self->children}) {
287         return 1
288     } else {
289         return 0;
290     }
291 }
292
293
294 =head2 children
295
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.
298
299 =cut
300
301 sub children {
302     my $self = shift;
303     my @kids;
304     if ($self->{children_list}) {
305         @kids = @{$self->{children_list}};
306     } else {
307         @kids = values %{$self->{children} || {}};
308         @kids = sort {$a->{sort_order} <=> $b->{sort_order}} @kids;
309         $self->{children_list} = \@kids;
310     }
311     return wantarray ? @kids : \@kids;
312 }
313
314 1;