lib/Catalyst/Dispatcher.pm

   1 package Catalyst::Dispatcher;
   2
   3 use Moose;
   4 use Class::MOP;
   5 with 'MooseX::Emulate::Class::Accessor::Fast';
   6
   7 use Catalyst::Exception;
   8 use Catalyst::Utils;
   9 use Catalyst::Action;
  10 use Catalyst::ActionContainer;
  11 use Catalyst::DispatchType::Default;
  12 use Catalyst::DispatchType::Index;
  13 use Catalyst::Utils;
  14 use Text::SimpleTable;
  15 use Tree::Simple;
  16 use Tree::Simple::Visitor::FindByPath;
  17
  18 use namespace::clean -except => 'meta';
  19
  20 # Refactoring note:
  21 # do these belong as package vars or should we build these via a builder method?
  22 # See Catalyst-Plugin-Server for them being added to, which should be much less ugly.
  23
  24 # Preload these action types
  25 our @PRELOAD = qw/Index Path Regex/;
  26
  27 # Postload these action types
  28 our @POSTLOAD = qw/Default/;
  29
  30 # Note - see back-compat methods at end of file.
  31 has _tree => (is => 'rw', builder => '_build__tree');
  32 has dispatch_types => (is => 'rw', default => sub { [] }, required => 1, lazy => 1);
  33 has _registered_dispatch_types => (is => 'rw', default => sub { {} }, required => 1, lazy => 1);
  34 has _method_action_class => (is => 'rw', default => 'Catalyst::Action');
  35 has _action_hash => (is => 'rw', required => 1, lazy => 1, default => sub { {} });
  36 has _container_hash => (is => 'rw', required => 1, lazy => 1, default => sub { {} });
  37
  38 my %dispatch_types = ( pre => \@PRELOAD, post => \@POSTLOAD );
  39 foreach my $type (keys %dispatch_types) {
  40     has $type . "load_dispatch_types" => (
  41         is => 'rw', required => 1, lazy => 1, default => sub { $dispatch_types{$type} },
  42         traits => ['MooseX::Emulate::Class::Accessor::Fast::Meta::Role::Attribute'], # List assignment is CAF style
  43     );
  44 }
  45
  46 =head1 NAME
  47
  48 Catalyst::Dispatcher - The Catalyst Dispatcher
  49
  50 =head1 SYNOPSIS
  51
  52 See L<Catalyst>.
  53
  54 =head1 DESCRIPTION
  55
  56 This is the class that maps public urls to actions in your Catalyst
  57 application based on the attributes you set.
  58
  59 =head1 METHODS
  60
  61 =head2 new
  62
  63 Construct a new dispatcher.
  64
  65 =cut
  66
  67 sub _build__tree {
  68   my ($self) = @_;
  69
  70   my $container =
  71     Catalyst::ActionContainer->new( { part => '/', actions => {} } );
  72
  73   return Tree::Simple->new($container, Tree::Simple->ROOT);
  74 }
  75
  76 =head2 $self->preload_dispatch_types
  77
  78 An arrayref of pre-loaded dispatchtype classes
  79
  80 Entries are considered to be available as C<Catalyst::DispatchType::CLASS>
  81 To use a custom class outside the regular C<Catalyst> namespace, prefix
  82 it with a C<+>, like so:
  83
  84     +My::Dispatch::Type
  85
  86 =head2 $self->postload_dispatch_types
  87
  88 An arrayref of post-loaded dispatchtype classes
  89
  90 Entries are considered to be available as C<Catalyst::DispatchType::CLASS>
  91 To use a custom class outside the regular C<Catalyst> namespace, prefix
  92 it with a C<+>, like so:
  93
  94     +My::Dispatch::Type
  95
  96 =head2 $self->dispatch($c)
  97
  98 Delegate the dispatch to the action that matched the url, or return a
  99 message about unknown resource
 100
 101 =cut
 102
 103 sub dispatch {
 104     my ( $self, $c ) = @_;
 105     if ( my $action = $c->action ) {
 106         $c->forward( join( '/', '', $action->namespace, '_DISPATCH' ) );
 107     }
 108     else {
 109         my $path  = $c->req->path;
 110         my $error = $path
 111           ? qq/Unknown resource "$path"/
 112           : "No default action defined";
 113         $c->log->error($error) if $c->debug;
 114         $c->error($error);
 115     }
 116 }
 117
 118 # $self->_command2action( $c, $command [, \@arguments ] )
 119 # $self->_command2action( $c, $command [, \@captures, \@arguments ] )
 120 # Search for an action, from the command and returns C<($action, $args, $captures)> on
 121 # success. Returns C<(0)> on error.
 122
 123 sub _command2action {
 124     my ( $self, $c, $command, @extra_params ) = @_;
 125
 126     unless ($command) {
 127         $c->log->debug('Nothing to go to') if $c->debug;
 128         return 0;
 129     }
 130
 131     my (@args, @captures);
 132
 133     if ( ref( $extra_params[-2] ) eq 'ARRAY' ) {
 134         @captures = @{ splice @extra_params, -2, 1 };
 135     }
 136
 137     if ( ref( $extra_params[-1] ) eq 'ARRAY' ) {
 138         @args = @{ pop @extra_params }
 139     } else {
 140         # this is a copy, it may take some abuse from
 141         # ->_invoke_as_path if the path had trailing parts
 142         @args = @{ $c->request->arguments };
 143     }
 144
 145     my $action;
 146
 147     # go to a string path ("/foo/bar/gorch")
 148     # or action object
 149     if (blessed($command) && $command->isa('Catalyst::Action')) {
 150         $action = $command;
 151     }
 152     else {
 153         $action = $self->_invoke_as_path( $c, "$command", \@args );
 154     }
 155
 156     # go to a component ( "MyApp::*::Foo" or $c->component("...")
 157     # - a path or an object)
 158     unless ($action) {
 159         my $method = @extra_params ? $extra_params[0] : "process";
 160         $action = $self->_invoke_as_component( $c, $command, $method );
 161     }
 162
 163     return $action, \@args, \@captures;
 164 }
 165
 166 =head2 $self->visit( $c, $command [, \@arguments ] )
 167
 168 Documented in L<Catalyst>
 169
 170 =cut
 171
 172 sub visit {
 173     my $self = shift;
 174     $self->_do_visit('visit', @_);
 175 }
 176
 177 sub _do_visit {
 178     my $self = shift;
 179     my $opname = shift;
 180     my ( $c, $command ) = @_;
 181     my ( $action, $args, $captures ) = $self->_command2action(@_);
 182     my $error = qq/Couldn't $opname("$command"): /;
 183
 184     if (!$action) {
 185         $error .= qq/Couldn't $opname to command "$command": /
 186                  .qq/Invalid action or component./;
 187     }
 188     elsif (!defined $action->namespace) {
 189         $error .= qq/Action has no namespace: cannot $opname() to a plain /
 190                  .qq/method or component, must be an :Action of some sort./
 191     }
 192     elsif (!$action->class->can('_DISPATCH')) {
 193         $error .= qq/Action cannot _DISPATCH. /
 194                  .qq/Did you try to $opname() a non-controller action?/;
 195     }
 196     else {
 197         $error = q();
 198     }
 199
 200     if($error) {
 201         $c->error($error);
 202         $c->log->debug($error) if $c->debug;
 203         return 0;
 204     }
 205
 206     $action = $self->expand_action($action);
 207
 208     local $c->request->{arguments} = $args;
 209     local $c->request->{captures}  = $captures;
 210     local $c->{namespace} = $action->{'namespace'};
 211     local $c->{action} = $action;
 212
 213     $self->dispatch($c);
 214 }
 215
 216 =head2 $self->go( $c, $command [, \@arguments ] )
 217
 218 Documented in L<Catalyst>
 219
 220 =cut
 221
 222 sub go {
 223     my $self = shift;
 224     $self->_do_visit('go', @_);
 225     Catalyst::Exception::Go->throw;
 226 }
 227
 228 =head2 $self->forward( $c, $command [, \@arguments ] )
 229
 230 Documented in L<Catalyst>
 231
 232 =cut
 233
 234 sub forward {
 235     my $self = shift;
 236     no warnings 'recursion';
 237     $self->_do_forward(forward => @_);
 238 }
 239
 240 sub _do_forward {
 241     my $self = shift;
 242     my $opname = shift;
 243     my ( $c, $command ) = @_;
 244     my ( $action, $args, $captures ) = $self->_command2action(@_);
 245
 246     if (!$action) {
 247         my $error .= qq/Couldn't $opname to command "$command": /
 248                     .qq/Invalid action or component./;
 249         $c->error($error);
 250         $c->log->debug($error) if $c->debug;
 251         return 0;
 252     }
 253
 254
 255     local $c->request->{arguments} = $args;
 256     no warnings 'recursion';
 257     $action->dispatch( $c );
 258
 259     return $c->state;
 260 }
 261
 262 =head2 $self->detach( $c, $command [, \@arguments ] )
 263
 264 Documented in L<Catalyst>
 265
 266 =cut
 267
 268 sub detach {
 269     my ( $self, $c, $command, @args ) = @_;
 270     $self->_do_forward(detach => $c, $command, @args ) if $command;
 271     Catalyst::Exception::Detach->throw;
 272 }
 273
 274 sub _action_rel2abs {
 275     my ( $self, $c, $path ) = @_;
 276
 277     unless ( $path =~ m#^/# ) {
 278         my $namespace = $c->stack->[-1]->namespace;
 279         $path = "$namespace/$path";
 280     }
 281
 282     $path =~ s#^/##;
 283     return $path;
 284 }
 285
 286 sub _invoke_as_path {
 287     my ( $self, $c, $rel_path, $args ) = @_;
 288
 289     my $path = $self->_action_rel2abs( $c, $rel_path );
 290
 291     my ( $tail, @extra_args );
 292     while ( ( $path, $tail ) = ( $path =~ m#^(?:(.*)/)?(\w+)?$# ) )
 293     {                           # allow $path to be empty
 294         if ( my $action = $c->get_action( $tail, $path ) ) {
 295             push @$args, @extra_args;
 296             return $action;
 297         }
 298         else {
 299             return
 300               unless $path
 301               ; # if a match on the global namespace failed then the whole lookup failed
 302         }
 303
 304         unshift @extra_args, $tail;
 305     }
 306 }
 307
 308 sub _find_component {
 309     my ( $self, $c, $component ) = @_;
 310
 311     # fugly, why doesn't ->component('MyApp') work?
 312     return $c if ($component eq blessed($c));
 313
 314     return blessed($component)
 315         ? $component
 316         : $c->component($component);
 317 }
 318
 319 sub _invoke_as_component {
 320     my ( $self, $c, $component_or_class, $method ) = @_;
 321
 322     my $component = $self->_find_component($c, $component_or_class);
 323     my $component_class = blessed $component || return 0;
 324
 325     if (my $code = $component_class->can('action_for')) {
 326         my $possible_action = $component->$code($method);
 327         return $possible_action if $possible_action;
 328     }
 329
 330     if ( my $code = $component_class->can($method) ) {
 331         return $self->_method_action_class->new(
 332             {
 333                 name      => $method,
 334                 code      => $code,
 335                 reverse   => "$component_class->$method",
 336                 class     => $component_class,
 337                 namespace => Catalyst::Utils::class2prefix( $component_class ),
 338             }
 339         );
 340     }
 341     else {
 342         my $error =
 343           qq/Couldn't forward to "$component_class". Does not implement "$method"/;
 344         $c->error($error);
 345         $c->log->debug($error)
 346           if $c->debug;
 347         return 0;
 348     }
 349 }
 350
 351 =head2 $self->prepare_action($c)
 352
 353 Find an dispatch type that matches $c->req->path, and set args from it.
 354
 355 =cut
 356
 357 sub prepare_action {
 358     my ( $self, $c ) = @_;
 359     my $req = $c->req;
 360     my $path = $req->path;
 361     my @path = split /\//, $req->path;
 362     $req->args( \my @args );
 363
 364     unshift( @path, '' );    # Root action
 365
 366   DESCEND: while (@path) {
 367         $path = join '/', @path;
 368         $path =~ s#^/+##;
 369
 370         # Check out dispatch types to see if any will handle the path at
 371         # this level
 372
 373         foreach my $type ( @{ $self->dispatch_types } ) {
 374             last DESCEND if $type->match( $c, $path );
 375         }
 376
 377         # If not, move the last part path to args
 378         my $arg = pop(@path);
 379         $arg =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
 380         unshift @args, $arg;
 381     }
 382
 383     s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg for grep { defined } @{$req->captures||[]};
 384
 385     $c->log->debug( 'Path is "' . $req->match . '"' )
 386       if ( $c->debug && defined $req->match && length $req->match );
 387
 388     $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
 389       if ( $c->debug && @args );
 390 }
 391
 392 =head2 $self->get_action( $action, $namespace )
 393
 394 returns a named action from a given namespace.
 395
 396 =cut
 397
 398 sub get_action {
 399     my ( $self, $name, $namespace ) = @_;
 400     return unless $name;
 401
 402     $namespace = join( "/", grep { length } split '/', ( defined $namespace ? $namespace : "" ) );
 403
 404     return $self->_action_hash->{"${namespace}/${name}"};
 405 }
 406
 407 =head2 $self->get_action_by_path( $path );
 408
 409 Returns the named action by its full private path.
 410
 411 =cut
 412
 413 sub get_action_by_path {
 414     my ( $self, $path ) = @_;
 415     $path =~ s/^\///;
 416     $path = "/$path" unless $path =~ /\//;
 417     $self->_action_hash->{$path};
 418 }
 419
 420 =head2 $self->get_actions( $c, $action, $namespace )
 421
 422 =cut
 423
 424 sub get_actions {
 425     my ( $self, $c, $action, $namespace ) = @_;
 426     return [] unless $action;
 427
 428     $namespace = join( "/", grep { length } split '/', $namespace || "" );
 429
 430     my @match = $self->get_containers($namespace);
 431
 432     return map { $_->get_action($action) } @match;
 433 }
 434
 435 =head2 $self->get_containers( $namespace )
 436
 437 Return all the action containers for a given namespace, inclusive
 438
 439 =cut
 440
 441 sub get_containers {
 442     my ( $self, $namespace ) = @_;
 443     $namespace ||= '';
 444     $namespace = '' if $namespace eq '/';
 445
 446     my @containers;
 447
 448     if ( length $namespace ) {
 449         do {
 450             push @containers, $self->_container_hash->{$namespace};
 451         } while ( $namespace =~ s#/[^/]+$## );
 452     }
 453
 454     return reverse grep { defined } @containers, $self->_container_hash->{''};
 455 }
 456
 457 =head2 $self->uri_for_action($action, \@captures)
 458
 459 Takes a Catalyst::Action object and action parameters and returns a URI
 460 part such that if $c->req->path were this URI part, this action would be
 461 dispatched to with $c->req->captures set to the supplied arrayref.
 462
 463 If the action object is not available for external dispatch or the dispatcher
 464 cannot determine an appropriate URI, this method will return undef.
 465
 466 =cut
 467
 468 sub uri_for_action {
 469     my ( $self, $action, $captures) = @_;
 470     $captures ||= [];
 471     foreach my $dispatch_type ( @{ $self->dispatch_types } ) {
 472         my $uri = $dispatch_type->uri_for_action( $action, $captures );
 473         return( $uri eq '' ? '/' : $uri )
 474             if defined($uri);
 475     }
 476     return undef;
 477 }
 478
 479 =head2 expand_action
 480
 481 expand an action into a full representation of the dispatch.
 482 mostly useful for chained, other actions will just return a
 483 single action.
 484
 485 =cut
 486
 487 sub expand_action {
 488     my ($self, $action) = @_;
 489
 490     foreach my $dispatch_type (@{ $self->dispatch_types }) {
 491         my $expanded = $dispatch_type->expand_action($action);
 492         return $expanded if $expanded;
 493     }
 494
 495     return $action;
 496 }
 497
 498 =head2 $self->register( $c, $action )
 499
 500 Make sure all required dispatch types for this action are loaded, then
 501 pass the action to our dispatch types so they can register it if required.
 502 Also, set up the tree with the action containers.
 503
 504 =cut
 505
 506 sub register {
 507     my ( $self, $c, $action ) = @_;
 508
 509     my $registered = $self->_registered_dispatch_types;
 510
 511     #my $priv = 0; #seems to be unused
 512     foreach my $key ( keys %{ $action->attributes } ) {
 513         next if $key eq 'Private';
 514         my $class = "Catalyst::DispatchType::$key";
 515         unless ( $registered->{$class} ) {
 516             # FIXME - Some error checking and re-throwing needed here, as
 517             #         we eat exceptions loading dispatch types.
 518             eval { Class::MOP::load_class($class) };
 519             push( @{ $self->dispatch_types }, $class->new ) unless $@;
 520             $registered->{$class} = 1;
 521         }
 522     }
 523
 524     my @dtypes = @{ $self->dispatch_types };
 525     my @normal_dtypes;
 526     my @low_precedence_dtypes;
 527
 528     for my $type ( @dtypes ) {
 529         if ($type->_is_low_precedence) {
 530             push @low_precedence_dtypes, $type;
 531         } else {
 532             push @normal_dtypes, $type;
 533         }
 534     }
 535
 536     # Pass the action to our dispatch types so they can register it if reqd.
 537     my $was_registered = 0;
 538     foreach my $type ( @normal_dtypes ) {
 539         $was_registered = 1 if $type->register( $c, $action );
 540     }
 541
 542     if (not $was_registered) {
 543         foreach my $type ( @low_precedence_dtypes ) {
 544             $type->register( $c, $action );
 545         }
 546     }
 547
 548     my $namespace = $action->namespace;
 549     my $name      = $action->name;
 550
 551     my $container = $self->_find_or_create_action_container($namespace);
 552
 553     # Set the method value
 554     $container->add_action($action);
 555
 556     $self->_action_hash->{"$namespace/$name"} = $action;
 557     $self->_container_hash->{$namespace} = $container;
 558 }
 559
 560 sub _find_or_create_action_container {
 561     my ( $self, $namespace ) = @_;
 562
 563     my $tree ||= $self->_tree;
 564
 565     return $tree->getNodeValue unless $namespace;
 566
 567     my @namespace = split '/', $namespace;
 568     return $self->_find_or_create_namespace_node( $tree, @namespace )
 569       ->getNodeValue;
 570 }
 571
 572 sub _find_or_create_namespace_node {
 573     my ( $self, $parent, $part, @namespace ) = @_;
 574
 575     return $parent unless $part;
 576
 577     my $child =
 578       ( grep { $_->getNodeValue->part eq $part } $parent->getAllChildren )[0];
 579
 580     unless ($child) {
 581         my $container = Catalyst::ActionContainer->new($part);
 582         $parent->addChild( $child = Tree::Simple->new($container) );
 583     }
 584
 585     $self->_find_or_create_namespace_node( $child, @namespace );
 586 }
 587
 588 =head2 $self->setup_actions( $class, $context )
 589
 590 Loads all of the preload dispatch types, registers their actions and then
 591 loads all of the postload dispatch types, and iterates over the tree of
 592 actions, displaying the debug information if appropriate.
 593
 594 =cut
 595
 596 sub setup_actions {
 597     my ( $self, $c ) = @_;
 598
 599     my @classes =
 600       $self->_load_dispatch_types( @{ $self->preload_dispatch_types } );
 601     @{ $self->_registered_dispatch_types }{@classes} = (1) x @classes;
 602
 603     foreach my $comp ( values %{ $c->components } ) {
 604         $comp->register_actions($c) if $comp->can('register_actions');
 605     }
 606
 607     $self->_load_dispatch_types( @{ $self->postload_dispatch_types } );
 608
 609     return unless $c->debug;
 610     $self->_display_action_tables($c);
 611 }
 612
 613 sub _display_action_tables {
 614     my ($self, $c) = @_;
 615
 616     my $avail_width = Catalyst::Utils::term_width() - 12;
 617     my $col1_width = ($avail_width * .25) < 20 ? 20 : int($avail_width * .25);
 618     my $col2_width = ($avail_width * .50) < 36 ? 36 : int($avail_width * .50);
 619     my $col3_width =  $avail_width - $col1_width - $col2_width;
 620     my $privates = Text::SimpleTable->new(
 621         [ $col1_width, 'Private' ], [ $col2_width, 'Class' ], [ $col3_width, 'Method' ]
 622     );
 623
 624     my $has_private = 0;
 625     my $walker = sub {
 626         my ( $walker, $parent, $prefix ) = @_;
 627         $prefix .= $parent->getNodeValue || '';
 628         $prefix .= '/' unless $prefix =~ /\/$/;
 629         my $node = $parent->getNodeValue->actions;
 630
 631         for my $action ( keys %{$node} ) {
 632             my $action_obj = $node->{$action};
 633             next
 634               if ( ( $action =~ /^_.*/ )
 635                 && ( !$c->config->{show_internal_actions} ) );
 636             $privates->row( "$prefix$action", $action_obj->class, $action );
 637             $has_private = 1;
 638         }
 639
 640         $walker->( $walker, $_, $prefix ) for $parent->getAllChildren;
 641     };
 642
 643     $walker->( $walker, $self->_tree, '' );
 644     $c->log->debug( "Loaded Private actions:\n" . $privates->draw . "\n" )
 645       if $has_private;
 646
 647     # List all public actions
 648     $_->list($c) for @{ $self->dispatch_types };
 649 }
 650
 651 sub _load_dispatch_types {
 652     my ( $self, @types ) = @_;
 653
 654     my @loaded;
 655     # Preload action types
 656     for my $type (@types) {
 657         # first param is undef because we cannot get the appclass
 658         my $class = Catalyst::Utils::resolve_namespace(undef, 'Catalyst::DispatchType', $type);
 659
 660         eval { Class::MOP::load_class($class) };
 661         Catalyst::Exception->throw( message => qq/Couldn't load "$class"/ )
 662           if $@;
 663         push @{ $self->dispatch_types }, $class->new;
 664
 665         push @loaded, $class;
 666     }
 667
 668     return @loaded;
 669 }
 670
 671 =head2 $self->dispatch_type( $type )
 672
 673 Get the DispatchType object of the relevant type, i.e. passing C<$type> of
 674 C<Chained> would return a L<Catalyst::DispatchType::Chained> object (assuming
 675 of course it's being used.)
 676
 677 =cut
 678
 679 sub dispatch_type {
 680     my ($self, $name) = @_;
 681
 682     # first param is undef because we cannot get the appclass
 683     $name = Catalyst::Utils::resolve_namespace(undef, 'Catalyst::DispatchType', $name);
 684
 685     for (@{ $self->dispatch_types }) {
 686         return $_ if ref($_) eq $name;
 687     }
 688     return undef;
 689 }
 690
 691 use Moose;
 692
 693 # 5.70 backwards compatibility hacks.
 694
 695 # Various plugins (e.g. Plugin::Server and Plugin::Authorization::ACL)
 696 # need the methods here which *should* be private..
 697
 698 # You should be able to use get_actions or get_containers appropriately
 699 # instead of relying on these methods which expose implementation details
 700 # of the dispatcher..
 701 #
 702 # IRC backlog included below, please come ask if this doesn't work for you.
 703 #
 704 # <@t0m> 5.80, the state of. There are things in the dispatcher which have
 705 #        been deprecated, that we yell at anyone for using, which there isn't
 706 #        a good alternative for yet..
 707 # <@mst> er, get_actions/get_containers provides that doesn't it?
 708 # <@mst> DispatchTypes are loaded on demand anyway
 709 # <@t0m> I'm thinking of things like _tree which is aliased to 'tree' with
 710 #        warnings otherwise shit breaks.. We're issuing warnings about the
 711 #        correct set of things which you shouldn't be calling..
 712 # <@mst> right
 713 # <@mst> basically, I don't see there's a need for a replacement for anything
 714 # <@mst> it was never a good idea to call ->tree
 715 # <@mst> nothingmuch was the only one who did AFAIK
 716 # <@mst> and he admitted it was a hack ;)
 717
 718 # See also t/lib/TestApp/Plugin/AddDispatchTypes.pm
 719
 720 # Alias _method_name to method_name, add a before modifier to warn..
 721 foreach my $public_method_name (qw/
 722         tree
 723         registered_dispatch_types
 724         method_action_class
 725         action_hash
 726         container_hash
 727     /) {
 728     my $private_method_name = '_' . $public_method_name;
 729     my $meta = __PACKAGE__->meta; # Calling meta method here fine as we happen at compile time.
 730     $meta->add_method($public_method_name, $meta->get_method($private_method_name));
 731     {
 732         my %package_hash; # Only warn once per method, per package. These are infrequent enough that
 733                           # I haven't provided a way to disable them, patches welcome.
 734         $meta->add_before_method_modifier($public_method_name, sub {
 735             my $class = caller(2);
 736             chomp($class);
 737             $package_hash{$class}++ || do {
 738                 warn("Class $class is calling the deprecated method\n"
 739                     . "  Catalyst::Dispatcher::$public_method_name,\n"
 740                     . "  this will be removed in Catalyst 5.9X\n");
 741             };
 742         });
 743     }
 744 }
 745 # End 5.70 backwards compatibility hacks.
 746
 747 __PACKAGE__->meta->make_immutable;
 748
 749 =head2 meta
 750
 751 Provided by Moose
 752
 753 =head1 AUTHORS
 754
 755 Catalyst Contributors, see Catalyst.pm
 756
 757 =head1 COPYRIGHT
 758
 759 This library is free software. You can redistribute it and/or modify it under
 760 the same terms as Perl itself.
 761
 762 =cut
 763
 764 1;