1package Class::Std::Utils; 2 3use version; $VERSION = qv('0.0.2'); 4 5use warnings; 6use strict; 7use Carp; 8use Scalar::Util qw( refaddr ); 9 10sub import { 11 my $caller = caller; 12 13 no strict qw( refs ); 14 *{ $caller . '::anon_scalar' } = \&anon_scalar; 15 *{ $caller . '::ident' } = \&refaddr; 16 *{ $caller . '::extract_initializers_from' } = \&extract_initializers_from; 17} 18 19sub anon_scalar { return \my $scalar; } 20 21use List::Util qw( first ); 22 23sub extract_initializers_from { 24 my ($arg_ref) = @_; 25 26 my $class_name = caller; 27 28 # Find the class-specific sub-hash (if any)... 29 my $specific_inits_ref 30 = first {defined $_} $arg_ref->{$class_name}, {}; 31 croak "$class_name initializer must be a nested hash" if ref $specific_inits_ref ne 'HASH'; 32 # Return initializers, overriding general initializers from the top level 33 # with any second-level initializers that are specific to the class.... 34 return ( %{$arg_ref}, %{$specific_inits_ref} ); 35} 36 37 381; # Magic true value required at end of module 39__END__ 40 41=head1 NAME 42 43Class::Std::Utils - Utility subroutines for building "inside-out" objects 44 45 46=head1 VERSION 47 48This document describes Class::Std::Utils version 0.0.1 49 50 51=head1 SYNOPSIS 52 53 use Class::Std::Utils; 54 55 # Constructor for anonymous scalars... 56 my $new_object = bless anon_scalar(), $class; 57 58 # Convert an object reference into a unique ID number... 59 my $ID_num = ident $new_object; 60 61 # Extract class-specific arguments from a hash reference... 62 my %args = extract_initializers_from($arg_ref); 63 64 65=head1 DESCRIPTION 66 67This module provides three utility subroutines that simplify the creation of 68"inside-out" classes. See Chapters 15 and 16 of "Perl Best Practices" 69(O'Reilly, 2005) for details. 70 71=head1 INTERFACE 72 73=over 74 75=item C<anon_scalar()> 76 77This subroutine is always exported. It takes no arguments and returns a 78reference to an anonymous scalar, suitable for blessing as an object. 79 80=item C<ident()> 81 82This subroutine is always exported. It takes one argument--a reference-- 83and acts exactly like the C<Scalar::Util::refaddr()>, returning a unique 84integer value suitable for identifying the referent. 85 86=item C<extract_initializers_from()> 87 88This subroutine is always exported. It takes one argument--a hash reference-- 89and returns a "flattened" set of key/value pairs extracted from that hash. 90 91The typical usage is: 92 93 my %class_specific_args = extract_initializers_from($args_ref); 94 95The argument hash is flattened as described in Chapter 16 of "Perl Best 96Practices": 97 98=over 99 100I<The subroutine is always called with the original multi-level argument 101hash from the constructor. It then looks up the class's own name (i.e. 102its C<caller> package) in the argument hash, to see if an initializer 103with that key has been defined. Finally, C<extract_initializers_for()> 104returns the flattened set of key/value pairs for the class's initializer 105set, by appending the class-specific initializer subhash to the end of 106the original generic initializer hash. Appending the specific 107initializers after the generic ones means that any key in the class- 108specific set will override any key in the generic set, thereby ensuring 109that the most relevant initializers are always selected, but that 110generic initializers are still available where no class-specific value 111has been passed in.> 112 113=back 114 115In other words, given: 116 117 my $arg_ref = { 118 key_1 => 'generic value 1', 119 key_2 => 'generic value 2', 120 121 'Base::Class' => { 122 key_1 => 'base value 1' 123 }, 124 125 'Der::Class' => { 126 key_1 => 'der value 1' 127 key_2 => 'der value 2' 128 }, 129 }; 130 131 package Base::Class; 132 use Class::Std::Utils; 133 134 my %base_args = extract_initializers_from($arg_ref); 135 136 package Der::Class; 137 use Class::Std::Utils; 138 139 my %der_args = extract_initializers_from($arg_ref); 140 141then C<%base_args> would be initialized to: 142 143 ( 144 key_1 => 'base value 1', 145 key_2 => 'generic value 2', 146 147 'Base::Class' => { 148 key_1 => 'base value 1', 149 }, 150 151 'Der::Class' => { 152 key_1 => 'der value 1', 153 key_2 => 'der value 2', 154 }, 155 ) 156 157whilst C<%der_args> would be initialized to: 158 159 ( 160 key_1 => 'der value 1', 161 key_2 => 'der value 2', 162 163 'Base::Class' => { 164 key_1 => 'base value 1', 165 }, 166 167 'Der::Class' => { 168 key_1 => 'der value 1', 169 key_2 => 'der value 2', 170 }, 171 ) 172 173That is, the top-level entries would be replaced by any second-level 174entries with the same key that appear in a top-level entry of the same name as 175the calling package. 176 177This means that each class can just refer to C<$args{key_1}> and 178C<$args{key_2}> and be confident that the resulting values will be the 179most specific available for that class. 180 181=back 182 183=head1 DIAGNOSTICS 184 185=over 186 187=item C<< %s initializer must be a nested hash >> 188 189Thrown by C<extract_initializers_from()>. You specified a top-level key 190that has the same name of the current class, but the value of that key 191wasn't a hash reference. 192 193=back 194 195 196=head1 CONFIGURATION AND ENVIRONMENT 197 198Class::Std::Utils requires no configuration files or environment variables. 199 200 201=head1 DEPENDENCIES 202 203Thsi module requires both the C<Scalar::Util> and C<List::Util> modules, 204which are standard in Perl 5.8 and available from the CPAN for earlier 205versions of Perl. 206 207 208=head1 INCOMPATIBILITIES 209 210None reported. 211 212 213=head1 SEE ALSO 214 215The C<Class::Std> module 216 217"Perl Best Practices", O'Reilly, 2005. 218 219 220=head1 BUGS AND LIMITATIONS 221 222No bugs have been reported. 223 224Please report any bugs or feature requests to 225C<bug-class-std-utils@rt.cpan.org>, or through the web interface at 226L<http://rt.cpan.org>. 227 228 229=head1 AUTHOR 230 231Damian Conway C<< <DCONWAY@cpan.org> >> 232 233 234=head1 LICENCE AND COPYRIGHT 235 236Copyright (c) 2005, Damian Conway C<< <DCONWAY@cpan.org> >>. All rights reserved. 237 238This module is free software; you can redistribute it and/or 239modify it under the same terms as Perl itself. 240 241 242=head1 DISCLAIMER OF WARRANTY 243 244BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY 245FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN 246OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES 247PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER 248EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 249WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE 250ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH 251YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL 252NECESSARY SERVICING, REPAIR, OR CORRECTION. 253 254IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 255WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR 256REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE 257LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, 258OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE 259THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING 260RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A 261FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF 262SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF 263SUCH DAMAGES. 264