[25] | 1 | #!/usr/bin/perl |
---|
| 2 | |
---|
| 3 | use strict; |
---|
| 4 | use warnings; |
---|
| 5 | use LATMOS::Accounts; |
---|
| 6 | use Getopt::Long; |
---|
| 7 | use Pod::Usage; |
---|
| 8 | |
---|
[38] | 9 | =head1 NAME |
---|
| 10 | |
---|
| 11 | la-config - Tools to query configuration of LATMOS::Accounts system. |
---|
| 12 | |
---|
| 13 | =head1 SYNOPSIS |
---|
| 14 | |
---|
[455] | 15 | List supported base, synchronisation, objects and attributes |
---|
[38] | 16 | |
---|
[455] | 17 | la-config [option] [object] |
---|
[38] | 18 | |
---|
| 19 | =cut |
---|
| 20 | |
---|
[25] | 21 | GetOptions( |
---|
| 22 | 'c|config=s' => \my $config, |
---|
[455] | 23 | 'lb' => \my $listbases, |
---|
| 24 | 'ls' => \my $listsynchros, |
---|
| 25 | 'base=s' => \my $base, |
---|
[38] | 26 | 'help' => sub { pod2usage(0) }, |
---|
[25] | 27 | ) or pod2usage(); |
---|
| 28 | |
---|
[38] | 29 | =head1 OPTIONS |
---|
| 30 | |
---|
[861] | 31 | =item -c|--config configdir |
---|
[38] | 32 | |
---|
[861] | 33 | Use this configuration directory instead of the default one. |
---|
[38] | 34 | |
---|
| 35 | =item -b|--base basename |
---|
| 36 | |
---|
| 37 | Perform query on this base |
---|
| 38 | |
---|
[455] | 39 | =item --lb |
---|
| 40 | |
---|
| 41 | List base setup in config |
---|
| 42 | |
---|
| 43 | =item --ls |
---|
| 44 | |
---|
| 45 | List synchronisation setup in config |
---|
| 46 | |
---|
[38] | 47 | =cut |
---|
| 48 | |
---|
[457] | 49 | my $LA = LATMOS::Accounts->new($config, noacl => 1); |
---|
[25] | 50 | |
---|
[455] | 51 | if ($listbases) { |
---|
| 52 | my $default = $LA->default_base_name || ''; |
---|
| 53 | print "Bases:\n"; |
---|
| 54 | foreach ($LA->list_bases) { |
---|
| 55 | printf(" %s %s (%s)\n", |
---|
| 56 | ($_ eq $default ? '*' : ' '), |
---|
| 57 | $_, |
---|
| 58 | $LA->val($_, 'type', 'Err: no type') |
---|
| 59 | ); |
---|
| 60 | } |
---|
| 61 | } |
---|
| 62 | if ($listsynchros) { |
---|
| 63 | my $default_sync = $LA->default_synchro_name || ''; |
---|
| 64 | print "Syncro:\n"; |
---|
| 65 | foreach ($LA->list_synchro) { |
---|
| 66 | printf(" %s %s (%s => %s)\n", |
---|
| 67 | ($_ eq $default_sync ? '*' : ' '), |
---|
| 68 | $_, |
---|
| 69 | $LA->val("sync:$_", 'from', 'Err: No from'), |
---|
| 70 | join(', ', $LA->val("sync:$_", 'to', 'Err: No to')), |
---|
| 71 | ); |
---|
| 72 | } |
---|
| 73 | } |
---|
| 74 | if (!($listsynchros || $listbases)) { |
---|
| 75 | if (my $otype = $ARGV[0]) { |
---|
[38] | 76 | my $labase = $base ? $LA->base($base) : $LA->default_base; |
---|
[455] | 77 | printf "Supported field for object type %s (base %s)\n", |
---|
| 78 | $otype, |
---|
| 79 | $base ? $base : $LA->default_base_name; |
---|
[861] | 80 | foreach($labase->list_canonical_fields($otype, 'a')) { |
---|
| 81 | my $attr = $labase->attribute($otype, $_); |
---|
| 82 | printf( |
---|
| 83 | " %s (%s%s)\n", $_, |
---|
| 84 | 'r', |
---|
| 85 | ($attr->readonly ? 'w' : ' '), |
---|
| 86 | ) |
---|
| 87 | } |
---|
[455] | 88 | } else { |
---|
[549] | 89 | my $labase = $base ? $LA->base($base) : $LA->default_base |
---|
| 90 | or die "Cannot instanciate " . |
---|
| 91 | $base ? $base : $LA->default_base_name . "\n"; |
---|
[455] | 92 | printf "Supported object type by base %s\n", |
---|
[549] | 93 | $base ? $base : $LA->default_base_name; |
---|
[861] | 94 | print " $_\n" foreach($labase->ordered_objects); |
---|
[455] | 95 | } |
---|
[25] | 96 | } |
---|