#!/usr/bin/perl use strict; use warnings; use LATMOS::Accounts; use Getopt::Long; use Pod::Usage; =head1 NAME la-attributes - Show summary of supported objects and attributes of config bases =head1 SYNOPSIS List supported bases, synchronisations, objects and attributes la-attributes [option] la-attributes [option] object =cut GetOptions( 'c|config=s' => \my $config, 'b|base=s' => \my @qbases, 'help' => sub { pod2usage(0) }, ) or pod2usage(); =head1 OPTIONS =over 4 =item -c|--config configdir Use this configuration directory instead of thr default one. =item -b|--base basename Perform query on this base(s) (can be set multiple times). =back =cut my $LA = LATMOS::Accounts->new($config, noacl => 1); if (!@qbases) { @qbases = $LA->list_bases } if (my ($otype) = @ARGV) { my %supported; my @bases; my %unsupported; foreach my $basename (@qbases) { my $labase = $LA->base($basename) or next; push(@bases, $basename); $labase->is_supported_object($otype) or do { $unsupported{$basename} = 1; next; }; foreach($labase->list_canonical_fields($otype, 'a')) { my $attr = $labase->attribute($otype, $_); $supported{$_}{$basename} = sprintf('%s', $attr ? ($attr->ro ? 'r ' : 'rw') : ' ' ); } } my ($objlen) = sort { $b <=> $a } map { length($_) } keys %supported; $objlen+=1; my $header = '|' . (' ' x $objlen) . ' | ' . join(' | ', @bases) . ' |'; print '-' x length($header) . "\n"; print $header . "\n"; print '-' x length($header) . "\n"; foreach my $obj (sort keys %supported) { printf("|%${objlen}s |", $obj); foreach (@bases) { print(' '. ($unsupported{$_} ? 'NA' : $supported{$obj}{$_} || ' ') ); print ' ' x (length($_) - 2) . ' |'; } print "\n"; print '-' x length($header) . "\n"; } } else { my %supported; my @bases; foreach my $basename (@qbases) { my $labase = $LA->base($basename) or next; push(@bases, $basename); foreach($labase->list_supported_objects) { $supported{$_}{$basename} = 1; } } my ($objlen) = sort { $b <=> $a } map { length($_) } keys %supported; $objlen+=1; my $header = '|' . (' ' x $objlen) . ' | ' . join(' | ', @bases) . ' |'; print '-' x length($header) . "\n"; print $header . "\n"; print '-' x length($header) . "\n"; foreach my $obj (sort keys %supported) { printf("|%${objlen}s |", $obj); foreach (@bases) { print($supported{$obj}{$_} ? ' x' : ' '); print ' ' x (length($_) - 1) . ' |'; } print "\n"; print '-' x length($header) . "\n"; } } __END__