source: trunk/LATMOS-Accounts/bin/la-dump @ 2321

#!/usr/bin/perl

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

=head1 NAME

    la-dump - Extract information

=head1 SYNOPSIS

    la-dump [options] filter [filter2 [...]]

=head1 OPTIONS

=over 4

=item --config configdir

Use this configuration directory instead default

=item --base basename

Perform search in this specific base instead default

=item --with-unexp

Take into account all objects (even non propagated ones, with attribute
'exported'=0) (default)

=item --wo-unexp

Take into account only propagated objects (attribute 'exported'=1)

=item --recur

Dump objects recursively

=item --subotype OTYPE1 [--subotype OTYPE2]

The list of subobject type to dump

=item --fmt format

Specify a format of output.

=item FILTER

Filter are in form "[ATTRIBUTE][OPERATOR][VALUE]"

where attribute is a supported attribute.

OPERATOR can be:

=over 4

=item C<=>

Search object having attribute strictely equal to VALUE. If VALUE is C<*> match
any non empty value.

=item C<~>

Search object having attribute containing VALUE.

=back

=back

=cut

GetOptions(
    'c|config=s'        => \my $config,
    'b|base=s'          => \my $base,
    'o|object=s'        => \my $otype,
    'fmt=s'             => \my @fmt,
    'recur'             => \my $recur,
    'subotype=s'        => \my @SubOtype,
    'no-unexp|wo-unexp' => \my $nounexp,
    'with-unexp'        => \my $unexp,
    'u|username=s'      => \my $username,
    'help'              => sub { pod2usage(0) },
    'f=s'               => \my $filename,
) or pod2usage();

$otype ||= 'user';

my $LA = LATMOS::Accounts->new($config, noacl => $username ? 0 : 1);
my $labase = $LA->base($base);
$labase && $labase->load or die "Cannot load base";

$labase->unexported($nounexp ? 0 : 1);
$labase->SetConnectedUser($username) if ($username);

my @result = $labase->search_objects($otype, @ARGV);

my @Dump = ();

foreach (@result) {
    my $o = $labase->get_object($otype, $_) or next;
    push(@Dump, $o->DataDump(
            {
                recur => $recur,
                SubOtype => \@SubOtype,
                noSchema => 1,
            }
    ));
}

@fmt = qw(xml) unless (@fmt);

foreach my $Format (@fmt) {

    my $string = '';

    for ($Format) {
        /^xml$/ and do {
            eval {
                require XML::Simple;
            };
            if ($@) {
                warn "Cannot output xml: XML::Simple perl module missing";
                next;
            }
            my $xml = XML::Simple->new();
            $string = $xml->XMLout(\@Dump);
            next;
        };
        /^json$/ and do {
            eval {
                require JSON;
            };
            if ($@) {
                warn "Cannot output xml: JSON perl module missing";
                next;
            }
            my $json = JSON->new;
            $json->indent(1);
            $string = $json->encode(\@Dump);
            next;
        };
        /^yaml$/ and do {
            eval {
                require YAML;
            };
            if ($@) {
                warn "Cannot output xml: YAML perl module missing";
                next;
            }
            $string = YAML::Dump(\@Dump);
            next;
        };
        /^pl$/ and do {
            require Data::Dumper;
            $string = Data::Dumper::Dumper(\@Dump);
        }
    }

    if ($filename) {
        my $realFilename = $filename . '.' . $Format;
        open(my $handle, '>', $realFilename) or do {
            warn "Cannot open $realFilename for wrinting";
            next;
        };
        print $handle $string;
        close($handle);
    } else {
        print $string;
    }
}

exit(0);