Changeset 1865 for trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Bases
- Timestamp:
- 12/21/16 15:07:28 (8 years ago)
- Location:
- trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Bases
- Files:
-
- 8 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Attributes.pm
r1839 r1865 261 261 } 262 262 263 if (ref $values eq 'ARRAY' && ! $self->multiple) { 264 $self->base->log(LA_WARN, 'Attribute %s is not multi valuesd', $self->name); 265 # TODO: really return an error 266 # return; 267 } 268 269 if ($self->{checkinput}) { 270 foreach my $val (ref $values ? @{ $values } : $values) { 271 if (!$self->{checkinput}->($val)) { 272 return; 273 } 274 } 275 return 1; 276 } 277 263 278 if ($self->has_values_list && $values) { 264 279 my @possible = $self->can_values; … … 281 296 } 282 297 283 if (ref $values eq 'ARRAY' && ! $self->multiple) {284 $self->base->log(LA_WARN, 'Attribute %s is not multi valuesd', $self->name);285 # TODO: really return an error286 # return;287 }288 289 if ($self->{checkinput}) {290 foreach my $val (ref $values ? @{ $values } : $values) {291 if (!$self->{checkinput}->($val)) {292 return;293 }294 }295 }296 298 297 299 return 1; -
trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Ldap/Group.pm
r1120 r1865 100 100 while (my ($f, $val) = each(%data)) { 101 101 $f eq 'memberUID' and do { 102 $val = [ $val ] unless(ref $val); 102 103 my %users; 103 104 $users{$_}{e} = 1 foreach (@{ $self->get_field('memberUID') || []}); -
trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Ldap/User.pm
r1706 r1865 232 232 ? $self->get_attributes('memberOf') 233 233 : ()); 234 $val = [ $val ] unless(ref $val); 234 235 $users{$_}{n} = 1 foreach (@{ $val || []}); 235 236 foreach (keys %users) { -
trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Objects.pm
r1840 r1865 45 45 46 46 =cut 47 48 =head2 listReal($base) 49 50 List object supported by this module existing in base $base 51 52 Can be override by base driver. The result must exclude specials object such alias. 53 54 =cut 55 56 sub listReal { 57 my ($class, $base) = @_; 58 $class->list($base); 59 } 47 60 48 61 =head2 list_from_rev($base, $rev) … … 68 81 } 69 82 70 # _new($base, $type, $id, ...)71 72 # Return a new object of type $type having unique identifier73 # $id, all remaining arguments are passed to the subclass.74 75 sub _new {76 my ($class, $base, $otype, $id, @args) = @_;77 78 # finding perl class:79 my $pclass = $base->_load_obj_class($otype) or return;80 my $newobj = "$pclass"->new($base, $id, @args);81 82 defined($newobj) or do {83 $base->log(LA_DEBUG, "$pclass->new() returned undef for $otype / %s", $id || '(none)');84 return;85 };86 87 $newobj->{_base} = $base;88 $newobj->{_type} = lc($otype);89 $newobj->{_id} ||= $id;90 91 return $newobj;92 }93 94 83 =head2 _create($class, $base, $id, %data) 95 84 … … 265 254 } 266 255 267 =head2 get_state ($state)268 269 Return an on fly computed value270 271 =cut272 273 sub get_state {274 my ($self, $state) = @_;275 # hum...276 if (defined(my $res = $self->_get_state($state))) {277 return $res;278 }279 for ($state) {280 }281 return;282 }283 284 sub _get_state {285 my ($self, $state) = @_;286 return;287 }288 289 256 sub _get_c_field { 290 257 my ($self, $cfield) = @_; … … 299 266 return $attribute->get; 300 267 } 268 269 =head2 GetAttributeValue($cfield) 270 271 Return the value to exposed to other base 272 273 =cut 274 275 sub GetAttributeValue { 276 my ($self, $cfield) = @_; 277 278 return $self->get_c_field($cfield); 279 } 280 301 281 302 282 =head2 queryformat ($fmt) -
trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Sql.pm
r1843 r1865 147 147 } 148 148 149 =head2 ListInternalObjects($otype) 150 151 List objects flags as internal for type C<$otype> 152 153 =cut 154 155 sub ListInternalObjects { 156 my ($self, $otype) = @_; 157 158 my $pclass = $self->_load_obj_class($otype) or return; 159 160 # Object Alias: checking if object is alias, then returning it: 161 my $sth = $self->db->prepare_cached( 162 sprintf(q{select %s as k from %s where and internobject = true}, 163 $self->db->quote_identifier($pclass->_key_field), 164 $self->db->quote_identifier($pclass->_object_table), 165 ), 166 ); 167 $sth->execute(); 168 my @list; 169 while (my $res = $sth->fetchrow_hashref) { 170 push(@list, $_->{k}); 171 } 172 return(@list); 173 } 174 175 =head2 GetRawObject($otype, $id) 176 177 Return an object even it is internal, alias are not follow and even 178 unexported object are returned 179 180 This function must be used only for maintenance operation. 181 182 =cut 183 184 sub GetRawObject { 185 my ($self, $otype, $id) = @_; 186 187 my $pclass = $self->_load_obj_class($otype) or return; 188 189 return $self->SUPER::get_object($otype, $id); 190 } 191 192 sub _derefObject { 193 my ($self, $otype, $oalias) = @_; 194 if (my ($aliasotype, $aliasoname, $aliasattr) = $oalias =~ m/^([^\/]+)\.([^\.]+)\.(.*)$/) { 195 my $attribute = $self->attribute($aliasotype, $aliasattr) or do { 196 $self->log(LA_DEBUG, "Oalias %s (%s): can fetch attibute %s/%s", 197 $otype, $oalias, $aliasotype, $aliasattr); 198 return; 199 }; 200 my $refotype = $attribute->reference or do { 201 $self->log(LA_DEBUG, "Oalias %s (%s): Attribute does not reference an object", 202 $otype, $oalias); 203 return; 204 }; 205 my $robj = $self->get_object($aliasotype, $aliasoname) or do { 206 $self->log(LA_DEBUG, "Oalias %s (%s): can fetch object %s/%s", 207 $otype, $oalias, $aliasotype, $aliasoname); 208 return; 209 }; 210 my $rvalue = $robj->get_attributes($aliasattr) or do { 211 $self->log(LA_DEBUG, "Oalias %s (%s): attribute value is empty", 212 $otype, $oalias); 213 return; 214 }; 215 return $self->get_object($refotype, $rvalue); 216 } else { 217 return $self->get_object($otype, $oalias); 218 } 219 } 220 221 sub get_object { 222 my ($self, $otype, $id) = @_; 223 224 my $pclass = $self->_load_obj_class($otype) or return; 225 226 # Object Alias: checking if object is alias, then returning it: 227 my $sth = $self->db->prepare_cached( 228 sprintf(q{select oalias from %s where %s = ? and internobject = false %s}, 229 $self->db->quote_identifier($pclass->_object_table), 230 $self->db->quote_identifier($pclass->_key_field), 231 ($self->{wexported} ? '' : 'and exported = true'), 232 ), 233 ); 234 $sth->execute($id); 235 my $res = $sth->fetchrow_hashref; 236 $sth->finish; 237 if (my $oalias = $res->{oalias}) { 238 # Cross reference over object/attribute 239 $self->_derefObject($otype, $oalias); 240 } else { 241 return $self->SUPER::get_object($otype, $id); 242 } 243 } 244 149 245 =head2 getObjectFromOKey ($okey) 150 246 … … 255 351 my ($self, @otype) = @_; 256 352 $self->SUPER::list_supported_objects(qw(site), @otype); 353 } 354 355 # For SQL listRealObjects != list_objects 356 sub listRealObjects { 357 my ($self, $otype) = @_; 358 my $pclass = $self->_load_obj_class($otype) or return; 359 $pclass->listReal($self); 257 360 } 258 361 … … 287 390 288 391 =head1 SPECIFICS FUNCTIONS 392 393 =head2 GetAlias($base, $id) 394 395 Return object having id C<$id> only if it is an object alias 396 397 =cut 398 399 sub GetAlias { 400 my ($self, $otype, $id) = @_; 401 402 my $pclass = $self->_load_obj_class($otype) or return; 403 404 # Object Alias: checking if object is alias, then returning it: 405 my $sth = $self->db->prepare_cached( 406 sprintf(q{select oalias from %s where %s = ? and oalias IS NOT NULL and internobject = false %s}, 407 $self->db->quote_identifier($pclass->_object_table), 408 $self->db->quote_identifier($pclass->_key_field), 409 ($self->{wexported} ? '' : 'and exported = true'), 410 ), 411 ); 412 $sth->execute($id); 413 my $res = $sth->fetchrow_hashref; 414 $sth->finish; 415 if ($res) { 416 return $self->SUPER::get_object($otype, $id); 417 } else { 418 return; 419 } 420 } 421 422 =head2 CreateAlias($otype, $name, $for) 423 424 Create an object alias named C<$name> for ovbject C<$for> 425 426 =cut 427 428 sub CreateAlias { 429 my ($self, $otype, $name, $for) = @_; 430 431 my $pclass = $self->_load_obj_class($otype) or return; 432 433 $for or die "Cannot create alias without giving object to point"; 434 435 my $res = $pclass->CreateAlias($self, $name, $for); 436 437 if ($res) { 438 $self->ReportChange( 439 $otype, 440 $name, 441 $pclass->_get_ikey($self, $name), 442 'Create', "Alias %s %s => %s", $otype, $name, $for 443 ); 444 $self->log(LA_DEBUG, "Alias $otype $name => $for created"); 445 return 1; 446 } else { 447 $self->log(LA_ERR, "Error when creating alias $otype $name"); 448 return; 449 } 450 } 451 452 =head2 RemoveAlias($otype, $name, $for) 453 454 Create an object alias named C<$name> for ovbject C<$for> 455 456 =cut 457 458 sub RemoveAlias { 459 my ($self, $otype, $name) = @_; 460 461 my $pclass = $self->_load_obj_class($otype) or return; 462 463 my $obj = $self->GetAlias($otype, $name) or do { 464 $self->log('Cannot get alias %s/%s for removal', $otype, $name); 465 return; 466 }; 467 468 if ($obj->_get_attributes('internobject')) { 469 # Cannot happend: internal are not fetchable 470 $self->log(LA_ERR,'Cannot delete %s/%s: is an internal object', $pclass->type, $name); 471 return; 472 } 473 if ($obj->_get_attributes('nodelete')) { 474 $self->log(LA_ERR,'Cannot delete %s/%s: is write protected', $pclass->type, $name); 475 return; 476 } 477 478 my $id = $obj->Iid; 479 480 my $sth = $self->db->prepare_cached(sprintf( 481 'DELETE FROM %s WHERE %s = ?', 482 $self->db->quote_identifier($pclass->_object_table), 483 $self->db->quote_identifier($pclass->_key_field), 484 )); 485 486 my $res = $sth->execute($name); 487 488 if ($res) { 489 $self->ReportChange( 490 $otype, 491 $name, 492 $id, 493 'Delete', "Alias %s %s deleted", $otype, $name 494 ); 495 $self->log(LA_DEBUG, "Alias $otype $name removed"); 496 return 1; 497 } else { 498 $self->log(LA_ERR, "Error when removing alias $otype $name"); 499 return; 500 } 501 } 289 502 290 503 =head2 get_global_value ($varname) … … 419 632 and expire > now() 420 633 and expire is not null 634 and internobject = false 421 635 } . ($self->{wexported} ? '' : 'and exported = true') . q{ 422 636 order by expire … … 444 658 expire < now() - ?::interval 445 659 and expire is not null 660 and internobject = false 446 661 } . ($self->{wexported} ? '' : 'and exported = true') . q{ 447 662 order by expire -
trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Sql/Address.pm
r1613 r1865 324 324 label => l('Description'), 325 325 }, 326 expire => { 327 inline => 1, 328 formtype => 'DATE', 329 label => l('Expire'), 330 }, 326 331 } 327 332 ); -
trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Sql/User.pm
r1863 r1865 508 508 select name from "group" join 509 509 group_attributes on group_attributes.okey = "group".ikey 510 where value = ? and attr = ? 510 where value = ? and attr = ? and internobject = false 511 511 } . ($self->base->{wexported} ? '' : ' and "group".exported = true') 512 512 ); … … 558 558 my ($self) = @_; 559 559 my $sth = $self->base->db->prepare(q{ 560 select forward from aliases where name = ? 560 select forward from aliases where name = ? and internobject = false 561 561 } . ($self->base->{wexported} ? '' : ' and exported = true')); 562 562 $sth->execute($self->object->id); … … 609 609 my ($self) = @_; 610 610 my $sth = $self->base->db->prepare(q{ 611 select name from aliases where lower($1) =611 select name from aliases where internobject = false and lower($1) = 612 612 lower(array_to_string("forward", ',')) 613 613 } . ($self->base->{wexported} ? '' : 'and exported = true')); … … 1348 1348 /^never$/ and return 0; 1349 1349 1350 !$_[0] andreturn 0;1350 $_[0] or return 0; 1351 1351 1352 1352 /^any$/i and return $_[0]->listEmployment ? 1 : 0; … … 1389 1389 1390 1390 $class->SUPER::_get_attr_schema($base, $attrs) 1391 } 1392 1393 sub CreateAlias { 1394 my ($class, $base, $name, $for) = @_; 1395 1396 my $stAddAlias = $base->db->prepare_cached( 1397 q{INSERT INTO "user" (name, uidnumber, gidnumber, oalias) values 1398 (?, -nextval('ikey_seq'), ?, ?)} 1399 ); 1400 1401 my $res = $stAddAlias->execute($name, -1, $for); 1402 return $res ? 1 : 0; 1391 1403 } 1392 1404 -
trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Sql/objects.pm
r1823 r1865 22 22 sub _attributes_table { $_[0]->_object_table . '_attributes_list' } 23 23 24 sub list {24 sub listReal { 25 25 my ($class, $base) = @_; 26 26 27 27 my $sth = $base->db->prepare_cached( 28 28 sprintf( 29 q{select %s as k from %s %s order by %s}, 29 q{select %s as k from %s where internobject = false 30 and oalias IS NULL %s order by %s}, 30 31 $base->db->quote_identifier($class->_key_field), 31 32 $base->db->quote_identifier($class->_object_table), 32 ($base->{wexported} ? '' : ' whereexported = true'),33 ($base->{wexported} ? '' : 'and exported = true'), 33 34 $base->db->quote_identifier($class->_key_field), 34 35 ) … … 42 43 } 43 44 45 sub list { 46 my ($class, $base) = @_; 47 48 my $sth = $base->db->prepare_cached( 49 sprintf( 50 q{select %s as k from %s where internobject = false %s order by %s}, 51 $base->db->quote_identifier($class->_key_field), 52 $base->db->quote_identifier($class->_object_table), 53 ($base->{wexported} ? '' : 'and exported = true'), 54 $base->db->quote_identifier($class->_key_field), 55 ) 56 ); 57 $sth->execute; 58 my @keys; 59 while(my $res = $sth->fetchrow_hashref) { 60 push(@keys, $res->{k}); 61 } 62 @keys 63 } 64 44 65 sub list_from_rev { 45 66 my ($class, $base, $rev) = @_; 46 67 my $sth = $base->db->prepare_cached( 47 68 sprintf( 48 q{select %s as k from %s where rev > ? %s order by %s}, 69 q{select %s as k from %s where rev > ? and internobject = false 70 and oalias IS NULL %s order by %s}, 49 71 $base->db->quote_identifier($class->_key_field), 50 72 $base->db->quote_identifier($class->_object_table), … … 135 157 label => l('Created by'), 136 158 }, 159 oalias => { 160 inline => 1, 161 reference => $class->type, 162 label => 'Alias for', 163 post => sub { 164 my ($self, $value) = @_; 165 $self->object->_update_aliases_ptr(); 166 }, 167 checkinput => sub { 168 my ($oalias) = @_; 169 my $otype = $class->type; 170 171 if (my ($aliasotype, $aliasoname, $aliasattr) = $oalias =~ m/^([^\/]+)\.([^\.]+)\.(.*)$/) { 172 my $attribute = $base->attribute($aliasotype, $aliasattr) or do { 173 $base->log(LA_DEBUG, "Oalias %s (%s): can fetch attibute %s/%s", 174 $otype, $oalias, $aliasotype, $aliasattr); 175 return; 176 }; 177 my $refotype = $attribute->reference or do { 178 $base->log(LA_DEBUG, "Oalias %s (%s): Attribute does not reference an object", 179 $otype, $oalias); 180 return; 181 }; 182 183 if ($attribute->multiple) { 184 $base->log(LA_DEBUG, "Oalias %s (%s): Attribute must not be multiple", 185 $otype, $oalias); 186 return; 187 }; 188 } elsif(!$base->get_object($otype, $oalias)) { 189 $base->log(LA_DEBUG, "Cannot get object $otype/$oalias"); 190 return; 191 } 192 return 1; 193 }, 194 }, 195 internobject => { 196 inline => 1, 197 label => 'True if object is for internal use', 198 hide => 1, 199 }, 200 nodelete => { 201 inline => 1, 202 label => 'True if the object is protected against deletion', 203 hide => 1, 204 }, 137 205 ); 138 206 … … 161 229 } 162 230 foreach (@{$base->{__cache}{$class->_object_table}{extend}}) { 163 $base->log(LA_DEBUG, 'Attribute %s for %s not declared in code', $_, $class->type) if(!exists($info->{$_}));231 #$base->log(LA_DEBUG, 'Attribute %s for %s not declared in code', $_, $class->type) if(!exists($info->{$_})); 164 232 $info->{$_} ||= {}; 165 233 } … … 185 253 186 254 my $sth = $base->db->prepare_cached( 187 sprintf(q{ select 1 from %s where %s = ? %s},255 sprintf(q{ select 1 from %s where %s = ?}, 188 256 $base->db->quote_identifier($class->_object_table), 189 257 $base->db->quote_identifier($class->_key_field), 190 ($base->{wexported} ? '' : 'and exported = true'),191 258 ), 192 259 ); … … 288 355 } 289 356 357 =head2 refreshRev 358 359 Increase revision of the object to force synchronisation 360 361 =cut 362 363 sub refreshRev { 364 my ($self) = @_; 365 366 my $sth = $self->db->prepare_cached( 367 sprintf(q{ 368 UPDATE %s SET rev = nextval('revisions_rev_seq'::regclass) WHERE %s = ? 369 }, 370 $self->db->quote_identifier($self->_object_table), 371 $self->db->quote_identifier($self->_key_field), 372 ) 373 ); 374 $sth->execute($self->id); 375 } 376 377 =head2 CreateAlias($base, $name, $for) 378 379 Create an alias named C<$name> with pointing to C<$for> 380 381 =cut 382 383 sub CreateAlias { 384 my ($class, $base, $name, $for) = @_; 385 386 $base->log(LA_ERR, '%s does not support alias object, alias %s not created', $class->type, $name); 387 } 388 290 389 sub _delete { 291 390 my ($class, $base, $id) = @_; … … 295 394 my $obj = $base->get_object($class->type, $id) 296 395 or return; 396 397 if ($obj->_get_attributes('internobject')) { 398 # Cannot happend: internal are not fetchable 399 $base->log(LA_ERR,'Cannot delete %s/%s: is an internal object', $class->type, $id); 400 return; 401 } 402 if ($obj->_get_attributes('nodelete')) { 403 $base->log(LA_ERR,'Cannot delete %s/%s: is write protected', $class->type, $id); 404 return; 405 } 297 406 298 407 my $sthd = $base->db->prepare_cached( … … 411 520 my $val = $__cache->{$self->id}{$field}; 412 521 return @{$val || []} > 1 ? $val : $val->[0]; 522 } 523 } 524 525 sub GetAttributeValue { 526 my ($self, $cfield) = @_; 527 528 my $res = $self->SUPER::GetAttributeValue($cfield) or return; 529 530 my $attribute = $self->attribute($cfield) or do { 531 $self->base->log(LA_WARN, "Unknow attribute $cfield"); 532 return; 533 }; 534 535 if (my $ref = $attribute->reference) { 536 my @deref; 537 foreach my $v (ref $res ? @{ $res } : $res) { 538 my $derefobj = $self->base->_derefObject($ref, $v); 539 push(@deref, $derefobj ? $derefobj->id : $v); 540 } 541 return scalar(@deref) > 1 ? \@deref : $deref[0]; 542 } else { 543 return $res; 413 544 } 414 545 } … … 588 719 } 589 720 721 =head2 SetNoDelete($value) 722 723 Set nodelete attribute to true or false 724 725 =cut 726 727 sub SetNoDelete { 728 my ($self, $value) = @_; 729 730 my $sthr = $self->db->prepare_cached( 731 sprintf( 732 q{update %s set nodelete = ? where %s = ?}, 733 $self->db->quote_identifier($self->_object_table), 734 $self->db->quote_identifier($self->_key_field), 735 ) 736 ); 737 738 if (($sthr->execute($value ? 'true' : 'false', $self->id) || 0) != 1) { 739 $self->log(LA_ERR, "Erreur seting nodelete for %s/%s to %s", 740 $self->type, 741 $self->id, 742 $value, 743 ); 744 return; 745 } 746 747 1; 748 } 749 590 750 =head2 find_next_numeric_id($class, $base, $field, $min, $max) 591 751 … … 644 804 $attr->{inline} 645 805 ? sprintf( 646 q{select %s as value from %s } . ($base->{wexported} ? '' : ' and "exported" = true'),806 q{select %s as value from %s where internobject = false} . ($base->{wexported} ? '' : ' and "exported" = true'), 647 807 $base->db->quote_identifier($attr->iname), 648 808 $base->db->quote_identifier($class->_object_table), … … 650 810 : sprintf( 651 811 q{select value from %s join 652 %s on %s.ikey = %s.okey where attr = ? group by value} . ($base->{wexported} ? '' : ' and "exported" = true'), 812 %s on %s.ikey = %s.okey where attr = ? and internobject = false group by value} . 813 ($base->{wexported} ? '' : ' and "exported" = true'), 653 814 $base->db->quote_identifier($class->_object_table), 654 815 $base->db->quote_identifier($class->_object_table . … … 756 917 # foo=1 bar=1 => foo =1 and bar = 2 757 918 my $results = {}; 919 my $noalias = 0; 758 920 759 921 @filter = grep { defined($_) && $_ ne '' } @filter; … … 776 938 return; 777 939 }; 940 $attribute->name eq 'oalias' and $noalias = 1; 778 941 defined($val) or $val = ''; 779 942 … … 822 985 } 823 986 987 # We add to result aliases: 988 if(keys %mresults && !$noalias) { 989 my @alias = $class->_search_uniq_filter($base, 'oalias', '=', join('||', keys %mresults)); 990 foreach(@alias) { 991 $mresults{$_} = 1; 992 } 993 } 994 824 995 return(sort keys %mresults); 825 996 } 826 827 997 828 998 sub _search_uniq_filter { … … 838 1008 839 1009 my @values = split(/([\|\&]+)/, $value); 1010 return unless(@values); 1011 1012 $base->log(LA_DEBUG, "Uniq search for $attr $operator (%s)", join(' ', @values)); 840 1013 841 1014 # We detect if we can do a very quick search: … … 940 1113 # building the query 941 1114 if (!$base->{wexported}) { 942 push(@attrsql, 'intersect', sprintf( 943 q{select ikey from %s where exported = true}, 1115 push(@attrsql, 'intersect') if (@attrsql); 1116 push(@attrsql, sprintf( 1117 q{select ikey from %s where exported = true and internobject = false}, 944 1118 $base->db->quote_identifier($class->_object_table) 945 1119 ) … … 949 1123 sprintf(q{ 950 1124 select name from %s 1125 where internobject = false 951 1126 %s 952 1127 order by name … … 954 1129 $base->db->quote_identifier($class->_object_table), 955 1130 @attrsql 956 ? " whereikey in (\n" . join(" ", @attrsql) . ")\n"1131 ? "and ikey in (\n" . join(" ", @attrsql) . ")\n" 957 1132 : '', 958 1133 ) … … 1065 1240 } 1066 1241 1242 sub _update_aliases_ptr { 1243 my ($self) = @_; 1244 1245 my $atype = $self->type; 1246 my $name = $self->id; 1247 my $base = $self->base; 1248 1249 foreach my $otype ($base->list_supported_objects) { 1250 foreach my $attr ($base->list_canonical_fields($otype, 'r')) { 1251 $attr =~ /^(oalias|modifiedby|createdby)$/ and next; 1252 my $attribute = $base->attribute($otype, $attr); 1253 my $ref = $attribute->reference or next; 1254 1255 if ($ref eq $atype) { 1256 $base->log(LA_DEBUG, "Searching object referencing alias %s/%s in %s->%s", 1257 $atype, $name, $otype, $attr); 1258 foreach my $target ($base->search_objects($otype, "$attr\=$name", 'oalias=NULL')) { 1259 $base->log(LA_DEBUG, "Update ref for object %s/%s", $otype, $target); 1260 my $otarget = $base->get_object($otype, $target) or next; 1261 $otarget->refreshRev; 1262 } 1263 } 1264 } 1265 } 1266 } 1267 1067 1268 1; 1068 1269
Note: See TracChangeset
for help on using the changeset viewer.