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

#!/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

Show configured bases:

    la-config

List supported attribute:

    la-config [option] att
    la-config [option] att objects_type

=cut

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

=head1 OPTIONS

=item -c|--config configfile

Use this configuration file instead default

=item -b|--base basename

Perform query on this base

=cut

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

my $action = shift(@ARGV) || '';
for ($action) {
    m/^$/ and do {
        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')
            );
        }
        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')),
            );
        }
        last;
    };
    m/^att(ributes)?$/ and do {
        my $labase = $base ? $LA->base($base) : $LA->default_base;
        if (my $otype = shift(@ARGV)) {
            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_canonicals_fields($otype, 'a'));
        } else {
            printf "Supported object type by base %s\n",
                $base ? $base : $LA->default_base_name;
            print "  $_\n" foreach($labase->list_supported_objects);
        }
    };
}