home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / Inherit.pm < prev    next >
Encoding:
Perl POD Document  |  2001-08-24  |  2.4 KB  |  105 lines
  1. package Class::Fields::Inherit;
  2.  
  3. use strict;
  4. no strict 'refs';
  5. use vars qw(@ISA @EXPORT $VERSION);
  6.  
  7. use Class::Fields::Fuxor;
  8. use Class::Fields::Attribs;
  9.  
  10. $VERSION = '0.05';
  11.  
  12. require Exporter;
  13. @ISA = qw(Exporter);
  14.  
  15. @EXPORT = qw( inherit_fields );
  16.  
  17. use constant SUCCESS => 1;
  18. use constant FAILURE => !SUCCESS;
  19.  
  20. #'#
  21. sub inherit_fields {
  22.     my($derived, $base) = @_;
  23.  
  24.     return SUCCESS unless $base;
  25.  
  26.     my $battr = get_attr($base);
  27.     my $dattr = get_attr($derived);
  28.     my $dfields = get_fields($derived);
  29.     my $bfields = get_fields($base);
  30.  
  31.     $dattr->[0] = @$battr;
  32.  
  33.     if( keys %$dfields ) {
  34.         warn "$derived is inheriting from $base but already has its own ".
  35.              "fields!\n".
  36.              "This will cause problems with pseudo-hashes.\n".
  37.              "Be sure you use base BEFORE declaring fields\n";
  38.     }
  39.  
  40.     # Iterate through the base's fields adding all the non-private
  41.     # ones to the derived class.  Hang on to the original attribute
  42.     # (Public, Private, etc...) and add Inherited.
  43.     # This is all too complicated to do efficiently with add_fields().
  44.     while (my($k,$v) = each %$bfields) {
  45.         my $fno;
  46.     if ($fno = $dfields->{$k} and $fno != $v) {
  47.         require Carp;
  48.         Carp::croak ("Inherited %FIELDS can't override existing %FIELDS");
  49.     }
  50.  
  51.         if( $battr->[$v] & PRIVATE ) {
  52.             $dattr->[$v] = undef;
  53.         }
  54.         else {
  55.             $dattr->[$v] = INHERITED | $battr->[$v];
  56.  
  57.             # Derived fields must be kept in the same position as the
  58.             # base in order to make "static" typing work with psuedo-hashes.
  59.             # Alas, this kills multiple field inheritance.
  60.             $dfields->{$k} = $v;
  61.         }
  62.     }
  63. }
  64.  
  65. return 'IRS Estate Tax Return Form 706';
  66. __END__
  67. =pod
  68.  
  69. =head1 NAME
  70.  
  71. Class::Fields::Inherit - Inheritance of %FIELDS
  72.  
  73.  
  74. =head1 SYNOPSIS
  75.  
  76.     use Class::Fields::Inherit;
  77.     inherit_fields($derived_class, $base_class);
  78.  
  79.  
  80. =head1 DESCRIPTION
  81.  
  82. A simple module to handle inheritance of the %FIELDS hash.  base.pm is
  83. usually its only customer, though there's nothing stopping you from
  84. using it.
  85.  
  86. =over 4
  87.  
  88. =item B<inherit_fields>
  89.  
  90.   inherit_fields($derived_class, $base_class);
  91.  
  92. The $derived_class will inherit all of the $base_class's fields.  This
  93. is a good chunk of what happens when you use base.pm.
  94.  
  95. =back
  96.  
  97. =head1 AUTHOR
  98.  
  99. Michael G Schwern <schwern@pobox.com> largely from code liberated from
  100. fields.pm
  101.  
  102. =head1 SEE ALSO
  103.  
  104. L<base>, L<Class::Fields>
  105.