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