1package KinoSearch1::Util::Class; 2use strict; 3use warnings; 4use KinoSearch1::Util::ToolSet; 5 6use KinoSearch1::Util::VerifyArgs qw( verify_args kerror ); 7 8sub new { 9 my $class = shift; # leave the rest of @_ intact. 10 11 # find a defaults hash and verify args 12 $class = ref($class) || $class; 13 my $defaults; 14 { 15 no strict 'refs'; 16 $defaults = \%{ $class . '::instance_vars' }; 17 } 18 if ( !verify_args( $defaults, @_ ) ) { 19 # if a user-based subclass, find KinoSearch1 parent class and verify. 20 my $kinoclass = _traverse_at_isa($class); 21 confess kerror() unless $kinoclass; 22 { 23 no strict 'refs'; 24 $defaults = \%{ $kinoclass . '::instance_vars' }; 25 } 26 confess kerror() unless verify_args( $defaults, @_ ); 27 } 28 29 # merge var => val pairs into new object, call customizable init routine 30 my $self = bless { %$defaults, @_ }, $class; 31 $self->init_instance; 32 33 return $self; 34} 35 36# Walk @ISA until a parent class starting with 'KinoSearch1::' is found. 37sub _traverse_at_isa { 38 my $orig = shift; 39 { 40 no strict 'refs'; 41 my $at_isa = \@{ $orig . '::ISA' }; 42 for my $parent (@$at_isa) { 43 return $parent if $parent =~ /^KinoSearch1::/; 44 my $grand_parent = _traverse_at_isa($parent); 45 return $grand_parent if $grand_parent; 46 } 47 }; 48 return ''; 49} 50 51sub init_instance { } 52 53sub init_instance_vars { 54 my $package = shift; 55 56 no strict 'refs'; 57 no warnings 'once'; 58 my $first_isa = ${ $package . '::ISA' }[0]; 59 %{ $package . '::instance_vars' } 60 = ( %{ $first_isa . '::instance_vars' }, @_ ); 61} 62 63sub ready_get_set { 64 ready_get(@_); 65 ready_set(@_); 66} 67 68sub ready_get { 69 my $package = shift; 70 no strict 'refs'; 71 for my $member (@_) { 72 *{ $package . "::get_$member" } = sub { return $_[0]->{$member} }; 73 } 74} 75 76sub ready_set { 77 my $package = shift; 78 no strict 'refs'; 79 for my $member (@_) { 80 *{ $package . "::set_$member" } = sub { $_[0]->{$member} = $_[1] }; 81 } 82} 83 84=for Rationale: 85KinoSearch1 is not thread-safe. Among other things, the C-struct-based classes 86cause segfaults or bus errors when their data gets double-freed by DESTROY. 87Therefore, CLONE dies with a user-friendly error message before that happens. 88 89=cut 90 91sub CLONE { 92 my $package = shift; 93 die( "CLONE invoked by package '$package', indicating that threads " 94 . "or Win32 fork were initiated, but KinoSearch1 is not thread-safe" 95 ); 96} 97 98sub abstract_death { 99 my ( undef, $filename, $line, $methodname ) = caller(1); 100 die "ERROR: $methodname', called at $filename line $line, is an " 101 . "abstract method and must be defined in a subclass"; 102} 103 104sub unimplemented_death { 105 my ( undef, $filename, $line, $methodname ) = caller(1); 106 die "ERROR: $methodname, called at $filename line $line, is " 107 . "intentionally unimplemented in KinoSearch1, though it is part " 108 . "of Lucene"; 109} 110 111sub todo_death { 112 my ( undef, $filename, $line, $methodname ) = caller(1); 113 die "ERROR: $methodname, called at $filename line $line, is not " 114 . "implemented yet in KinoSearch1, but is on the todo list"; 115} 116 1171; 118 119__END__ 120 121==begin devdocs 122 123==head1 NAME 124 125KinoSearch1::Util::Class - class building utility 126 127==head1 SYNOPSIS 128 129 package KinoSearch1::SomePackage::SomeClass; 130 use base qw( KinoSearch1::Util::Class ); 131 132 BEGIN { 133 __PACKAGE__->init_instance_vars( 134 # constructor params / members 135 foo => undef, 136 bar => {}, 137 138 # members 139 baz => {}, 140 ); 141 } 142 143==head1 DESCRIPTION 144 145KinoSearch1::Util::Class is a class-building utility a la 146L<Class::Accessor|Class::Accessor>, L<Class::Meta|Class::Meta>, etc. It 147provides four main services: 148 149==over 150 151==item 1 152 153A mechanism for inheriting instance variable declarations. 154 155==item 2 156 157A constructor with basic argument checking. 158 159==item 3 160 161Manufacturing of get_xxxx and set_xxxx methods. 162 163==item 4 164 165Convenience methods which help in defining abstract classes. 166 167==back 168 169==head1 VARIABLES 170 171==head2 %instance_vars 172 173The %instance_vars hash, which is always a package global, serves as a 174template for the creation of a hash-based object. It is built up from all the 175%instance_vars hashes in the module's parent classes, using 176init_instance_vars(). 177 178Key-value pairs in an %instance_vars hash are labeled as "constructor params" 179and/or "members". Items which are labeled as constructor params can be used 180as arguments to new(). 181 182 BEGIN { 183 __PACKAGE__->init_instance_vars( 184 # constructor params / members 185 foo => undef, 186 bar => 10, 187 # members 188 baz => '', 189 ); 190 } 191 192 # ok: specifies foo, uses default for bar, derives baz 193 my $object = __PACKAGE__->new( foo => $foo ); 194 195 # not ok: baz isn't a constructor param 196 my $object = __PACKAGE__->new( baz => $baz ); 197 198 # ok if a parent class defines boffo as a constructor param 199 my $object = __PACKAGE__->new( 200 foo => $foo, 201 boffo => $boffo, 202 ); 203 204%instance_vars may only contain scalar values, as the defaults are merged 205into the object using a shallow copy. 206 207init_instance_vars() must be called from within a BEGIN block and before any 208C<use> directives load a child class -- if children are born before their 209parents, inheritance gets screwed up. 210 211==head1 METHODS 212 213==head2 new 214 215A generic constructor with basic argument checking. new() expects hash-style 216labeled parameters; the label names must be present in the %instance_vars 217hash, or it will croak(). 218 219After verifying the labeled parameters, new() merges %instance_vars and @_ 220into a new object. It then calls $self->init_instance() before returning the 221blessed reference. 222 223==head2 init_instance 224 225 $self->init_instance(); 226 227Perform customized initialization routine. By default, this is a no-op. 228 229==head2 init_instance_vars 230 231 BEGIN { 232 __PACKAGE__->init_instance_vars( 233 a_safe_variable_name_that_wont_clash => 1, 234 freep_warble => undef, 235 ); 236 } 237 238Package method only. Creates a package global %instance_vars hash in the 239passed in package which consists of the passed in arguments plus all the 240key-value pairs in the parent class's %instance_vars hash. 241 242==head2 ready_get_set ready_get ready_set 243 244 # create get_foo(), set_foo(), get_bar(), set_bar() in __PACKAGE__ 245 BEGIN { __PACKAGE__->ready_get_set(qw( foo bar )) }; 246 247Mass manufacture getters and setters. The setters do not return a meaningful 248value. 249 250==head2 abstract_death unimplemented_death todo_death 251 252 sub an_abstract_method { shift->abstract_death } 253 sub an_unimplemented_method { shift->unimplemented_death } 254 sub maybe_someday { shift->todo_death } 255 256These are just different ways to die(), and are of little interest until your 257particular application comes face to face with one of them. 258 259abstract_death indicates that a method must be defined in a subclass. 260 261unimplemented_death indicates a feature/function that will probably not be 262implemented. Typically, this would appear for a sub that a developer 263intimately familiar with Lucene would expect to find. 264 265todo_death indicates a feature that might get implemented someday. 266 267==head1 COPYRIGHT 268 269Copyright 2005-2010 Marvin Humphrey 270 271==head1 LICENSE, DISCLAIMER, BUGS, etc. 272 273See L<KinoSearch1> version 1.01. 274 275==end devdocs 276==cut 277 278