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

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2017 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 attributes
  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>,
  74 L<attributes>, and L</active>.  See the subroutines with the respective name
  75 below for 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 attributes [HASHREF]
 143
 144 Gets or sets a hashref of HTML attribute name-value pairs that the menu item
 145 should have in addition to the attributes which have their own accessor, like
 146 L</class> and L</target>.  This is only used if L</raw_html> isn't specified.
 147
 148 =head2 path
 149
 150 Gets or sets the URL that the menu's link goes to.  If the link
 151 provided is not absolute (does not start with a "/"), then is is
 152 treated as relative to it's parent's path, and made absolute.
 153
 154 =cut
 155
 156 sub path {
 157     my $self = shift;
 158     if (@_) {
 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         }
 165     }
 166     return $self->{path};
 167 }
 168
 169 =head2 active [BOOLEAN]
 170
 171 Gets or sets if the menu item is marked as active.  Setting this
 172 cascades to all of the parents of the menu item.
 173
 174 This is currently B<unused>.
 175
 176 =cut
 177
 178 sub 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
 189 If only a I<KEY> is provided, returns the child with that I<KEY>.
 190
 191 Otherwise, creates or overwrites the child with that key, passing the
 192 I<PARAMHASH> to L<RT::Interface::Web::Menu/new>.  Additionally, the paramhash's
 193 L</title> defaults to the I<KEY>, and the L</sort_order> defaults to the
 194 pre-existing child's sort order (if a C<KEY> is being over-written) or
 195 the end of the list, if it is a new C<KEY>.
 196
 197 If the paramhash contains a key called C<menu>, that will be used instead
 198 of creating a new RT::Interface::Web::Menu.
 199
 200
 201 =cut
 202
 203 sub 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;
 241             $base_path =~ s!/+!/!g;
 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
 260 Returns the first active child node, or C<undef> is there is none.
 261
 262 =cut
 263
 264 sub 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
 275 Removes the child with the provided I<KEY>.
 276
 277 =cut
 278
 279 sub 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
 289 Returns true if there are any children on this menu
 290
 291 =cut
 292
 293 sub 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
 305 Returns the children of this menu item in sorted order; as an array in
 306 array context, or as an array reference in scalar context.
 307
 308 =cut
 309
 310 sub 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
 323 =head2 add_after
 324
 325 Called on a child, inserts a new menu item after it and shifts any other
 326 menu items at this level to the right.
 327
 328 L<child> by default would insert at the end of the list of children, unless you
 329 did manual sort_order calculations.
 330
 331 Takes all the regular arguments to L<child>.
 332
 333 =cut
 334
 335 sub add_after { shift->_insert_sibling("after", @_) }
 336
 337 =head2 add_before
 338
 339 Called on a child, inserts a new menu item at the child's location and shifts
 340 the child and the other menu items at this level to the right.
 341
 342 L<child> by default would insert at the end of the list of children, unless you
 343 did manual sort_order calculations.
 344
 345 Takes all the regular arguments to L<child>.
 346
 347 =cut
 348
 349 sub add_before { shift->_insert_sibling("before", @_) }
 350
 351 sub _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
 378 =head2 RemoveDashboardMenuItems
 379
 380 Remove dashboards from individual user and system dash menus.
 381
 382 Requires a hash with DashboardId and CurrentUser object.
 383
 384     $menu->RemoveDashboardMenuItem( DashboardId => $id, CurrentUser => $session{CurrentUser}->UserObj );
 385
 386 =cut
 387
 388 sub RemoveDashboardMenuItem {
 389     my $self = shift;
 390     my %args = @_;
 391
 392     return unless $args{'DashboardId'} and $args{'CurrentUser'};
 393     my $dashboard_id = $args{'DashboardId'};
 394     my $current_user = $args{'CurrentUser'};
 395
 396     # First clear from user's dashboards
 397     my $dashboards_in_menu = $current_user->Preferences('DashboardsInMenu', {} );
 398
 399     my @dashboards = grep { $_ != $dashboard_id } @{$dashboards_in_menu->{'dashboards'}};
 400     $dashboards_in_menu->{'dashboards'} = \@dashboards || [];
 401
 402     my ($ret, $msg) = $current_user->SetPreferences('DashboardsInMenu', $dashboards_in_menu);
 403     RT::Logger->warn("Unable to update dashboard for user " . $current_user->Name . ": $msg")
 404         unless $ret;
 405
 406     # Now update the system dashboard
 407     my $system = RT::System->new( $current_user );
 408     my ($default_dashboards) = $system->Attributes->Named('DashboardsInMenu');
 409
 410     if ($default_dashboards) {
 411         $dashboards_in_menu = $default_dashboards->Content;
 412         my @dashboards = grep { $_ != $dashboard_id } @{$dashboards_in_menu->{'dashboards'}};
 413
 414         # Update only if we removed one
 415         if ( @{$dashboards_in_menu->{'dashboards'}} > @dashboards ){
 416             $dashboards_in_menu->{'dashboards'} = \@dashboards || [];
 417
 418             ($ret, $msg) = $default_dashboards->SetContent($dashboards_in_menu);
 419             RT::Logger->warn("Unable to update system dashboard menu: $msg")
 420                 unless $ret;
 421         }
 422     }
 423     return;
 424 }
 425
 426 1;