Changeset 1992 for trunk/LATMOS-Accounts/lib
- Timestamp:
- 04/27/17 00:47:36 (7 years ago)
- Location:
- trunk/LATMOS-Accounts/lib/LATMOS/Accounts
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Bases.pm
r1974 r1992 7 7 use LATMOS::Accounts::Bases::Attributes; 8 8 use LATMOS::Accounts::Log; 9 use LATMOS::Accounts::Utils qw(exec_command to_ascii );9 use LATMOS::Accounts::Utils qw(exec_command to_ascii ); 10 10 11 11 our $VERSION = (q$Rev$ =~ /^Rev: (\d+) /)[0]; … … 195 195 return @sobj; 196 196 } 197 198 =head2 ListSubObjectOType($otype) 199 200 Return a list of sub object type supported by C<otype> objects. 201 202 =cut 203 204 sub ListSubObjectOType { 205 my ($self, $otype) = @_; 206 207 # finding perl class: 208 my $pclass = $self->_load_obj_class($otype) or return; 209 my $definition = "$pclass"->GetOtypeDef($self) or return; 210 211 return keys %{ $definition || {} } 212 } 213 214 =head2 GetSubObjectKey($otype, $sotype) 215 216 Return the key linking sub object C<$sotype> to object type C<$otype> 217 218 =cut 219 220 sub GetSubObjectKey { 221 my ($self, $otype, $sotype) = @_; 222 223 # finding perl class: 224 my $pclass = $self->_load_obj_class($otype) or return; 225 my $definition = "$pclass"->GetOtypeDef($self, $sotype) or return; 226 227 return $definition->{$sotype}; 228 } 229 197 230 198 231 =head2 ordered_objects … … 376 409 377 410 my %data; 411 my $sub; 378 412 foreach my $cfield (keys %cdata) { 379 my $attribute = $self->attribute($otype, $cfield) or next; 380 $attribute->ro and next; 381 $data{$cfield} = $cdata{$cfield}; 382 } 413 # Parsing subobject creation: 414 415 if (my ($sotype, $key, $scfield) = $cfield =~ /^(\w+)(?:\[(\w+)\])?\.(.*)/) { 416 $key ||= '_'; 417 $sub->{$sotype}{$key}{$scfield} = $cdata{$cfield}; 418 } else { 419 my $attribute = $self->attribute($otype, $cfield) or next; 420 $attribute->ro and next; 421 $data{$cfield} = $cdata{$cfield}; 422 } 423 } 424 383 425 $self->create_object($otype, $id, %data) or return; 384 426 my $obj = $self->get_object($otype, $id) or return; … … 393 435 ? join(', ', @{ $data{$attrname} }) 394 436 : $data{$attrname}) || '(none)'); 437 } 438 439 if ($sub) { 440 441 # Security: if caller is create_c_object calling it to check permission ? 442 # See below 443 # my ($caller) = caller(); 444 # my $subcreate = $caller eq 'create_c_object' ? 'create_c_object' : __SUB__; 445 446 # Trying to create subobject 447 foreach my $sotype (keys %$sub) { 448 my $SubKeyRef = $self->GetSubObjectKey($otype, $sotype) or do { 449 $self->log(LA_ERR, "Cannot create object type $sotype, subtype of $otype not defined"); 450 return; 451 }; 452 foreach my $skey (keys %{ $sub->{$sotype} || {} }) { 453 # Building id 454 my $info = $sub->{$sotype}{$skey} || {}; 455 # For id: if key is given using it, otherwise using random 456 my $sid = 457 $info->{$SubKeyRef} || 458 $id . '-' . join('', map { ('a' .. 'z')[rand(26)] } (0 .. 6)); 459 $info->{$SubKeyRef} = $id; 460 461 # Here we don't check permission to create sub object: 462 $self->_create_c_object($sotype, $sid, %{ $info || {} }) or return; 463 } 464 } 395 465 } 396 466 -
trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Objects.pm
r1935 r1992 197 197 @attrs = grep { $_->readable } @attrs if($for =~ /r/); 198 198 map { $_->name } grep { !$_->hidden } @attrs; 199 } 200 201 =head2 GetOtypeDef 202 203 This function is called to provide sub object definition. Must be overwritten 204 per object class when need. 205 206 Must return a hashref listing each sub object type and their related key atribute: 207 208 return { 209 addresses => 'user', 210 } 211 212 =cut 213 214 sub GetOtypeDef { 215 my ($class) = @_; 216 217 return; 199 218 } 200 219 -
trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Sql/User.pm
r1964 r1992 58 58 || $self->get_field('description') 59 59 || $self->id; 60 } 61 62 sub GetOtypeDef { 63 my ($class) = @_; 64 65 { 66 address => 'user', 67 employment => 'user', 68 }, 60 69 } 61 70
Note: See TracChangeset
for help on using the changeset viewer.