1package Class::MakeMethods::Emulator::MethodMaker; 2 3use Class::MakeMethods '-isasubclass'; 4require Class::MakeMethods::Emulator; 5 6$VERSION = 1.03; 7 8use strict; 9 10=head1 NAME 11 12Class::MakeMethods::Emulator::MethodMaker - Emulate Class::MethodMaker 13 14 15=head1 SYNOPSIS 16 17 package MyObject; 18 use Class::MakeMethods::Emulator::MethodMaker( 19 new_with_init => 'new', 20 get_set => [ qw / foo bar baz / ]; 21 ); 22 23 ... OR ... 24 25 package MyObject; 26 use Class::MakeMethods::Emulator::MethodMaker '-take_namespace'; 27 use Class::MethodMaker ( 28 new_with_init => 'new', 29 get_set => [ qw / foo bar baz / ]; 30 ); 31 32 33=head1 DESCRIPTION 34 35This module provides emulation of Class::MethodMaker, using the Class::MakeMethods framework. 36 37Although originally based on Class::MethodMaker, the calling convention 38for Class::MakeMethods differs in a variety of ways; most notably, the names 39given to various types of methods have been changed, and the format for 40specifying method attributes has been standardized. This package uses 41the aliasing capability provided by Class::MakeMethods, defining methods 42that modify the declaration arguments as necessary and pass them off to 43various subclasses of Class::MakeMethods. 44 45 46=head1 COMPATIBILITY 47 48Full compatibility is maintained with version 1.03; some of the 49changes in versions 1.04 through 1.10 are not yet included. 50 51The test suite from Class::MethodMaker version 1.10 is included 52with this package, in the t/emulator_class_methodmaker/ directory. 53The unsupported tests have names ending in ".todo". 54 55The tests are unchanged from those in the Class::MethodMaker 56distribution, except for the substitution of 57C<Class::MakeMethods::Emulator::MethodMaker> in the place of 58C<Class::MethodMaker>. 59 60In cases where earlier distributions of Class::MethodMaker contained 61a different version of a test, it is also included. (Note that 62version 0.92's get_concat returned '' for empty values, but in 63version 0.96 this was changed to undef; this emulator follows the 64later behavior. To avoid "use of undefined value" warnings from 65the 0.92 version of get_concat.t, that test has been modified by 66appending a new flag after the name, C<'get_concat --noundef'>, 67which restores the earlier behavior.) 68 69 70=head1 USAGE 71 72There are several ways to call this emulation module: 73 74=over 4 75 76=item * 77 78Direct Access 79 80Replace occurances in your code of C<Class::MethodMaker> with C<Class::MakeMethods::Emulator::MethodMaker>. 81 82=item * 83 84Install Emulation 85 86If you C<use Class::MakeMethods::Emulator::MethodMaker '-take_namespace'>, the Class::MethodMaker namespace will be aliased to this package, and calls to the original package will be transparently handled by this emulator. 87 88To remove the emulation aliasing, call C<use Class::MakeMethods::Emulator::MethodMaker '-release_namespace'>. 89 90B<Note:> This affects B<all> subsequent uses of Class::MethodMaker in your program, including those in other modules, and might cause unexpected effects. 91 92=item * 93 94The -sugar Option 95 96Passing '-sugar' as the first argument in a use or import call will cause the 'methods' package to be declared as an alias to this one. 97 98This allows you to write declarations in the following manner. 99 100 use Class::MakeMethods::Emulator::MethodMaker '-sugar'; 101 102 make methods 103 get_set => [ qw / foo bar baz / ], 104 list => [ qw / a b c / ]; 105 106B<Note:> This feature is deprecated in Class::MethodMaker version 0.96 and later. 107 108=back 109 110=cut 111 112my $emulation_target = 'Class::MethodMaker'; 113 114sub import { 115 my $mm_class = shift; 116 117 if ( scalar @_ and $_[0] =~ /^-take_namespace/ and shift ) { 118 Class::MakeMethods::Emulator::namespace_capture(__PACKAGE__, $emulation_target); 119 } elsif ( scalar @_ and $_[0] =~ /^-release_namespace/ and shift ) { 120 Class::MakeMethods::Emulator::namespace_release(__PACKAGE__, $emulation_target); 121 } 122 123 if ( scalar @_ and $_[0] eq '-sugar' and shift ) { 124 Class::MakeMethods::Emulator::namespace_capture(__PACKAGE__, "methods"); 125 } 126 127 $mm_class->make( @_ ) if ( scalar @_ ); 128} 129 130 131=head1 METHOD CATALOG 132 133B<NOTE:> The documentation below is derived from version 1.02 of 134Class::MethodMaker. Class::MakeMethods::Emulator::MethodMaker 135provides support for all of the features and examples shown below, 136with no changes required. 137 138 139=head1 CONSTRUCTOR METHODS 140 141=head2 new 142 143Equivalent to Class::MakeMethods 'Template::Hash:new --with_values'. 144 145=cut 146 147sub new { return 'Template::Hash:new --with_values' } 148 149 150=head2 new_with_init 151 152Equivalent to Class::MakeMethods 'Template::Hash:new --with_init'. 153 154=cut 155 156sub new_with_init { return 'Template::Hash:new --with_init' } 157 158 159=head2 new_hash_init 160 161Equivalent to Class::MakeMethods 'Template::Hash:new --instance_with_methods'. 162 163=cut 164 165sub new_hash_init { return 'Template::Hash:new --instance_with_methods' } 166 167 168=head2 new_with_args 169 170Equivalent to Class::MakeMethods 'Template::Hash:new --with_values'. 171 172=cut 173 174sub new_with_args { return 'Template::Hash:new --with_values' } 175 176 177=head2 copy 178 179Equivalent to Class::MakeMethods 'Template::Hash:new --copy_with_values'. 180 181=cut 182 183sub copy { return 'Template::Hash:new --copy_with_values' } 184 185 186=head1 SCALAR ACCESSORS 187 188=head2 get_set 189 190Basically equivalent to Class::MakeMethods 'Template::Hash:scalar', except that various arguments are intercepted and converted into the parallel Class::MakeMethods::Template interface declarations. 191 192=cut 193 194my $scalar_interface = { '*'=>'get_set', 'clear_*'=>'clear' }; 195 196sub get_set { 197 shift and return [ 198 ( ( $_[0] and $_[0] eq '-static' and shift ) ? 'Template::Static:scalar' 199 : 'Template::Hash:scalar' ), 200 '-interface' => $scalar_interface, 201 map { 202 ( ref($_) eq 'ARRAY' ) 203 ? ( '-interface'=>{ 204 ( $_->[0] ? ( $_->[0] => 'get_set' ) : () ), 205 ( $_->[1] ? ( $_->[1] => 'clear' ) : () ), 206 ( $_->[2] ? ( $_->[2] => 'get' ) : () ), 207 ( $_->[3] ? ( $_->[3] => 'set_return' ) : () ), 208 } ) 209 : ($_ eq '-compatibility') 210 ? ( '-interface', $scalar_interface ) 211 : ($_ eq '-noclear') 212 ? ( '-interface', 'default' ) 213 : ( /^-/ ? "-$_" : $_ ) 214 } @_ 215 ] 216} 217 218 219=head2 get_concat 220 221Equivalent to Class::MakeMethods 'Template::Hash:string' with a special interface declaration that provides the get_concat and clear behaviors. 222 223=cut 224 225my $get_concat_interface = { 226 '*'=>'get_concat', 'clear_*'=>'clear', 227 '-params'=>{ 'join' => '', 'return_value_undefined' => undef() } 228}; 229 230my $old_get_concat_interface = { 231 '*'=>'get_concat', 'clear_*'=>'clear', 232 '-params'=>{ 'join' => '', 'return_value_undefined' => '' } 233}; 234 235sub get_concat { 236 shift and return [ 'Template::Hash:string', '-interface', 237 ( $_[0] eq '--noundef' ? ( shift and $old_get_concat_interface ) 238 : $get_concat_interface ), @_ ] 239} 240 241=head2 counter 242 243Equivalent to Class::MakeMethods 'Template::Hash:number --counter'. 244 245=cut 246 247sub counter { return 'Template::Hash:number --counter' } 248 249 250=head1 OBJECT ACCESSORS 251 252Basically equivalent to Class::MakeMethods 'Template::Hash:object' with an declaration that provides the "delete_x" interface. Due to a difference in expected argument syntax, the incoming arguments are revised before being delegated to Template::Hash:object. 253 254=cut 255 256my $object_interface = { '*'=>'get_set_init', 'delete_*'=>'clear' }; 257 258sub object { 259 shift and return [ 260 'Template::Hash:object', 261 '-interface' => $object_interface, 262 _object_args(@_) 263 ] 264} 265 266sub _object_args { 267 my @meta_methods; 268 ! (@_ % 2) or Carp::croak("Odd number of arguments for object declaration"); 269 while ( scalar @_ ) { 270 my ($class, $list) = (shift(), shift()); 271 push @meta_methods, map { 272 (! ref $_) ? { name=> $_, class=>$class } 273 : { name=> $_->{'slot'}, class=>$class, 274 delegate=>( $_->{'forward'} || $_->{'comp_mthds'} ) } 275 } ( ( ref($list) eq 'ARRAY' ) ? @$list : ($list) ); 276 } 277 return @meta_methods; 278} 279 280 281=head2 object_list 282 283Basically equivalent to Class::MakeMethods 'Template::Hash:object_list' with an declaration that provides the relevant helper methods. Due to a difference in expected argument syntax, the incoming arguments are revised before being delegated to Template::Hash:object_list. 284 285=cut 286 287my $array_interface = { 288 '*'=>'get_push', 289 '*_set'=>'set_items', 'set_*'=>'set_items', 290 map( ('*_'.$_ => $_, $_.'_*' => $_ ), 291 qw( pop push unshift shift splice clear count ref index )), 292}; 293 294sub object_list { 295 shift and return [ 296 'Template::Hash:array_of_objects', 297 '-interface' => $array_interface, 298 _object_args(@_) 299 ]; 300} 301 302=head2 forward 303 304Basically equivalent to Class::MakeMethods 'Template::Universal:forward_methods'. Due to a difference in expected argument syntax, the incoming arguments are revised before being delegated to Template::Universal:forward_methods. 305 306 forward => [ comp => 'method1', comp2 => 'method2' ] 307 308Define pass-through methods for certain fields. The above defines that 309method C<method1> will be handled by component C<comp>, whilst method 310C<method2> will be handled by component C<comp2>. 311 312=cut 313 314sub forward { 315 my $class = shift; 316 my @results; 317 while ( scalar @_ ) { 318 my ($comp, $method) = ( shift, shift ); 319 push @results, { name=> $method, target=> $comp }; 320 } 321 [ 'forward_methods', @results ] 322} 323 324 325 326=head1 REFERENCE ACCESSORS 327 328=head2 list 329 330Equivalent to Class::MakeMethods 'Template::Hash:array' with a custom method naming interface. 331 332=cut 333 334sub list { 335 shift and return [ 'Template::Hash:array', '-interface' => $array_interface, @_ ]; 336} 337 338 339=head2 hash 340 341Equivalent to Class::MakeMethods 'Template::Hash:hash' with a custom method naming interface. 342 343=cut 344 345my $hash_interface = { 346 '*'=>'get_push', 347 '*s'=>'get_push', 348 'add_*'=>'get_set_items', 349 'add_*s'=>'get_set_items', 350 'clear_*'=>'delete', 351 'clear_*s'=>'delete', 352 map {'*_'.$_ => $_} qw(push set keys values exists delete tally clear), 353}; 354 355sub hash { 356 shift and return [ 'Template::Hash:hash', '-interface' => $hash_interface, @_ ]; 357} 358 359 360=head2 tie_hash 361 362Equivalent to Class::MakeMethods 'Template::Hash:tiedhash' with a custom method naming interface. 363 364=cut 365 366sub tie_hash { 367 shift and return [ 'Template::Hash:tiedhash', '-interface' => $hash_interface, @_ ]; 368} 369 370=head2 hash_of_lists 371 372Equivalent to Class::MakeMethods 'Template::Hash:hash_of_arrays', or if the -static flag is present, to 'Template::Static:hash_of_arrays'. 373 374=cut 375 376sub hash_of_lists { 377 shift and return ( $_[0] and $_[0] eq '-static' and shift ) 378 ? [ 'Template::Static:hash_of_arrays', @_ ] 379 : [ 'Template::Hash:hash_of_arrays', @_ ] 380} 381 382 383=head1 STATIC ACCESSORS 384 385=head2 static_get_set 386 387Equivalent to Class::MakeMethods 'Template::Static:scalar' with a custom method naming interface. 388 389=cut 390 391sub static_get_set { 392 shift and return [ 'Template::Static:scalar', '-interface', $scalar_interface, @_ ] 393} 394 395=head2 static_list 396 397Equivalent to Class::MakeMethods 'Template::Static:array' with a custom method naming interface. 398 399=cut 400 401sub static_list { 402 shift and return [ 'Template::Static:array', '-interface' => $array_interface, @_ ]; 403} 404 405=head2 static_hash 406 407Equivalent to Class::MakeMethods 'Template::Static:hash' with a custom method naming interface. 408 409=cut 410 411sub static_hash { 412 shift and return [ 'Template::Static:hash', '-interface' => $hash_interface, @_ ]; 413} 414 415 416=head1 GROUPED ACCESSORS 417 418=head2 boolean 419 420Equivalent to Class::MakeMethods 'Template::Static:bits' with a custom method naming interface. 421 422=cut 423 424my $bits_interface = { 425 '*'=>'get_set', 'set_*'=>'set_true', 'clear_*'=>'set_false', 426 'bit_fields'=>'bit_names', 'bits'=>'bit_string', 'bit_dump'=>'bit_hash' 427}; 428 429sub boolean { 430 shift and return [ 'Template::Hash:bits', '-interface' => $bits_interface, @_ ]; 431} 432 433 434=head2 grouped_fields 435 436Creates get/set methods like get_set but also defines a method which 437returns a list of the slots in the group. 438 439 use Class::MakeMethods::Emulator::MethodMaker 440 grouped_fields => [ 441 some_group => [ qw / field1 field2 field3 / ], 442 ]; 443 444Its argument list is parsed as a hash of group-name => field-list 445pairs. Get-set methods are defined for all the fields and a method with 446the name of the group is defined which returns the list of fields in the 447group. 448 449=cut 450 451sub grouped_fields { 452 my ($class, %args) = @_; 453 my @methods; 454 foreach (keys %args) { 455 my @slots = @{ $args{$_} }; 456 push @methods, 457 $_, sub { @slots }, 458 $class->make( 'get_set', \@slots ); 459 } 460 return @methods; 461} 462 463=head2 struct 464 465Equivalent to Class::MakeMethods 'Template::Hash::struct'. 466 467B<Note:> This feature is included but not documented in Class::MethodMaker version 1. 468 469 470=cut 471 472sub struct { return 'Template::Hash:struct' } 473 474 475=head1 INDEXED ACCESSORS 476 477=head2 listed_attrib 478 479Equivalent to Class::MakeMethods 'Template::Flyweight:boolean_index' with a custom method naming interface. 480 481=cut 482 483sub listed_attrib { 484 shift and return [ 'Template::Flyweight:boolean_index', '-interface' => { 485 '*'=>'get_set', 'set_*'=>'set_true', 'clear_*'=>'set_false', 486 '*_objects'=>'find_true', }, @_ ] 487} 488 489 490=head2 key_attrib 491 492Equivalent to Class::MakeMethods 'Template::Hash:string_index'. 493 494=cut 495 496sub key_attrib { return 'Template::Hash:string_index' } 497 498=head2 key_with_create 499 500Equivalent to Class::MakeMethods 'Template::Hash:string_index --find_or_new'. 501 502=cut 503 504sub key_with_create { return 'Template::Hash:string_index --find_or_new'} 505 506 507=head1 CODE ACCESSORS 508 509=head2 code 510 511Equivalent to Class::MakeMethods 'Template::Hash:code'. 512 513=cut 514 515sub code { return 'Template::Hash:code' } 516 517 518=head2 method 519 520Equivalent to Class::MakeMethods 'Template::Hash:code --method'. 521 522=cut 523 524sub method { return 'Template::Hash:code --method' } 525 526 527=head2 abstract 528 529Equivalent to Class::MakeMethods 'Template::Universal:croak --abstract'. 530 531=cut 532 533sub abstract { return 'Template::Universal:croak --abstract' } 534 535 536=head1 ARRAY CONSTRUCTOR AND ACCESSORS 537 538=head2 builtin_class (EXPERIMENTAL) 539 540Equivalent to Class::MakeMethods 'Template::StructBuiltin:builtin_isa' with a modified argument order. 541 542=cut 543 544sub builtin_class { 545 shift and return [ 'Template::StructBuiltin:builtin_isa', 546 '-new_function'=>(shift), @{(shift)} ] 547} 548 549=head1 CONVERSION 550 551If you wish to convert your code from use of the Class::MethodMaker emulator to direct use of Class::MakeMethods, you will need to adjust the arguments specified in your C<use> or C<make> calls. 552 553Often this is simply a matter of replacing the names of aliased method-types listed below with the new equivalents. 554 555For example, suppose that you code contained the following declaration: 556 557 use Class::MethodMaker ( 558 counter => [ 'foo' ] 559 ); 560 561Consulting the listings below you can find that C<counter> is an alias for C<Hash:number --counter> and you could thus revise your declaration to read: 562 563 use Class::MakeMethods ( 564 'Hash:number --counter' => [ 'foo' ] 565 ); 566 567However, note that those methods marked "(with custom interface)" below have a different default naming convention for helper methods in Class::MakeMethods, and you will need to either supply a similar interface or alter your module's calling interface. 568 569Also note that the C<forward>, C<object>, and C<object_list> method types, marked "(with modified arguments)" below, require their arguments to be specified differently. 570 571See L<Class::MakeMethods::Template::Generic> for more information about the default interfaces of these method types. 572 573 574=head2 Hash methods 575 576The following equivalencies are declared for old meta-method names that are now handled by the Hash implementation: 577 578 new 'Template::Hash:new --with_values' 579 new_with_init 'Template::Hash:new --with_init' 580 new_hash_init 'Template::Hash:new --instance_with_methods' 581 copy 'Template::Hash:copy' 582 get_set 'Template::Hash:scalar' (with custom interfaces) 583 counter 'Template::Hash:number --counter' 584 get_concat 'Template::Hash:string --get_concat' (with custom interface) 585 boolean 'Template::Hash:bits' (with custom interface) 586 list 'Template::Hash:array' (with custom interface) 587 struct 'Template::Hash:struct' 588 hash 'Template::Hash:hash' (with custom interface) 589 tie_hash 'Template::Hash:tiedhash' (with custom interface) 590 hash_of_lists 'Template::Hash:hash_of_arrays' 591 code 'Template::Hash:code' 592 method 'Template::Hash:code --method' 593 object 'Template::Hash:object' (with custom interface and modified arguments) 594 object_list 'Template::Hash:array_of_objects' (with custom interface and modified arguments) 595 key_attrib 'Template::Hash:string_index' 596 key_with_create 'Template::Hash:string_index --find_or_new' 597 598=head2 Static methods 599 600The following equivalencies are declared for old meta-method names 601that are now handled by the Static implementation: 602 603 static_get_set 'Template::Static:scalar' (with custom interface) 604 static_hash 'Template::Static:hash' (with custom interface) 605 606=head2 Flyweight method 607 608The following equivalency is declared for the one old meta-method name 609that us now handled by the Flyweight implementation: 610 611 listed_attrib 'Template::Flyweight:boolean_index' 612 613=head2 Struct methods 614 615The following equivalencies are declared for old meta-method names 616that are now handled by the Struct implementation: 617 618 builtin_class 'Template::Struct:builtin_isa' 619 620=head2 Universal methods 621 622The following equivalencies are declared for old meta-method names 623that are now handled by the Universal implementation: 624 625 abstract 'Template::Universal:croak --abstract' 626 forward 'Template::Universal:forward_methods' (with modified arguments) 627 628 629=head1 EXTENDING 630 631In order to enable third-party subclasses of MethodMaker to run under this emulator, several aliases or stub replacements are provided for internal Class::MethodMaker methods which have been eliminated or renamed. 632 633=over 4 634 635=item * 636 637install_methods - now simply return the desired methods 638 639=item * 640 641find_target_class - now passed in as the target_class attribute 642 643=item * 644 645ima_method_maker - no longer supported; use target_class instead 646 647=back 648 649=cut 650 651sub find_target_class { (shift)->_context('TargetClass') } 652sub get_target_class { (shift)->_context('TargetClass') } 653sub install_methods { (shift)->_install_methods(@_) } 654sub ima_method_maker { 1 } 655 656 657=head1 BUGS 658 659This module aims to provide a 100% compatible drop-in replacement for Class::MethodMaker; if you detect a difference when using this emulation, please inform the author. 660 661 662=head1 SEE ALSO 663 664See L<Class::MakeMethods> for general information about this distribution. 665 666See L<Class::MakeMethods::Emulator> for more about this family of subclasses. 667 668See L<Class::MethodMaker> for more information about the original module. 669 670A good introduction to Class::MethodMaker is provided by pages 222-234 of I<Object Oriented Perl>, by Damian Conway (Manning, 1999). 671 672 http://www.browsebooks.com/Conway/ 673 674=cut 675 6761; 677