From: TizenOpenSource Date: Thu, 8 Feb 2024 09:19:21 +0000 (+0900) Subject: Imported Upstream version 0.09 X-Git-Tag: upstream/0.09^0 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=b168e3b703c57bdecb697d617e8d98edff2cb079;p=platform%2Fupstream%2Fperl-Class-Data-Inheritable.git Imported Upstream version 0.09 --- 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();