- Timestamp:
- 06/19/19 20:02:16 (5 years ago)
- Location:
- trunk/LATMOS-Accounts
- Files:
-
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/LATMOS-Accounts/bin/la-query
r2241 r2267 74 74 (Only if obj_id is specified) Include also read-only attributes as comments. 75 75 76 =item --recur 77 78 Dump also all related objects 79 76 80 =item --fmt format 77 81 -
trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Objects.pm
r2235 r2267 839 839 my ($self, $config, $base) = @_; 840 840 841 $config->{level} ||= 0; 841 842 my $otype = $self->type; 842 843 $base ||= $self->base; 843 844 my $dump; 844 845 if (ref $self) { 845 $dump .= sprintf "# base %s: object %s/%s\n", 846 $dump .= sprintf "%s# base %s: object %s/%s\n", 847 ' ' x $config->{level}, 846 848 $base->label, $self->type, $self->id; 847 849 } 848 $dump .= sprintf "# %s\n", scalar(localtime); 850 $dump .= sprintf( 851 "%s# %s\n", 852 ' ' x $config->{level}, 853 scalar(localtime) 854 ); 849 855 850 856 foreach my $attr (sort { $a cmp $b } $base->list_canonical_fields($otype, … … 866 872 $_ ||= ''; 867 873 s/\r?\n/\\n/g; 868 $dump .= sprintf("%s%s:%s\n", 874 $dump .= sprintf("%s%s%s%s:%s\n", 875 ' ' x $config->{level}, 869 876 $oattr->ro ? '# (ro) ' : '', 877 $config->{level} ? $self->type . '[' . $self->id . '].' : '', 870 878 $attr, $_ ? " $_" : ''); 871 879 } … … 883 891 } 884 892 } 893 894 if (ref $self && $config->{recur}) { 895 my %subobj = $self->ListChildObjects; 896 foreach my $otype (keys %subobj) { 897 foreach my $oname (sort @{ $subobj{$otype} }) { 898 my $obj = $self->base->get_object($otype, $oname) or next; 899 $dump .= "\n"; 900 $dump .= $obj->dump({ %{$config || {}}, recur => $config->{recur}, level => $config->{level} + 2 }); 901 } 902 } 903 } 904 885 905 return $dump; 886 906 } -
trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Sql/User.pm
r2265 r2267 66 66 address => 'user', 67 67 employment => 'user', 68 nethost => [ 'owner', 'user' ], 68 69 }, 69 70 } -
trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Sql/objects.pm
r2266 r2267 313 313 314 314 sub ParentObject { } 315 316 =head2 ListChildObjects 317 318 Return objects having this object as Parent 319 320 =cut 321 322 sub ListChildObjects { 323 my ($self) = @_; 324 325 my $Subotype = $self->GetOtypeDef or return; 326 327 my %res; 328 329 foreach my $otype (keys %$Subotype) { 330 foreach my $attr (ref $Subotype->{$otype} ? @{ $Subotype->{$otype} } : $Subotype->{$otype}) { 331 my @list = $self->base->search_objects( $otype, $attr . '=' . $self->id ); 332 if (@list) { 333 push(@{ $res{$otype} }, @list); 334 } 335 } 336 } 337 338 %res; 339 } 315 340 316 341 sub _get_ikey { -
trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Cli/Base.pm
r2231 r2267 225 225 Instead displaying attribute list use C<format> as formating string 226 226 227 =item recur 228 229 Dump object and all related objects 230 227 231 =back 228 232 … … 241 245 'fmt=s' => \my $fmt, 242 246 'filefmt=s' => \my $filefmt, 247 'recur' => \my $recur, 243 248 }, @_ 244 249 ); … … 271 276 } else { 272 277 $_->text_dump( $self->Context->Out, { 278 recur => $recur, 273 279 empty_attr => $empty_attr, 274 280 only_rw => !$with_ro, -
trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Cli/Object.pm
r2241 r2267 519 519 }); 520 520 } 521 if (1) { # TODO test SQL base 522 $self->add_func('extract', { 523 help => 'extract information about objects', 524 code => sub { 525 my ($env, $action) = @_; 526 foreach my $obj (sort @{$env->{_objects}}) { 527 print $OUT $obj->dump({ recur => 1 }); 528 } 529 $env->rollback; 530 }, 531 }); 532 } 521 533 522 534 return $self;
Note: See TracChangeset
for help on using the changeset viewer.