/usr/share/perl5/Class/Data/Inheritable.pm is in libclass-data-inheritable-perl 0.08-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 | package Class::Data::Inheritable;
use strict qw(vars subs);
use vars qw($VERSION);
$VERSION = '0.08';
sub mk_classdata {
my ($declaredclass, $attribute, $data) = @_;
if( ref $declaredclass ) {
require Carp;
Carp::croak("mk_classdata() is a class method, not an object method");
}
my $accessor = sub {
my $wantclass = ref($_[0]) || $_[0];
return $wantclass->mk_classdata($attribute)->(@_)
if @_>1 && $wantclass ne $declaredclass;
$data = $_[1] if @_>1;
return $data;
};
my $alias = "_${attribute}_accessor";
*{$declaredclass.'::'.$attribute} = $accessor;
*{$declaredclass.'::'.$alias} = $accessor;
}
1;
__END__
=head1 NAME
Class::Data::Inheritable - Inheritable, overridable class data
=head1 SYNOPSIS
package Stuff;
use base qw(Class::Data::Inheritable);
# Set up DataFile as inheritable class data.
Stuff->mk_classdata('DataFile');
# Declare the location of the data file for this class.
Stuff->DataFile('/etc/stuff/data');
# Or, all in one shot:
Stuff->mk_classdata(DataFile => '/etc/stuff/data');
=head1 DESCRIPTION
Class::Data::Inheritable is for creating accessor/mutators to class
data. That is, if you want to store something about your class as a
whole (instead of about a single object). This data is then inherited
by your subclasses and can be overridden.
For example:
Pere::Ubu->mk_classdata('Suitcase');
will generate the method Suitcase() in the class Pere::Ubu.
This new method can be used to get and set a piece of class data.
Pere::Ubu->Suitcase('Red');
$suitcase = Pere::Ubu->Suitcase;
The interesting part happens when a class inherits from Pere::Ubu:
package Raygun;
use base qw(Pere::Ubu);
# Raygun's suitcase is Red.
$suitcase = Raygun->Suitcase;
Raygun inherits its Suitcase class data from Pere::Ubu.
Inheritance of class data works analogous to method inheritance. As
long as Raygun does not "override" its inherited class data (by using
Suitcase() to set a new value) it will continue to use whatever is set
in Pere::Ubu and inherit further changes:
# Both Raygun's and Pere::Ubu's suitcases are now Blue
Pere::Ubu->Suitcase('Blue');
However, should Raygun decide to set its own Suitcase() it has now
"overridden" Pere::Ubu and is on its own, just like if it had
overridden a method:
# Raygun has an orange suitcase, Pere::Ubu's is still Blue.
Raygun->Suitcase('Orange');
Now that Raygun has overridden Pere::Ubu futher changes by Pere::Ubu
no longer effect Raygun.
# Raygun still has an orange suitcase, but Pere::Ubu is using Samsonite.
Pere::Ubu->Suitcase('Samsonite');
=head1 Methods
=head2 mk_classdata
Class->mk_classdata($data_accessor_name);
Class->mk_classdata($data_accessor_name => $value);
This is a class method used to declare new class data accessors.
A new accessor will be created in the Class using the name from
$data_accessor_name, and optionally initially setting it to the given
value.
To facilitate overriding, mk_classdata creates an alias to the
accessor, _field_accessor(). So Suitcase() would have an alias
_Suitcase_accessor() that does the exact same thing as Suitcase().
This is useful if you want to alter the behavior of a single accessor
yet still get the benefits of inheritable class data. For example.
sub Suitcase {
my($self) = shift;
warn "Fashion tragedy" if @_ and $_[0] eq 'Plaid';
$self->_Suitcase_accessor(@_);
}
=head1 AUTHOR
Original code by Damian Conway.
Maintained by Michael G Schwern until September 2005.
Now maintained by Tony Bowden.
=head1 BUGS and QUERIES
Please direct all correspondence regarding this module to:
bug-Class-Data-Inheritable@rt.cpan.org
=head1 COPYRIGHT and LICENSE
Copyright (c) 2000-2005, Damian Conway and Michael G Schwern.
All Rights Reserved.
This module is free software. It may be used, redistributed and/or
modified under the same terms as Perl itself.
=head1 SEE ALSO
L<perltooc> has a very elaborate discussion of class data in Perl.
|