rt/lib/RT/Interface/Web/Menu.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2015 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         if (defined($self->{path} = shift)) {
 154             my $base  = ($self->parent and $self->parent->path) ? $self->parent->path : "";
 155                $base .= "/" unless $base =~ m{/$};
 156             my $uri = URI->new_abs($self->{path}, $base);
 157             $self->{path} = $uri->as_string;
 158         }
 159     }
 160     return $self->{path};
 161 }
 162
 163 =head2 active [BOOLEAN]
 164
 165 Gets or sets if the menu item is marked as active.  Setting this
 166 cascades to all of the parents of the menu item.
 167
 168 This is currently B<unused>.
 169
 170 =cut
 171
 172 sub active {
 173     my $self = shift;
 174     if (@_) {
 175         $self->{active} = shift;
 176         $self->parent->active($self->{active}) if defined $self->parent;
 177     }
 178     return $self->{active};
 179 }
 180
 181 =head2 child KEY [, PARAMHASH]
 182
 183 If only a I<KEY> is provided, returns the child with that I<KEY>.
 184
 185 Otherwise, creates or overwrites the child with that key, passing the
 186 I<PARAMHASH> to L<RT::Interface::Web::Menu/new>.  Additionally, the paramhash's
 187 L</title> defaults to the I<KEY>, and the L</sort_order> defaults to the
 188 pre-existing child's sort order (if a C<KEY> is being over-written) or
 189 the end of the list, if it is a new C<KEY>.
 190
 191 If the paramhash contains a key called C<menu>, that will be used instead
 192 of creating a new RT::Interface::Web::Menu.
 193
 194
 195 =cut
 196
 197 sub child {
 198     my $self  = shift;
 199     my $key   = shift;
 200     my $proto = ref $self || $self;
 201
 202     if ( my %args = @_ ) {
 203
 204         # Clear children ordering cache
 205         delete $self->{children_list};
 206
 207         my $child;
 208         if ( $child = $args{menu} ) {
 209             $child->parent($self);
 210         } else {
 211             $child = $proto->new(
 212                 {   parent      => $self,
 213                     key         => $key,
 214                     title       => $key,
 215                     escape_title=> 1,
 216                     %args
 217                 }
 218             );
 219         }
 220         $self->{children}{$key} = $child;
 221
 222         $child->sort_order( $args{sort_order} || (scalar values %{ $self->{children} })  )
 223             unless ($child->sort_order());
 224
 225         # URL is relative to parents, and cached, so set it up now
 226         $child->path( $child->{path} );
 227
 228         # Figure out the URL
 229         my $path = $child->path;
 230
 231         # Activate it
 232         if ( defined $path and length $path ) {
 233             my $base_path = $HTML::Mason::Commands::r->path_info;
 234             my $query     = $HTML::Mason::Commands::m->cgi_object->query_string;
 235             $base_path =~ s!/+!/!g;
 236             $base_path .= "?$query" if defined $query and length $query;
 237
 238             $base_path =~ s/index\.html$//;
 239             $base_path =~ s/\/+$//;
 240             $path =~ s/index\.html$//;
 241             $path =~ s/\/+$//;
 242
 243             if ( $path eq $base_path ) {
 244                 $self->{children}{$key}->active(1);
 245             }
 246         }
 247     }
 248
 249     return $self->{children}{$key};
 250 }
 251
 252 =head2 active_child
 253
 254 Returns the first active child node, or C<undef> is there is none.
 255
 256 =cut
 257
 258 sub active_child {
 259     my $self = shift;
 260     foreach my $kid ($self->children) {
 261         return $kid if $kid->active;
 262     }
 263     return undef;
 264 }
 265
 266
 267 =head2 delete KEY
 268
 269 Removes the child with the provided I<KEY>.
 270
 271 =cut
 272
 273 sub delete {
 274     my $self = shift;
 275     my $key = shift;
 276     delete $self->{children_list};
 277     delete $self->{children}{$key};
 278 }
 279
 280
 281 =head2 has_children
 282
 283 Returns true if there are any children on this menu
 284
 285 =cut
 286
 287 sub has_children {
 288     my $self = shift;
 289     if (@{ $self->children}) {
 290         return 1
 291     } else {
 292         return 0;
 293     }
 294 }
 295
 296
 297 =head2 children
 298
 299 Returns the children of this menu item in sorted order; as an array in
 300 array context, or as an array reference in scalar context.
 301
 302 =cut
 303
 304 sub children {
 305     my $self = shift;
 306     my @kids;
 307     if ($self->{children_list}) {
 308         @kids = @{$self->{children_list}};
 309     } else {
 310         @kids = values %{$self->{children} || {}};
 311         @kids = sort {$a->{sort_order} <=> $b->{sort_order}} @kids;
 312         $self->{children_list} = \@kids;
 313     }
 314     return wantarray ? @kids : \@kids;
 315 }
 316
 317 =head2 add_after
 318
 319 Called on a child, inserts a new menu item after it and shifts any other
 320 menu items at this level to the right.
 321
 322 L<child> by default would insert at the end of the list of children, unless you
 323 did manual sort_order calculations.
 324
 325 Takes all the regular arguments to L<child>.
 326
 327 =cut
 328
 329 sub add_after { shift->_insert_sibling("after", @_) }
 330
 331 =head2 add_before
 332
 333 Called on a child, inserts a new menu item at the child's location and shifts
 334 the child and the other menu items at this level to the right.
 335
 336 L<child> by default would insert at the end of the list of children, unless you
 337 did manual sort_order calculations.
 338
 339 Takes all the regular arguments to L<child>.
 340
 341 =cut
 342
 343 sub add_before { shift->_insert_sibling("before", @_) }
 344
 345 sub _insert_sibling {
 346     my $self = shift;
 347     my $where = shift;
 348     my $parent = $self->parent;
 349     my $sort_order;
 350     for my $contemporary ($parent->children) {
 351         if ( $contemporary->key eq $self->key ) {
 352             if ($where eq "before") {
 353                 # Bump the current child and the following
 354                 $sort_order = $contemporary->sort_order;
 355             }
 356             elsif ($where eq "after") {
 357                 # Leave the current child along, bump the rest
 358                 $sort_order = $contemporary->sort_order + 1;
 359                 next;
 360             }
 361             else {
 362                 # never set $sort_order, act no differently than ->child()
 363             }
 364         }
 365         if ( $sort_order ) {
 366             $contemporary->sort_order( $contemporary->sort_order + 1 );
 367         }
 368     }
 369     $parent->child( @_, sort_order => $sort_order );
 370 }
 371
 372 1;