lib/Object/Accessor.pm

   1 package Object::Accessor;
   2
   3 use strict;
   4 use Carp            qw[carp croak];
   5 use vars            qw[$FATAL $DEBUG $AUTOLOAD $VERSION];
   6 use Params::Check   qw[allow];
   7 use Data::Dumper;
   8
   9 ### some objects might have overload enabled, we'll need to
  10 ### disable string overloading for callbacks
  11 require overload;
  12
  13 $VERSION    = '0.32';
  14 $FATAL      = 0;
  15 $DEBUG      = 0;
  16
  17 use constant VALUE => 0;    # array index in the hash value
  18 use constant ALLOW => 1;    # array index in the hash value
  19
  20 =head1 NAME
  21
  22 Object::Accessor
  23
  24 =head1 SYNOPSIS
  25
  26     ### using the object
  27     $obj = Object::Accessor->new;        # create object
  28     $obj = Object::Accessor->new(@list); # create object with accessors
  29     $obj = Object::Accessor->new(\%h);   # create object with accessors
  30                                          # and their allow handlers
  31
  32     $bool   = $obj->mk_accessors('foo'); # create accessors
  33     $bool   = $obj->mk_accessors(        # create accessors with input
  34                {foo => ALLOW_HANDLER} ); # validation
  35
  36     $clone  = $obj->mk_clone;            # create a clone of original
  37                                          # object without data
  38     $bool   = $obj->mk_flush;            # clean out all data
  39
  40     @list   = $obj->ls_accessors;        # retrieves a list of all
  41                                          # accessors for this object
  42
  43     $bar    = $obj->foo('bar');          # set 'foo' to 'bar'
  44     $bar    = $obj->foo();               # retrieve 'bar' again
  45
  46     $sub    = $obj->can('foo');          # retrieve coderef for
  47                                          # 'foo' accessor
  48     $bar    = $sub->('bar');             # set 'foo' via coderef
  49     $bar    = $sub->();                  # retrieve 'bar' by coderef
  50
  51     ### using the object as base class
  52     package My::Class;
  53     use base 'Object::Accessor';
  54
  55     $obj    = My::Class->new;               # create base object
  56     $bool   = $obj->mk_accessors('foo');    # create accessors, etc...
  57
  58     ### make all attempted access to non-existant accessors fatal
  59     ### (defaults to false)
  60     $Object::Accessor::FATAL = 1;
  61
  62     ### enable debugging
  63     $Object::Accessor::DEBUG = 1;
  64
  65     ### advanced usage -- callbacks
  66     {   my $obj = Object::Accessor->new('foo');
  67         $obj->register_callback( sub { ... } );
  68
  69         $obj->foo( 1 ); # these calls invoke the callback you registered
  70         $obj->foo()     # which allows you to change the get/set
  71                         # behaviour and what is returned to the caller.
  72     }
  73
  74     ### advanced usage -- lvalue attributes
  75     {   my $obj = Object::Accessor::Lvalue->new('foo');
  76         print $obj->foo = 1;            # will print 1
  77     }
  78
  79     ### advanced usage -- scoped attribute values
  80     {   my $obj = Object::Accessor->new('foo');
  81
  82         $obj->foo( 1 );
  83         print $obj->foo;                # will print 1
  84
  85         ### bind the scope of the value of attribute 'foo'
  86         ### to the scope of '$x' -- when $x goes out of
  87         ### scope, 'foo's previous value will be restored
  88         {   $obj->foo( 2 => \my $x );
  89             print $obj->foo, ' ', $x;   # will print '2 2'
  90         }
  91         print $obj->foo;                # will print 1
  92     }
  93
  94
  95 =head1 DESCRIPTION
  96
  97 C<Object::Accessor> provides an interface to create per object
  98 accessors (as opposed to per C<Class> accessors, as, for example,
  99 C<Class::Accessor> provides).
 100
 101 You can choose to either subclass this module, and thus using its
 102 accessors on your own module, or to store an C<Object::Accessor>
 103 object inside your own object, and access the accessors from there.
 104 See the C<SYNOPSIS> for examples.
 105
 106 =head1 METHODS
 107
 108 =head2 $object = Object::Accessor->new( [ARGS] );
 109
 110 Creates a new (and empty) C<Object::Accessor> object. This method is
 111 inheritable.
 112
 113 Any arguments given to C<new> are passed straight to C<mk_accessors>.
 114
 115 If you want to be able to assign to your accessors as if they
 116 were C<lvalue>s, you should create your object in the
 117 C<Object::Acccessor::Lvalue> namespace instead. See the section
 118 on C<LVALUE ACCESSORS> below.
 119
 120 =cut
 121
 122 sub new {
 123     my $class   = shift;
 124     my $obj     = bless {}, $class;
 125
 126     $obj->mk_accessors( @_ ) if @_;
 127
 128     return $obj;
 129 }
 130
 131 =head2 $bool = $object->mk_accessors( @ACCESSORS | \%ACCESSOR_MAP );
 132
 133 Creates a list of accessors for this object (and C<NOT> for other ones
 134 in the same class!).
 135 Will not clobber existing data, so if an accessor already exists,
 136 requesting to create again is effectively a C<no-op>.
 137
 138 When providing a C<hashref> as argument, rather than a normal list,
 139 you can specify a list of key/value pairs of accessors and their
 140 respective input validators. The validators can be anything that
 141 C<Params::Check>'s C<allow> function accepts. Please see its manpage
 142 for details.
 143
 144 For example:
 145
 146     $object->mk_accessors( {
 147         foo     => qr/^\d+$/,       # digits only
 148         bar     => [0,1],           # booleans
 149         zot     => \&my_sub         # a custom verification sub
 150     } );
 151
 152 Returns true on success, false on failure.
 153
 154 Accessors that are called on an object, that do not exist return
 155 C<undef> by default, but you can make this a fatal error by setting the
 156 global variable C<$FATAL> to true. See the section on C<GLOBAL
 157 VARIABLES> for details.
 158
 159 Note that you can bind the values of attributes to a scope. This allows
 160 you to C<temporarily> change a value of an attribute, and have it's
 161 original value restored up on the end of it's bound variable's scope;
 162
 163 For example, in this snippet of code, the attribute C<foo> will
 164 temporarily be set to C<2>, until the end of the scope of C<$x>, at
 165 which point the original value of C<1> will be restored.
 166
 167     my $obj = Object::Accessor->new;
 168
 169     $obj->mk_accessors('foo');
 170     $obj->foo( 1 );
 171     print $obj->foo;                # will print 1
 172
 173     ### bind the scope of the value of attribute 'foo'
 174     ### to the scope of '$x' -- when $x goes out of
 175     ### scope, 'foo' previous value will be restored
 176     {   $obj->foo( 2 => \my $x );
 177         print $obj->foo, ' ', $x;   # will print '2 2'
 178     }
 179     print $obj->foo;                # will print 1
 180
 181
 182 Note that all accessors are read/write for everyone. See the C<TODO>
 183 section for details.
 184
 185 =cut
 186
 187 sub mk_accessors {
 188     my $self    = $_[0];
 189     my $is_hash = UNIVERSAL::isa( $_[1], 'HASH' );
 190
 191     ### first argument is a hashref, which means key/val pairs
 192     ### as keys + allow handlers
 193     for my $acc ( $is_hash ? keys %{$_[1]} : @_[1..$#_] ) {
 194
 195         ### already created apparently
 196         if( exists $self->{$acc} ) {
 197             __PACKAGE__->___debug( "Accessor '$acc' already exists");
 198             next;
 199         }
 200
 201         __PACKAGE__->___debug( "Creating accessor '$acc'");
 202
 203         ### explicitly vivify it, so that exists works in ls_accessors()
 204         $self->{$acc}->[VALUE] = undef;
 205
 206         ### set the allow handler only if one was specified
 207         $self->{$acc}->[ALLOW] = $_[1]->{$acc} if $is_hash;
 208     }
 209
 210     return 1;
 211 }
 212
 213 =head2 @list = $self->ls_accessors;
 214
 215 Returns a list of accessors that are supported by the current object.
 216 The corresponding coderefs can be retrieved by passing this list one
 217 by one to the C<can> method.
 218
 219 =cut
 220
 221 sub ls_accessors {
 222     ### metainformation is stored in the stringified
 223     ### key of the object, so skip that when listing accessors
 224     return sort grep { $_ ne "$_[0]" } keys %{$_[0]};
 225 }
 226
 227 =head2 $ref = $self->ls_allow(KEY)
 228
 229 Returns the allow handler for the given key, which can be used with
 230 C<Params::Check>'s C<allow()> handler. If there was no allow handler
 231 specified, an allow handler that always returns true will be returned.
 232
 233 =cut
 234
 235 sub ls_allow {
 236     my $self = shift;
 237     my $key  = shift or return;
 238     return exists $self->{$key}->[ALLOW]
 239                 ? $self->{$key}->[ALLOW]
 240                 : sub { 1 };
 241 }
 242
 243 =head2 $clone = $self->mk_clone;
 244
 245 Makes a clone of the current object, which will have the exact same
 246 accessors as the current object, but without the data stored in them.
 247
 248 =cut
 249
 250 ### XXX this creates an object WITH allow handlers at all times.
 251 ### even if the original didnt
 252 sub mk_clone {
 253     my $self    = $_[0];
 254     my $class   = ref $self;
 255
 256     my $clone   = $class->new;
 257
 258     ### split out accessors with and without allow handlers, so we
 259     ### don't install dummy allow handers (which makes O::A::lvalue
 260     ### warn for exampel)
 261     my %hash; my @list;
 262     for my $acc ( $self->ls_accessors ) {
 263         my $allow = $self->{$acc}->[ALLOW];
 264         $allow ? $hash{$acc} = $allow : push @list, $acc;
 265     }
 266
 267     ### copy the accessors from $self to $clone
 268     $clone->mk_accessors( \%hash ) if %hash;
 269     $clone->mk_accessors( @list  ) if @list;
 270
 271     ### copy callbacks
 272     #$clone->{"$clone"} = $self->{"$self"} if $self->{"$self"};
 273     $clone->___callback( $self->___callback );
 274
 275     return $clone;
 276 }
 277
 278 =head2 $bool = $self->mk_flush;
 279
 280 Flushes all the data from the current object; all accessors will be
 281 set back to their default state of C<undef>.
 282
 283 Returns true on success and false on failure.
 284
 285 =cut
 286
 287 sub mk_flush {
 288     my $self = $_[0];
 289
 290     # set each accessor's data to undef
 291     $self->{$_}->[VALUE] = undef for $self->ls_accessors;
 292
 293     return 1;
 294 }
 295
 296 =head2 $bool = $self->mk_verify;
 297
 298 Checks if all values in the current object are in accordance with their
 299 own allow handler. Specifically useful to check if an empty initialised
 300 object has been filled with values satisfying their own allow criteria.
 301
 302 =cut
 303
 304 sub mk_verify {
 305     my $self = $_[0];
 306
 307     my $fail;
 308     for my $name ( $self->ls_accessors ) {
 309         unless( allow( $self->$name, $self->ls_allow( $name ) ) ) {
 310             my $val = defined $self->$name ? $self->$name : '<undef>';
 311
 312             __PACKAGE__->___error("'$name' ($val) is invalid");
 313             $fail++;
 314         }
 315     }
 316
 317     return if $fail;
 318     return 1;
 319 }
 320
 321 =head2 $bool = $self->register_callback( sub { ... } );
 322
 323 This method allows you to register a callback, that is invoked
 324 every time an accessor is called. This allows you to munge input
 325 data, access external data stores, etc.
 326
 327 You are free to return whatever you wish. On a C<set> call, the
 328 data is even stored in the object.
 329
 330 Below is an example of the use of a callback.
 331
 332     $object->some_method( "some_value" );
 333
 334     my $callback = sub {
 335         my $self    = shift; # the object
 336         my $meth    = shift; # "some_method"
 337         my $val     = shift; # ["some_value"]
 338                              # could be undef -- check 'exists';
 339                              # if scalar @$val is empty, it was a 'get'
 340
 341         # your code here
 342
 343         return $new_val;     # the value you want to be set/returned
 344     }
 345
 346 To access the values stored in the object, circumventing the
 347 callback structure, you should use the C<___get> and C<___set> methods
 348 documented further down.
 349
 350 =cut
 351
 352 sub register_callback {
 353     my $self    = shift;
 354     my $sub     = shift or return;
 355
 356     ### use the memory address as key, it's not used EVER as an
 357     ### accessor --kane
 358     $self->___callback( $sub );
 359
 360     return 1;
 361 }
 362
 363
 364 =head2 $bool = $self->can( METHOD_NAME )
 365
 366 This method overrides C<UNIVERAL::can> in order to provide coderefs to
 367 accessors which are loaded on demand. It will behave just like
 368 C<UNIVERSAL::can> where it can -- returning a class method if it exists,
 369 or a closure pointing to a valid accessor of this particular object.
 370
 371 You can use it as follows:
 372
 373     $sub = $object->can('some_accessor');   # retrieve the coderef
 374     $sub->('foo');                          # 'some_accessor' now set
 375                                             # to 'foo' for $object
 376     $foo = $sub->();                        # retrieve the contents
 377                                             # of 'some_accessor'
 378
 379 See the C<SYNOPSIS> for more examples.
 380
 381 =cut
 382
 383 ### custom 'can' as UNIVERSAL::can ignores autoload
 384 sub can {
 385     my($self, $method) = @_;
 386
 387     ### it's one of our regular methods
 388     if( $self->UNIVERSAL::can($method) ) {
 389         __PACKAGE__->___debug( "Can '$method' -- provided by package" );
 390         return $self->UNIVERSAL::can($method);
 391     }
 392
 393     ### it's an accessor we provide;
 394     if( UNIVERSAL::isa( $self, 'HASH' ) and exists $self->{$method} ) {
 395         __PACKAGE__->___debug( "Can '$method' -- provided by object" );
 396         return sub { $self->$method(@_); }
 397     }
 398
 399     ### we don't support it
 400     __PACKAGE__->___debug( "Cannot '$method'" );
 401     return;
 402 }
 403
 404 ### don't autoload this
 405 sub DESTROY { 1 };
 406
 407 ### use autoload so we can have per-object accessors,
 408 ### not per class, as that is incorrect
 409 sub AUTOLOAD {
 410     my $self    = shift;
 411     my($method) = ($AUTOLOAD =~ /([^:']+$)/);
 412
 413     my $val = $self->___autoload( $method, @_ ) or return;
 414
 415     return $val->[0];
 416 }
 417
 418 sub ___autoload {
 419     my $self    = shift;
 420     my $method  = shift;
 421     my $assign  = scalar @_;    # is this an assignment?
 422
 423     ### a method on our object
 424     if( UNIVERSAL::isa( $self, 'HASH' ) ) {
 425         if ( not exists $self->{$method} ) {
 426             __PACKAGE__->___error("No such accessor '$method'", 1);
 427             return;
 428         }
 429
 430     ### a method on something else, die with a descriptive error;
 431     } else {
 432         local $FATAL = 1;
 433         __PACKAGE__->___error(
 434                 "You called '$AUTOLOAD' on '$self' which was interpreted by ".
 435                 __PACKAGE__ . " as an object call. Did you mean to include ".
 436                 "'$method' from somewhere else?", 1 );
 437     }
 438
 439     ### assign?
 440     my $val = $assign ? shift(@_) : $self->___get( $method );
 441
 442     if( $assign ) {
 443
 444         ### any binding?
 445         if( $_[0] ) {
 446             if( ref $_[0] and UNIVERSAL::isa( $_[0], 'SCALAR' ) ) {
 447
 448                 ### tie the reference, so we get an object and
 449                 ### we can use it's going out of scope to restore
 450                 ### the old value
 451                 my $cur = $self->{$method}->[VALUE];
 452
 453                 tie ${$_[0]}, __PACKAGE__ . '::TIE',
 454                         sub { $self->$method( $cur ) };
 455
 456                 ${$_[0]} = $val;
 457
 458             } else {
 459                 __PACKAGE__->___error(
 460                     "Can not bind '$method' to anything but a SCALAR", 1
 461                 );
 462             }
 463         }
 464
 465         ### need to check the value?
 466         if( exists $self->{$method}->[ALLOW] ) {
 467
 468             ### double assignment due to 'used only once' warnings
 469             local $Params::Check::VERBOSE = 0;
 470             local $Params::Check::VERBOSE = 0;
 471
 472             allow( $val, $self->{$method}->[ALLOW] ) or (
 473                 __PACKAGE__->___error(
 474                     "'$val' is an invalid value for '$method'", 1),
 475                 return
 476             );
 477         }
 478     }
 479
 480     ### callbacks?
 481     if( my $sub = $self->___callback ) {
 482         $val = eval { $sub->( $self, $method, ($assign ? [$val] : []) ) };
 483
 484         ### register the error
 485         $self->___error( $@, 1 ), return if $@;
 486     }
 487
 488     ### now we can actually assign it
 489     if( $assign ) {
 490         $self->___set( $method, $val ) or return;
 491     }
 492
 493     return [$val];
 494 }
 495
 496 =head2 $val = $self->___get( METHOD_NAME );
 497
 498 Method to directly access the value of the given accessor in the
 499 object. It circumvents all calls to allow checks, callbakcs, etc.
 500
 501 Use only if you C<Know What You Are Doing>! General usage for
 502 this functionality would be in your own custom callbacks.
 503
 504 =cut
 505
 506 ### XXX O::A::lvalue is mirroring this behaviour! if this
 507 ### changes, lvalue's autoload must be changed as well
 508 sub ___get {
 509     my $self    = shift;
 510     my $method  = shift or return;
 511     return $self->{$method}->[VALUE];
 512 }
 513
 514 =head2 $bool = $self->___set( METHOD_NAME => VALUE );
 515
 516 Method to directly set the value of the given accessor in the
 517 object. It circumvents all calls to allow checks, callbakcs, etc.
 518
 519 Use only if you C<Know What You Are Doing>! General usage for
 520 this functionality would be in your own custom callbacks.
 521
 522 =cut
 523
 524 sub ___set {
 525     my $self    = shift;
 526     my $method  = shift or return;
 527
 528     ### you didn't give us a value to set!
 529     exists $_[0] or return;
 530     my $val     = shift;
 531
 532     ### if there's more arguments than $self, then
 533     ### replace the method called by the accessor.
 534     ### XXX implement rw vs ro accessors!
 535     $self->{$method}->[VALUE] = $val;
 536
 537     return 1;
 538 }
 539
 540 sub ___debug {
 541     return unless $DEBUG;
 542
 543     my $self = shift;
 544     my $msg  = shift;
 545     my $lvl  = shift || 0;
 546
 547     local $Carp::CarpLevel += 1;
 548
 549     carp($msg);
 550 }
 551
 552 sub ___error {
 553     my $self = shift;
 554     my $msg  = shift;
 555     my $lvl  = shift || 0;
 556     local $Carp::CarpLevel += ($lvl + 1);
 557     $FATAL ? croak($msg) : carp($msg);
 558 }
 559
 560 ### objects might be overloaded.. if so, we can't trust what "$self"
 561 ### will return, which might get *really* painful.. so check for that
 562 ### and get their unoverloaded stringval if needed.
 563 sub ___callback {
 564     my $self = shift;
 565     my $sub  = shift;
 566
 567     my $mem  = overload::Overloaded( $self )
 568                 ? overload::StrVal( $self )
 569                 : "$self";
 570
 571     $self->{$mem} = $sub if $sub;
 572
 573     return $self->{$mem};
 574 }
 575
 576 =head1 LVALUE ACCESSORS
 577
 578 C<Object::Accessor> supports C<lvalue> attributes as well. To enable
 579 these, you should create your objects in the designated namespace,
 580 C<Object::Accessor::Lvalue>. For example:
 581
 582     my $obj = Object::Accessor::Lvalue->new('foo');
 583     $obj->foo += 1;
 584     print $obj->foo;
 585
 586 will actually print C<1> and work as expected. Since this is an
 587 optional feature, that's not desirable in all cases, we require
 588 you to explicitly use the C<Object::Accessor::Lvalue> class.
 589
 590 Doing the same on the standard C<Object>>Accessor> class would
 591 generate the following code & errors:
 592
 593     my $obj = Object::Accessor->new('foo');
 594     $obj->foo += 1;
 595
 596     Can't modify non-lvalue subroutine call
 597
 598 Note that C<lvalue> support on C<AUTOLOAD> routines is a
 599 C<perl 5.8.x> feature. See perldoc L<perl58delta> for details.
 600
 601 =head2 CAVEATS
 602
 603 =over 4
 604
 605 =item * Allow handlers
 606
 607 Due to the nature of C<lvalue subs>, we never get access to the
 608 value you are assigning, so we can not check it againt your allow
 609 handler. Allow handlers are therefor unsupported under C<lvalue>
 610 conditions.
 611
 612 See C<perldoc perlsub> for details.
 613
 614 =item * Callbacks
 615
 616 Due to the nature of C<lvalue subs>, we never get access to the
 617 value you are assigning, so we can not check provide this value
 618 to your callback. Furthermore, we can not distinguish between
 619 a C<get> and a C<set> call. Callbacks are therefor unsupported
 620 under C<lvalue> conditions.
 621
 622 See C<perldoc perlsub> for details.
 623
 624
 625 =cut
 626
 627 {   package Object::Accessor::Lvalue;
 628     use base 'Object::Accessor';
 629     use strict;
 630     use vars qw[$AUTOLOAD];
 631
 632     ### constants needed to access values from the objects
 633     *VALUE = *Object::Accessor::VALUE;
 634     *ALLOW = *Object::Accessor::ALLOW;
 635
 636     ### largely copied from O::A::Autoload
 637     sub AUTOLOAD : lvalue {
 638         my $self    = shift;
 639         my($method) = ($AUTOLOAD =~ /([^:']+$)/);
 640
 641         $self->___autoload( $method, @_ ) or return;
 642
 643         ### *dont* add return to it, or it won't be stored
 644         ### see perldoc perlsub on lvalue subs
 645         ### XXX can't use $self->___get( ... ), as we MUST have
 646         ### the container that's used for the lvalue assign as
 647         ### the last statement... :(
 648         $self->{$method}->[ VALUE() ];
 649     }
 650
 651     sub mk_accessors {
 652         my $self    = shift;
 653         my $is_hash = UNIVERSAL::isa( $_[0], 'HASH' );
 654
 655         $self->___error(
 656             "Allow handlers are not supported for '". __PACKAGE__ ."' objects"
 657         ) if $is_hash;
 658
 659         return $self->SUPER::mk_accessors( @_ );
 660     }
 661
 662     sub register_callback {
 663         my $self = shift;
 664         $self->___error(
 665             "Callbacks are not supported for '". __PACKAGE__ ."' objects"
 666         );
 667         return;
 668     }
 669 }
 670
 671
 672 ### standard tie class for bound attributes
 673 {   package Object::Accessor::TIE;
 674     use Tie::Scalar;
 675     use Data::Dumper;
 676     use base 'Tie::StdScalar';
 677
 678     my %local = ();
 679
 680     sub TIESCALAR {
 681         my $class   = shift;
 682         my $sub     = shift;
 683         my $ref     = undef;
 684         my $obj     =  bless \$ref, $class;
 685
 686         ### store the restore sub
 687         $local{ $obj } = $sub;
 688         return $obj;
 689     }
 690
 691     sub DESTROY {
 692         my $tied    = shift;
 693         my $sub     = delete $local{ $tied };
 694
 695         ### run the restore sub to set the old value back
 696         return $sub->();
 697     }
 698 }
 699
 700 =head1 GLOBAL VARIABLES
 701
 702 =head2 $Object::Accessor::FATAL
 703
 704 Set this variable to true to make all attempted access to non-existant
 705 accessors be fatal.
 706 This defaults to C<false>.
 707
 708 =head2 $Object::Accessor::DEBUG
 709
 710 Set this variable to enable debugging output.
 711 This defaults to C<false>.
 712
 713 =head1 TODO
 714
 715 =head2 Create read-only accessors
 716
 717 Currently all accessors are read/write for everyone. Perhaps a future
 718 release should make it possible to have read-only accessors as well.
 719
 720 =head1 CAVEATS
 721
 722 If you use codereferences for your allow handlers, you will not be able
 723 to freeze the data structures using C<Storable>.
 724
 725 Due to a bug in storable (until at least version 2.15), C<qr//> compiled
 726 regexes also don't de-serialize properly. Although this bug has been
 727 reported, you should be aware of this issue when serializing your objects.
 728
 729 You can track the bug here:
 730
 731     http://rt.cpan.org/Ticket/Display.html?id=1827
 732
 733 =head1 AUTHOR
 734
 735 This module by
 736 Jos Boumans E<lt>kane@cpan.orgE<gt>.
 737
 738 =head1 COPYRIGHT
 739
 740 This module is
 741 copyright (c) 2004-2005 Jos Boumans E<lt>kane@cpan.orgE<gt>.
 742 All rights reserved.
 743
 744 This library is free software;
 745 you may redistribute and/or modify it under the same
 746 terms as Perl itself.
 747
 748 =cut
 749
 750 1;