diff lib/IMPL/lang.pm @ 421:7798345304bc ref20150831

working on IMPL::Config, removed old stuff
author cin
date Sun, 16 Jul 2017 22:59:39 +0300
parents bbc4739c4d48
children
line wrap: on
line diff
--- a/lib/IMPL/lang.pm	Sat Feb 25 22:35:26 2017 +0300
+++ b/lib/IMPL/lang.pm	Sun Jul 16 22:59:39 2017 +0300
@@ -22,29 +22,6 @@
           &isglob
           )
     ],
-
-    declare => [
-        qw(
-          &public
-          &protected
-          &private
-          &property
-          &static
-          &property
-          &_direct
-          &ACCESS_PUBLIC
-          &ACCESS_PROTECTED
-          &ACCESS_PRIVATE
-          &PROP_GET
-          &PROP_SET
-          &PROP_OWNERSET
-          &PROP_LIST
-          &PROP_ALL
-          &PROP_RO
-          &PROP_RW
-          &PROP_DIRECT
-          )
-    ],
     compare => [
         qw(
           &equals
@@ -64,98 +41,45 @@
     ]
 );
 
-our @EXPORT_OK = keys %{ { map (($_,1) , map (@{$_}, values %EXPORT_TAGS) ) } };
+our @EXPORT_OK =
+  keys %{ { map ( ( $_, 1 ), map ( @{$_}, values %EXPORT_TAGS ) ) } };
 
 use IMPL::Const qw(:all);
 
 sub is {
     carp "A typename can't be undefined" unless $_[1];
-    blessed($_[0]) and $_[0]->isa( $_[1] );
+    blessed( $_[0] ) and $_[0]->isa( $_[1] );
 }
 
 sub isclass {
     carp "A typename can't be undefined" unless $_[1];
     local $@;
-    eval {not ref $_[0] and $_[0]->isa( $_[1] ) };
+    eval { not ref $_[0] and $_[0]->isa( $_[1] ) };
 }
 
 sub typeof(*) {
-    blessed($_[0]);
+    blessed( $_[0] );
 }
 
 sub isarray {
-	not blessed($_[0]) and ref $_[0] eq 'ARRAY';
+    not blessed( $_[0] ) and ref $_[0] eq 'ARRAY';
 }
 
 sub ishash {
-	not blessed($_[0]) and ref $_[0] eq 'HASH';
+    not blessed( $_[0] ) and ref $_[0] eq 'HASH';
 }
 
 sub isscalar {
-	not blessed($_[0]) and ref $_[0] eq 'SCALAR';
+    not blessed( $_[0] ) and ref $_[0] eq 'SCALAR';
 }
 
 sub isglob {
-	not blessed($_[0]) and ref $_[0] eq 'GLOB';
-}
-
-sub public($) {
-    my $info = shift;
-    $info->{access} = ACCESS_PUBLIC;
-    my $implementor = delete $info->{implementor};
-    $implementor->Implement($info);
-}
-
-sub private($) {
-    my $info = shift;
-    $info->{access} = ACCESS_PRIVATE;
-    my $implementor = delete $info->{implementor};
-    $implementor->Implement($info);
-}
-
-sub protected($) {
-    my $info = shift;
-    $info->{access} = ACCESS_PROTECTED;
-    my $implementor = delete $info->{implementor};
-    $implementor->Implement($info);
-}
-
-sub _direct ($) {
-    my $info = shift;
-    $info->{direct} = 1;
-    return $info;
-}
-
-sub property($$) {
-    my ($propName,$attributes) = @_;
-    
-    $attributes = {
-        get => $attributes & PROP_GET,
-        set => $attributes & PROP_SET,
-        isList => $attributes & PROP_LIST
-    } unless ref $attributes;
-    
-    my $class = caller;
-     
-    return hashMerge (
-        $attributes,
-        {
-            implementor => $class->ClassPropertyImplementor,
-            name => $propName,
-            class => scalar(caller),
-        }
-    );
-}
-
-sub static($$) {
-    my ( $name, $value ) = @_;
-    my $class = caller;
-    $class->static_accessor( $name, $value );
+    not blessed( $_[0] ) and ref $_[0] eq 'GLOB';
 }
 
 sub coarsen {
-	my ( $value, $resolution ) = @_;
-	return $resolution ? ceil( $value / $resolution ) * $resolution : $value;
+    my ( $value, $resolution ) = @_;
+    return $resolution ? ceil( $value / $resolution ) * $resolution : $value;
 }
 
 # datetime is DateTime object
