Mercurial > pub > Impl
diff Lib/IMPL/lang.pm @ 167:1f7a6d762394
SQL schema in progress
author | sourcer |
---|---|
date | Thu, 12 May 2011 08:57:19 +0400 |
parents | 76515373dac0 |
children | 6148f89bb7bf |
line wrap: on
line diff
--- a/Lib/IMPL/lang.pm Sat Apr 23 23:12:06 2011 +0400 +++ b/Lib/IMPL/lang.pm Thu May 12 08:57:19 2011 +0400 @@ -5,11 +5,128 @@ use parent qw(Exporter); use IMPL::_core::version; +require IMPL::Class::PropertyInfo; -our @EXPORT = qw(&is); +our @EXPORT = qw(&is); +our %EXPORT_TAGS = ( + base => [ + qw( + &is + ) + ], + constants => [ + qw( + &ACCESS_PUBLIC + &ACCESS_PROTECTED + &ACCESS_PRIVATE + &PROP_GET + &PROP_SET + &PROP_OWNERSET + &PROP_LIST + &PROP_ALL + ) + ], + + declare => [ + qw( + &public + &protected + &private + &virtual + &property + &static + &property + ) + ], + compare => [ + qw( + &equals + &equals_s + ) + ] +); + +our @EXPORT_OK = keys %{ { map (($_,1) , map (@{$_}, values %EXPORT_TAGS) ) } }; + +use constant { + ACCESS_PUBLIC => 1, + ACCESS_PROTECTED => 2, + ACCESS_PRIVATE => 3, + PROP_GET => 1, + PROP_SET => 2, + PROP_OWNERSET => 10, + PROP_LIST => 4, + PROP_ALL => 3 +}; sub is($$) { - eval { $_[0]->isa($_[1]) } + eval { $_[0]->isa( $_[1] ) }; +} + +sub virtual($) { + $_[0]->Virtual(1); + $_[0]; +} + +sub public($) { + $_[0]->Access(ACCESS_PUBLIC); + $_[0]->Implement; + $_[0]; +} + +sub private($) { + $_[0]->Access(ACCESS_PRIVATE); + $_[0]->Implement; + $_[0]; +} + +sub protected($) { + $_[0]->Access(ACCESS_PROTECTED); + $_[0]->Implement; + $_[0]; } -1; \ No newline at end of file +sub property($$;$) { + my ( $propName, $mutators, $attributes ) = @_; + my $Info = new IMPL::Class::PropertyInfo( + { + Name => $propName, + Mutators => $mutators, + Class => scalar(caller), + Attributes => $attributes + } + ); + return $Info; +} + +sub static($$) { + my ( $name, $value ) = @_; + my $class = caller; + $class->static_accessor( $name, $value ); +} + +sub equals { + if (defined $_[0]) { + return 0 if (not defined $_[1]); + + return $_[0] == $_[1]; + } else { + return 0 if defined $_[1]; + + return 1; + } +} + +sub equals_s { + if (defined $_[0]) { + return 0 if (not defined $_[1]); + + return $_[0] eq $_[1]; + } else { + return 0 if defined $_[1]; + + return 1; + } +} + +1;