source: LATMOS-Accounts/bin/la-config @ 656

#!/usr/bin/perl

use strict;
use warnings;
use LATMOS::Accounts;
use Getopt::Long;
use Pod::Usage;

=head1 NAME

    la-config - Tools to query configuration of LATMOS::Accounts system.

=head1 SYNOPSIS

List supported base, synchronisation, objects and attributes

    la-config [option] [object]

=cut

GetOptions(
    'c|config=s' => \my $config,
    'lb'         => \my $listbases,
    'ls'         => \my $listsynchros,
    'base=s'     => \my $base,
    'help'       => sub { pod2usage(0) },
) or pod2usage();

=head1 OPTIONS

=item -c|--config configfile

Use this configuration file instead of the default one.

=item -b|--base basename

Perform query on this base

=item --lb

List base setup in config

=item --ls

List synchronisation setup in config

=cut

my $LA = LATMOS::Accounts->new($config, noacl => 1);

if ($listbases) {
    my $default = $LA->default_base_name || '';
    print "Bases:\n";
    foreach ($LA->list_bases) {
        printf("  %s %s (%s)\n",
            ($_ eq $default ? '*' : ' '),
            $_,
            $LA->val($_, 'type', 'Err: no type')
        );
    }
}
if ($listsynchros) {
    my $default_sync = $LA->default_synchro_name || '';
    print "Syncro:\n";
    foreach ($LA->list_synchro) {
        printf("  %s %s (%s => %s)\n",
            ($_ eq $default_sync ? '*' : ' '),
            $_,
            $LA->val("sync:$_", 'from', 'Err: No from'),
            join(', ', $LA->val("sync:$_", 'to', 'Err: No to')),
        );
    }
}
if (!($listsynchros || $listbases)) {
    if (my $otype = $ARGV[0]) {
        my $labase = $base ? $LA->base($base) : $LA->default_base;
        printf "Supported field for object type %s (base %s)\n",
        $otype,
        $base ? $base : $LA->default_base_name;
        printf(
            "  %s (%s%s)\n", $_,
            ($labase->get_field_name($otype, $_, 'r') ? 'r' : ' '),
            ($labase->get_field_name($otype, $_, 'w') ? 'w' : ' '),
        ) foreach($labase->list_canonical_fields($otype, 'a'));
    } else {
        my $labase = $base ? $LA->base($base) : $LA->default_base
            or die "Cannot instanciate " .
            $base ? $base : $LA->default_base_name . "\n";
        printf "Supported object type by base %s\n",
            $base ? $base : $LA->default_base_name;
        print "  $_\n" foreach($labase->list_supported_objects);
    }
}