Mercurial > pub > Impl
annotate Lib/IMPL/lang.pm @ 245:7c517134c42f
Added Unsupported media type Web exception
corrected resourceLocation setting in the resource
Implemented localizable resources for text messages
fixed TT view scopings, INIT block in controls now sets globals correctly.
| author | sergey |
|---|---|
| date | Mon, 29 Oct 2012 03:15:22 +0400 |
| parents | f48a1a9f4fa2 |
| children | 56364d0c4b4f |
| rev | line source |
|---|---|
| 164 | 1 package IMPL::lang; |
| 2 use strict; | |
| 3 use warnings; | |
| 4 | |
| 165 | 5 use parent qw(Exporter); |
| 164 | 6 use IMPL::_core::version; |
| 173 | 7 use IMPL::clone qw(clone); |
| 164 | 8 |
| 167 | 9 require IMPL::Class::PropertyInfo; |
| 164 | 10 |
| 167 | 11 our @EXPORT = qw(&is); |
| 12 our %EXPORT_TAGS = ( | |
| 194 | 13 base => [ |
| 14 qw( | |
| 15 &is | |
| 16 &clone | |
| 17 ) | |
| 18 ], | |
| 167 | 19 |
| 194 | 20 declare => [ |
| 21 qw( | |
| 22 &public | |
| 23 &protected | |
| 24 &private | |
| 25 &virtual | |
| 26 &property | |
| 27 &static | |
| 28 &property | |
| 213 | 29 &ACCESS_PUBLIC |
| 30 &ACCESS_PROTECTED | |
| 31 &ACCESS_PRIVATE | |
| 32 &PROP_GET | |
| 33 &PROP_SET | |
| 34 &PROP_OWNERSET | |
| 35 &PROP_LIST | |
| 36 &PROP_ALL | |
| 230 | 37 &PROP_RO |
| 38 &PROP_RW | |
| 194 | 39 ) |
| 40 ], | |
| 41 compare => [ | |
| 42 qw( | |
| 43 &equals | |
| 44 &equals_s | |
| 45 &hashCompare | |
| 46 ) | |
| 47 ], | |
| 48 hash => [ | |
| 49 qw( | |
| 50 &hashApply | |
| 51 &hashMerge | |
| 52 &hashDiff | |
| 53 &hashCompare | |
| 54 &hashParse | |
| 55 &hashSave | |
| 56 ) | |
| 57 ] | |
| 167 | 58 ); |
| 59 | |
| 60 our @EXPORT_OK = keys %{ { map (($_,1) , map (@{$_}, values %EXPORT_TAGS) ) } }; | |
| 61 | |
| 230 | 62 use IMPL::Const qw(:all); |
| 164 | 63 |
| 64 sub is($$) { | |
| 194 | 65 eval { $_[0]->isa( $_[1] ) }; |
| 167 | 66 } |
| 67 | |
| 68 sub virtual($) { | |
| 194 | 69 $_[0]->Virtual(1); |
| 70 $_[0]; | |
| 167 | 71 } |
| 72 | |
| 73 sub public($) { | |
| 194 | 74 $_[0]->Access(ACCESS_PUBLIC); |
| 75 $_[0]->Implement; | |
| 76 $_[0]; | |
| 167 | 77 } |
| 78 | |
| 79 sub private($) { | |
| 194 | 80 $_[0]->Access(ACCESS_PRIVATE); |
| 81 $_[0]->Implement; | |
| 82 $_[0]; | |
| 167 | 83 } |
| 84 | |
| 85 sub protected($) { | |
| 194 | 86 $_[0]->Access(ACCESS_PROTECTED); |
| 87 $_[0]->Implement; | |
| 88 $_[0]; | |
| 164 | 89 } |
| 90 | |
| 167 | 91 sub property($$;$) { |
| 194 | 92 my ( $propName, $mutators, $attributes ) = @_; |
| 93 my $Info = new IMPL::Class::PropertyInfo( | |
| 94 { | |
| 95 Name => $propName, | |
| 96 Mutators => $mutators, | |
| 97 Class => scalar(caller), | |
| 98 Attributes => $attributes | |
| 99 } | |
| 100 ); | |
| 101 return $Info; | |
| 167 | 102 } |
| 103 | |
| 104 sub static($$) { | |
| 194 | 105 my ( $name, $value ) = @_; |
| 106 my $class = caller; | |
| 107 $class->static_accessor( $name, $value ); | |
| 167 | 108 } |
| 109 | |
| 110 sub equals { | |
| 194 | 111 if (defined $_[0]) { |
| 112 return 0 if (not defined $_[1]); | |
| 113 | |
| 114 return $_[0] == $_[1]; | |
| 115 } else { | |
| 116 return 0 if defined $_[1]; | |
| 117 | |
| 118 return 1; | |
| 119 } | |
| 167 | 120 } |
| 121 | |
| 122 sub equals_s { | |
| 194 | 123 if (defined $_[0]) { |
| 124 return 0 if (not defined $_[1]); | |
| 125 | |
| 126 return $_[0] eq $_[1]; | |
| 127 } else { | |
| 128 return 0 if defined $_[1]; | |
| 129 | |
| 130 return 1; | |
| 131 } | |
| 167 | 132 } |
| 133 | |
| 168 | 134 sub hashDiff { |
| 194 | 135 my ($src,$dst) = @_; |
| 136 | |
| 137 $dst = $dst ? { %$dst } : {} ; | |
| 138 $src ||= {}; | |
| 139 | |
| 140 my %result; | |
| 141 | |
| 142 foreach my $key ( keys %$src ) { | |
| 143 if (exists $dst->{$key}) { | |
| 144 $result{"+$key"} = $dst->{$key} unless equals_s($dst->{$key}, $src->{$key}); | |
| 145 delete $dst->{$key}; | |
| 146 } else { | |
| 147 $result{"-$key"} = 1; | |
| 148 } | |
| 149 } | |
| 150 | |
| 151 $result{"+$_"} = $dst->{$_} foreach keys %$dst; | |
| 152 | |
| 153 return \%result; | |
| 168 | 154 } |
| 155 | |
| 156 sub hashMerge { | |
| 210 | 157 return hashApply( { %{$_[0] || {}} }, $_[1] ); |
| 168 | 158 } |
| 159 | |
| 160 sub hashApply { | |
| 194 | 161 my ($target,$diff) = @_; |
| 162 | |
|
241
f48a1a9f4fa2
+Added ViewResult to allow implementation of the view environment.
sergey
parents:
230
diff
changeset
|
163 return $target unless ref $diff eq 'HASH'; |
|
f48a1a9f4fa2
+Added ViewResult to allow implementation of the view environment.
sergey
parents:
230
diff
changeset
|
164 |
| 194 | 165 while ( my ($key,$value) = each %$diff) { |
| 166 $key =~ /^(\+|-)?(.*)$/; | |
| 167 my $op = $1 || '+'; | |
| 168 $key = $2; | |
| 169 | |
| 170 if ($op eq '-') { | |
| 171 delete $target->{$key}; | |
| 172 } else { | |
| 173 $target->{$key} = $value; | |
| 174 } | |
| 175 } | |
| 176 | |
| 177 return $target; | |
| 168 | 178 } |
| 179 | |
| 180 sub hashCompare { | |
| 194 | 181 my ($l,$r,$cmp) = @_; |
| 182 | |
| 183 $cmp ||= \&equals_s; | |
| 184 | |
| 185 return 0 unless scalar keys %$l == scalar keys %$r; | |
| 186 &$cmp($l->{$_},$r->{$_}) || return 0 foreach keys %$l; | |
| 187 | |
| 188 return 1; | |
| 168 | 189 } |
| 190 | |
| 174 | 191 sub hashParse { |
| 194 | 192 my ($s,$p,$d) = @_; |
| 193 | |
| 194 $p = $p ? qr/$p/ : qr/\n+/; | |
| 195 $d = $d ? qr/$d/ : qr/\s*=\s*/; | |
| 196 | |
| 197 return { | |
| 198 map split($d,$_,2), split($p,$s) | |
| 199 }; | |
| 174 | 200 } |
| 201 | |
| 202 sub hashSave { | |
| 194 | 203 my ($hash,$p,$d) = @_; |
| 204 | |
| 205 return "" unless ref $hash eq 'HASH'; | |
| 206 | |
| 207 $p ||= "\n"; | |
| 208 $d ||= " = "; | |
| 209 | |
| 210 return | |
| 211 join( | |
| 212 $p, | |
| 213 map( | |
| 214 join( | |
| 215 $d, | |
| 216 $_, | |
| 217 $hash->{$_} | |
| 218 ), | |
| 219 keys %$hash | |
| 220 ) | |
| 221 ); | |
| 174 | 222 } |
| 223 | |
| 167 | 224 1; |