From b168e3b703c57bdecb697d617e8d98edff2cb079 Mon Sep 17 00:00:00 2001 From: TizenOpenSource Date: Thu, 8 Feb 2024 18:19:21 +0900 Subject: [PATCH] Imported Upstream version 0.09 --- Changes | 31 ++++++ MANIFEST | 12 +++ MANIFEST.SKIP | 32 +++++++ META.json | 40 ++++++++ META.yml | 22 +++++ Makefile.PL | 9 ++ README | 108 +++++++++++++++++++++ doc/jp/Class-Data-Inheritable.pod | 132 ++++++++++++++++++++++++++ lib/Class/Data/Inheritable.pm | 150 ++++++++++++++++++++++++++++++ t/Inheritable.t | 46 +++++++++ t/pod-coverage.t | 4 + t/pod.t | 4 + 12 files changed, 590 insertions(+) create mode 100644 Changes create mode 100644 MANIFEST create mode 100644 MANIFEST.SKIP create mode 100644 META.json create mode 100644 META.yml create mode 100644 Makefile.PL create mode 100644 README create mode 100644 doc/jp/Class-Data-Inheritable.pod create mode 100644 lib/Class/Data/Inheritable.pm create mode 100644 t/Inheritable.t create mode 100644 t/pod-coverage.t create mode 100644 t/pod.t diff --git a/Changes b/Changes new file mode 100644 index 0000000..1756ca8 --- /dev/null +++ b/Changes @@ -0,0 +1,31 @@ +0.09 Fri Jul 30 22:42:00 UTC 2021 + - Update spelling errors to resolve #83824 and #86563 + +0.08 Sat Jan 26 00:34:11 NZDT 2008 + - Fix 'perltooc' typo in Docs + +0.07 Sat Jan 26 00:34:11 NZDT 2008 + - Relicense as dual AL/GPL + +0.06 Wed Sep 20 14:35:55 BST 2006 + - Sync the japanese docs (as best as possible!) + +0.05 Sat Aug 26 18:27:12 UTC 2006 + - Use correct bug reporting address (Jonathan Rockway) + +0.04 Sat Sep 24 12:36:56 UTC 2005 + - Tony Bowden now maintainer + - Document how to set value when creating data + - Complete rewrite of tests + +0.03 Tue Mar 11 18:30:01 GMT 2003 + - Rearranged the docs a smidge. + - Added Japanese docs from perldocjp (thanks Atsuhi Kato) + - mk_classdata() is now explicitly only a class method + - Added this change log. + +0.02 Sat Apr 15 05:14:17 GMT 2000 + * mk_classdata() now creates a private accessor alias. + +0.01 Fri Apr 14 09:17:15 GMT 2000 + * First cut. diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..1e0d304 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,12 @@ +Changes +doc/jp/Class-Data-Inheritable.pod +lib/Class/Data/Inheritable.pm +Makefile.PL +MANIFEST This list of files +MANIFEST.SKIP +META.yml +README +t/Inheritable.t +t/pod-coverage.t +t/pod.t +META.json Module JSON meta-data (added by MakeMaker) diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP new file mode 100644 index 0000000..ccce0d1 --- /dev/null +++ b/MANIFEST.SKIP @@ -0,0 +1,32 @@ +# Avoid version control files. +\bRCS\b +\bCVS\b +,v$ +,B$ +,D$ +\B\.svn\b +aegis.log$ +\bconfig$ +\bbuild$ + +# Avoid Makemaker generated and utility files. +\bMakefile$ +\bblib +\bMakeMaker-\d +\bpm_to_blib$ +\bblibdirs$ + +# Avoid Module::Build generated and utility files. +\bBuild$ +\b_build + +# Avoid temp and backup files. +~$ +\.gz$ +\.old$ +\.bak$ +\.swp$ +\.tdy$ +\#$ +\b\.# + diff --git a/META.json b/META.json new file mode 100644 index 0000000..8c65c37 --- /dev/null +++ b/META.json @@ -0,0 +1,40 @@ +{ + "abstract" : "Inheritable, overridable class data", + "author" : [ + "unknown" + ], + "dynamic_config" : 1, + "generated_by" : "ExtUtils::MakeMaker version 7.62, CPAN::Meta::Converter version 2.150010", + "license" : [ + "perl_5" + ], + "meta-spec" : { + "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", + "version" : 2 + }, + "name" : "Class-Data-Inheritable", + "no_index" : { + "directory" : [ + "t", + "inc" + ] + }, + "prereqs" : { + "build" : { + "requires" : { + "ExtUtils::MakeMaker" : "0" + } + }, + "configure" : { + "requires" : { + "ExtUtils::MakeMaker" : "0" + } + }, + "runtime" : { + "requires" : {} + } + }, + "release_status" : "stable", + "version" : "0.09", + "x_serialization_backend" : "JSON::PP version 4.06" +} diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..c46e4a5 --- /dev/null +++ b/META.yml @@ -0,0 +1,22 @@ +--- +abstract: 'Inheritable, overridable class data' +author: + - unknown +build_requires: + ExtUtils::MakeMaker: '0' +configure_requires: + ExtUtils::MakeMaker: '0' +dynamic_config: 1 +generated_by: 'ExtUtils::MakeMaker version 7.62, CPAN::Meta::Converter version 2.150010' +license: perl +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: '1.4' +name: Class-Data-Inheritable +no_index: + directory: + - t + - inc +requires: {} +version: '0.09' +x_serialization_backend: 'CPAN::Meta::YAML version 0.018' diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..05be06c --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,9 @@ +use ExtUtils::MakeMaker; + +WriteMakefile( + NAME => 'Class::Data::Inheritable', + VERSION_FROM => "lib/Class/Data/Inheritable.pm", + ABSTRACT_FROM => "lib/Class/Data/Inheritable.pm", + LICENSE => 'perl', + PREREQ_PM => {}, +); diff --git a/README b/README new file mode 100644 index 0000000..7045079 --- /dev/null +++ b/README @@ -0,0 +1,108 @@ +NAME + Class::Data::Inheritable - Inheritable, overridable class data + +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'); + +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 further changes by Pere::Ubu no + longer effect Raygun. + + # Raygun still has an orange suitcase, but Pere::Ubu is using Samsonite. + Pere::Ubu->Suitcase('Samsonite'); + +Methods + 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(@_); + } + +AUTHOR + Original code by Damian Conway. + + Maintained by Michael G Schwern until September 2005. + + Now maintained by Tony Bowden. + +BUGS and QUERIES + Please direct all correspondence regarding this module to: + bug-Class-Data-Inheritable@rt.cpan.org + +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. + +SEE ALSO + perltootc has a very elaborate discussion of class data in Perl. + diff --git a/doc/jp/Class-Data-Inheritable.pod b/doc/jp/Class-Data-Inheritable.pod new file mode 100644 index 0000000..9240fcf --- /dev/null +++ b/doc/jp/Class-Data-Inheritable.pod @@ -0,0 +1,132 @@ +=pod + +=head1 ̾Á° + +Class::Data::Inheritable - ·Ñ¾µ²Äǽ¤Ê, ¥ª¡¼¥Ð¡¼¥é¥¤¥É²Äǽ¤Ê¡¢¥¯¥é¥¹¥Ç¡¼¥¿ + +=head1 ³µÍ× + + package Stuff; + use base qw(Class::Data::Inheritable); + + # DataFile¤ò¡¢·Ñ¾µ²Äǽ¤Ê¥¯¥é¥¹¥Ç¡¼¥¿¤È¤·¤Æ¥»¥Ã¥È¥¢¥Ã¥×¤¹¤ë¡£ + Stuff->mk_classdata('DataFile'); + + # ¤³¤Î¥¯¥é¥¹¤¿¤á¤Ë¥Ç¡¼¥¿¥Õ¥¡¥¤¥ë¤Î¾ì½ê¤òÀë¸À¤¹¤ë¡£ + Stuff->DataFile('/etc/stuff/data'); + + + Stuff->mk_classdata(DataFile => '/etc/stuff/data'); + +=head1 ³µÍ× + +Class::Data::Inheritable ¤Ï¡¢¥¯¥é¥¹¥Ç¡¼¥¿¤Î¥¢¥¯¥»¥µ/¥ß¥å¡¼¥Æ¡¼¥¿¤òºî¤ë¤Î¤Ë¸þ¤¤¤Æ¤¤¤Þ¤¹¡£ +¤Ä¤Þ¤ê¡¢(ñ°ì¤Î¥ª¥Ö¥¸¥§¥¯¥È¤È¤Ï°ã¤Ã¤Æ¡¢)¥¯¥é¥¹Á´ÂΤ˲¿¤«¤òÃߤ¨¤¿¤¤¾ì¹ç¤Ç¤¹¡£ +¤³¤Î¥Ç¡¼¥¿¤Ï¡¢¥µ¥Ö¥¯¥é¥¹¤Ç·Ñ¾µ¤µ¤ìÆÀ¤Þ¤¹¤·¡¢¥ª¡¼¥Ð¡¼¥é¥¤¥É¤µ¤ìÆÀ¤Þ¤¹¡£ + +Îã: + + Pere::Ubu->mk_classdata('Suitcase'); + +¤³¤ì¤Ï¡¢Suitcate ¥á¥½¥Ã¥É¤ò¡¢Pere::Ubu ¥¯¥é¥¹¤ËÀ¸À®¤·¤Þ¤¹¡£ + +¿·¤·¤¤¥á¥½¥Ã¥É¤Ï¡¢¥¯¥é¥¹¥Ç¡¼¥¿¤Î°ì¤Ä¤òÆÀ¤¿¤ê¡¢¥»¥Ã¥È¤¹¤ë¤Î¤Ë¡¢»È¤ï¤ìÆÀ¤Þ¤¹¡£ + + Pere::Ubu->Suitcase('Red'); + $suitcase = Pere::Ubu->Suitcase; + +ÌÌÇò¤¤Éôʬ¤¬¡¢¥¯¥é¥¹¤¬ Pere::Ubu ¤«¤é·Ñ¾µ¤¹¤ë¤È¤­¤Ëµ¯¤³¤ê¤Þ¤¹¡§ + + package Raygun; + use base qw(Pere::Ubu); + + # Raygun¤Î¥¹¡¼¥Ä¥±¡¼¥¹¤Ï Red. + $suitcase = Raygun->Suitcase; + +Raygun ¤Ï¡¢Pere::Ubu¤«¤é¥¹¡¼¥Ä¥±¡¼¥¹¥¯¥é¥¹¥Ç¡¼¥¿·Ñ¾µ¤·¤Þ¤¹¡£ + +¥¯¥é¥¹¥Ç¡¼¥¿¤Î·Ñ¾µ¤Ï¡¢¥á¥½¥Ã¥É·Ñ¾µ¤Ëanalgous¤òÆ°¤«¤·¤Þ¤¹¡£ +Raygun¤¬¡¢·Ñ¾µ¤µ¤ì¤¿¥¯¥é¥¹¥Ç¡¼¥¿¤ò(Suitcase()¤ò»È¤Ã¤Æ¡¢¿·¤·¤¤Ãͤò¥»¥Ã¥È¤¹¤ë¤³¤È¤Ë¤è¤Ã¤Æ)"¥ª¡¼¥Ð¡¼¥é¥¤¥É"¤·¤Ê¤¤¤«¤®¤ê¡¢ +Pere::Ubu ¤Ç¡¢¥»¥Ã¥È¤µ¤ì¤¿¤â¤Î¤ò¤Ê¤ó¤Ç¤â»È¤¤Â³¤±¡¢°ÊÁ°¤ÎÊѹ¹¤ò·Ñ¾µ¤·Â³¤±¤Þ¤¹¡£ + + # Raygun ¤È Pere::Ubu ¤Î suitcases ¤Ï¡¢º£¤Ï Blue ¤Ç¤¹¡£ + Pere::Ubu->Suitcase('Blue'); + +¤·¤«¤·¡¢Raygun ¤¬¡¢¼«Ê¬¼«¿È¤ÎSuitcase() ¤ò¥»¥Ã¥È¤¹¤ë¤Ù¤­¤À¤È·è¤á¤ë¤È¡¢ +Suitcase() ¤Ï¡¢ º£¤ä¡¢Pare::Ubu ¤ò"¥ª¡¼¥Ð¡¼¥é¥¤¥É"¤·¤Æ¤ª¤ê¡¢Raygun ¼«¿È¤Î¤â¤Î¤Ç¤¹¡£ +¥ª¡¼¥Ð¡¼¥é¥¤¥É¤µ¤ì¤¿¥á¥½¥Ã¥É¤Ë¤Á¤ç¤¦¤É¡¢»÷¤Æ¤¤¤Þ¤¹¡£ + + # Raygun ¤Ï orange ¤Î¥¹¡¼¥Ä¥±¡¼¥¹¤ò»ý¤Ä¤¬¡¢Pere::Ubu ¤Î¥¹¡¼¥Ä¥±¡¼¥¹¤Ï¡¢¤Þ¤À Blue ¤Ç¤¹. + Raygun->Suitcase('Orange'); + +¤µ¤Æ¡¢Raygun ¤Ï¡¢Pare::Ubu ¤ò¥ª¡¼¥Ð¡¼¥é¥¤¥É¤·¤¿¤Î¤Ç¡¢Pare::Ubu ¤Ë¤è¤ë¡¢°ÊÁ°¤ÎÊѹ¹¤Ï +¤Þ¤Ã¤¿¤¯ Raygun ¤Ë¤Ï¡¢±Æ¶Á¤òÍ¿¤¨¤Þ¤»¤ó¡£ + + # Raygun ¤Ï¡¢¤Þ¤À¡¢orange ¤Î¥¹¡¼¥Ä¥±¡¼¥¹¤Ç¤¹¤¬¡¢ Pere::Ubu ¤Ï¡¢Samsonite ¤ò»È¤¤¤Þ¤¹¡£ + Pere::Ubu->Suitcase('Samsonite'); + + +=head1 ¥á¥½¥Ã¥É + +=head2 B + + Class->mk_classdata($data_accessor_name); + Class->mk_classdata($data_accessor_name => $value); + +¤³¤ì¤Ï¥¯¥é¥¹¥á¥½¥Ã¥É¤Ç¡¢¿·¤·¤¤¥¯¥é¥¹¥Ç¡¼¥¿¤Î¥¢¥¯¥»¥µ¤òÀë¸À¤¹¤ë¤Î¤Ë»È¤ï¤ì¤Þ¤¹¡£ +$data_accessor_name ¤ò̾Á°¤Ë»È¤Ã¤Æ¡¢¿·¤·¤¤¥¢¥¯¥»¥µ¤¬¥¯¥é¥¹Æâ¤Ëºî¤é¤ì¤Þ¤¹¡£ + +¥ª¡¼¥Ð¡¼¥é¥¤¥É¤òÍưפˤ¹¤ë¤¿¤á¤Ë¡¢mk_classdata ¤Ï¡¢¥¢¥¯¥»¥µ¤Ø¤Î¥¨¥¤¥ê¥¢¥¹ _field_accessor() ¤òºî¤ê¤Þ¤¹¡£ +¤½¤ì¤Ç¡¢Suitcase() ¤Ë¤Ï¡¢_Suitcase_accessor() ¤È¤¤¤¦¥¨¥¤¥ê¥¢¥¹¤¬¤¢¤ê¡¢ +¤³¤Î¥¨¥¤¥ê¥¢¥¹¤Ï¡¢Suitcase() ¤È¡¢¤Á¤ç¤¦¤ÉƱ¤¸¤³¤È¤ò¤·¤Þ¤¹¡£ +ñ°ì¤Î¥¢¥¯¥»¥µ¤Î¿¶¤ëÉñ¤¤¤òÊѤ¨¤è¤¦¤È¤·¤Æ¡¢ +¤Þ¤À¡¢·Ñ¾µ²Äǽ¤Ê¥¯¥é¥¹¥Ç¡¼¥¿¤Î²¸·Ã¤òÆÀ¤¿¤¤¤Ê¤é¡¢Í­±×¤Ç¤¹¡£¼¡¤ÎÎã¤Î¤è¤¦¤Ë¡£ + + sub Suitcase { + my($self) = shift; + warn "Fashion tragedy" if @_ and $_[0] eq 'Plaid'; + + $self->_Suitcase_accessor(@_); + } + +=head1 Ãøºî¸¢ + +(¸¶Ê¸¤Þ¤Þ) + +Copyright (c) 2000, Damian Conway and Michael G Schwern. All +Rights Reserved. This module is free software. It may be used, +redistributed and/or modified under the terms of the Perl Artistic +License (see http://www.perl.com/perl/misc/Artistic.html) + + +=head1 Ãø¼Ô + +(¸¶Ê¸¤Þ¤Þ) + +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 SEE ALSO + +L ¤Ï¡¢¤È¤Æ¤âÆþÇ°¤ÊPerl¤Î¥¯¥é¥¹¥Ç¡¼¥¿¤Ë¤Ä¤¤¤Æ¤ÎµÄÏÀ¤¬¤¢¤ê¤Þ¤¹¡£ + +=head1 ËÝÌõ¤Ë¤Ä¤¤¤Æ + +ËÝÌõ¼Ô¡§²ÃÆ£ÆØ (atusi@pure.ne.jp) + +Perl¥É¥­¥å¥á¥ó¥ÈÆüËܸìÌõ Project ¤Ë¤Æ¡¢ +Perl¥â¥¸¥å¡¼¥ë¡¢¥É¥­¥å¥á¥ó¥È¤ÎËÝÌõ¤ò¹Ô¤Ã¤Æ¤ª¤ê¤Þ¤¹¡£ + + http://sourceforge.jp/projects/perldocjp/ + http://freeml.com/ctrl/html/MLInfoForm/perldocjp@freeml.com + http://www.perldoc.jp + diff --git a/lib/Class/Data/Inheritable.pm b/lib/Class/Data/Inheritable.pm new file mode 100644 index 0000000..3f20aec --- /dev/null +++ b/lib/Class/Data/Inheritable.pm @@ -0,0 +1,150 @@ +package Class::Data::Inheritable; + +use strict qw(vars subs); +use vars qw($VERSION); +$VERSION = '0.09'; + +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 further 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 has a very elaborate discussion of class data in Perl. + diff --git a/t/Inheritable.t b/t/Inheritable.t new file mode 100644 index 0000000..136adf8 --- /dev/null +++ b/t/Inheritable.t @@ -0,0 +1,46 @@ +use strict; +use Test::More tests => 15; + +package Ray; +use base qw(Class::Data::Inheritable); +Ray->mk_classdata('Ubu'); +Ray->mk_classdata(DataFile => '/etc/stuff/data'); + +package Gun; +use base qw(Ray); +Gun->Ubu('Pere'); + +package Suitcase; +use base qw(Gun); +Suitcase->DataFile('/etc/otherstuff/data'); + +package main; + +foreach my $class (qw/Ray Gun Suitcase/) { + can_ok $class => + qw/mk_classdata Ubu _Ubu_accessor DataFile _DataFile_accessor/; +} + +# Test that superclasses effect children. +is +Gun->Ubu, 'Pere', 'Ubu in Gun'; +is +Suitcase->Ubu, 'Pere', "Inherited into children"; +is +Ray->Ubu, undef, "But not set in parent"; + +# Set value with data +is +Ray->DataFile, '/etc/stuff/data', "Ray datafile"; +is +Gun->DataFile, '/etc/stuff/data', "Inherited into gun"; +is +Suitcase->DataFile, '/etc/otherstuff/data', "Different in suitcase"; + +# Now set the parent +ok +Ray->DataFile('/tmp/stuff'), "Set data in parent"; +is +Ray->DataFile, '/tmp/stuff', " - it sticks"; +is +Gun->DataFile, '/tmp/stuff', "filters down to unchanged children"; +is +Suitcase->DataFile, '/etc/otherstuff/data', "but not to changed"; + + +my $obj = bless {}, 'Gun'; +eval { $obj->mk_classdata('Ubu') }; +ok $@ =~ /^mk_classdata\(\) is a class method, not an object method/, +"Can't create classdata for an object"; + +is $obj->DataFile, "/tmp/stuff", "But objects can access the data"; diff --git a/t/pod-coverage.t b/t/pod-coverage.t new file mode 100644 index 0000000..2c5ca56 --- /dev/null +++ b/t/pod-coverage.t @@ -0,0 +1,4 @@ +use Test::More; +eval "use Test::Pod::Coverage 1.00"; +plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@; +all_pod_coverage_ok(); diff --git a/t/pod.t b/t/pod.t new file mode 100644 index 0000000..437887a --- /dev/null +++ b/t/pod.t @@ -0,0 +1,4 @@ +use Test::More; +eval "use Test::Pod 1.00"; +plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; +all_pod_files_ok(); -- 2.34.1