@@ -176,117 +100,109 @@
 }
 
 sub equals {
-    if (defined $_[0]) {
-        return 0 if (not defined $_[1]);
-        
+    if ( defined $_[0] ) {
+        return 0 if ( not defined $_[1] );
+
         return $_[0] == $_[1];
-    }  else {
+    }
+    else {
         return 0 if defined $_[1];
-        
+
         return 1;
     }
 }
 
 sub equals_s {
-    if (defined $_[0]) {
-        return 0 if (not defined $_[1]);
-        
+    if ( defined $_[0] ) {
+        return 0 if ( not defined $_[1] );
+
         return $_[0] eq $_[1];
-    }  else {
+    }
+    else {
         return 0 if defined $_[1];
-        
+
         return 1;
     }
 }
 
 sub hashDiff {
-    my ($src,$dst) = @_;
-    
-    $dst = $dst ? { %$dst } : {} ;
+    my ( $src, $dst ) = @_;
+
+    $dst = $dst ? {%$dst} : {};
     $src ||= {};
-    
+
     my %result;
-    
+
     foreach my $key ( keys %$src ) {
-        if (exists $dst->{$key}) {
-            $result{"+$key"} = $dst->{$key} unless equals_s($dst->{$key}, $src->{$key});
+        if ( exists $dst->{$key} ) {
+            $result{"+$key"} = $dst->{$key}
+              unless equals_s( $dst->{$key}, $src->{$key} );
             delete $dst->{$key};
-        } else {
+        }
+        else {
             $result{"-$key"} = 1;
         }
     }
-    
+
     $result{"+$_"} = $dst->{$_} foreach keys %$dst;
-    
+
     return \%result;
 }
 
 sub hashMerge {
-    return hashApply( { %{$_[0] || {}} }, $_[1] );
+    return hashApply( { %{ $_[0] || {} } }, $_[1] );
 }
 
 sub hashApply {
-    my ($target,$diff) = @_;
-    
+    my ( $target, $diff ) = @_;
+
     return $target unless ref $diff eq 'HASH';
-    
-    while ( my ($key,$value) = each %$diff) {
+
+    while ( my ( $key, $value ) = each %$diff ) {
         $key =~ /^(\+|-)?(.*)$/;
         my $op = $1 || '+';
         $key = $2;
-        
-        if ($op eq '-') {
+
+        if ( $op eq '-' ) {
             delete $target->{$key};
-        } else {
+        }
+        else {
             $target->{$key} = $value;
         }
     }
-    
+
     return $target;
 }
 
 sub hashCompare {
-    my ($l,$r,$cmp) = @_;
-    
+    my ( $l, $r, $cmp ) = @_;
+
     $cmp ||= \&equals_s;
-    
+
     return 0 unless scalar keys %$l == scalar keys %$r;
-    &$cmp($l->{$_},$r->{$_}) || return 0 foreach keys %$l;
-    
+    &$cmp( $l->{$_}, $r->{$_} ) || return 0 foreach keys %$l;
+
     return 1;
 }
 
 sub hashParse {
-    my ($s,$p,$d) = @_;
-    
+    my ( $s, $p, $d ) = @_;
+
     $p = $p ? qr/$p/ : qr/\n+/;
     $d = $d ? qr/$d/ : qr/\s*=\s*/;
-    
-    return {
-        map split($d,$_,2), split($p,$s)
-    };
+
+    return { map split( $d, $_, 2 ), split( $p, $s ) };
 }
 
 sub hashSave {
-    my ($hash,$p,$d) = @_;
-    
+    my ( $hash, $p, $d ) = @_;
+
     return "" unless ref $hash eq 'HASH';
-    
+
     $p ||= "\n";
     $d ||= " = ";
-    
-    return
-        join(
-            $p,
-            map(
-                join(
-                    $d,
-                    $_,
-                    $hash->{$_}
-                ),
-                keys %$hash
-            )
-        );
+
+    return join( $p, map( join( $d, $_, $hash->{$_} ), keys %$hash ) );
 }
 
 1;