source: LATMOS-Accounts/bin/la-create @ 376

#!/bin/env perl

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

=head1 NAME

    la-create -- Tools to create object in LATMOS::Account system

=head1 SYNOPSIS

    la-create [options] obj_id

=cut

GetOptions(
    'c|config=s' => \my $config,
    'b|base=s'   => \my $base,
    'o|object=s' => \my $otype,
    'f=s'        => \my $inputfile,
    'ro'         => \my $with_ro,
    'u|update'   => \my $allow_update,
    'help'       => sub { pod2usage(0) },
) or pod2usage();

$otype ||= 'user';

=head1 OPTIONS

=over 4

=item -c|--config configfile

Use this cofngiuration file instead the default one

=item -b|--base basename

Query this specific base instead default.

=item -o|object object_type

Query should be performed on this objects. Default is to user 'User' object.

=item --ro

Include also read-only attributes as comment

=item -u|--update

If the object already exists, then updating it

=item -f FILE

Use this file to get attributes (- use stdin)

=back

=cut

my $LA = LATMOS::Accounts->new($config);
my $labase = $base ? $LA->base($base) : $LA->default_base;
$labase && $labase->load or die "Cannot load base";

$labase->is_supported_object($otype) or die "$otype object unsupported\n";
my $objname = $ARGV[0];

sub input_from_handle {
    my ($fh) = @_;
    my %attr = LATMOS::Accounts::Utils::parse_obj_file($fh);
    if (my $obj = $labase->get_object($otype, $objname)) {
        if ($allow_update) {
            my $res = $obj->set_c_fields(%attr);
            if ($res) {
                print "Changes applied\n";
                $labase->commit;
            }
            return $res;
        } else {
            die "Object $otype $objname already exists, aborting\n";
        }
    } else {
        my $res = $labase->create_c_object($otype, $objname, %attr);
        if($res) {
            print "Changes applied\n";
            $labase->commit;
        }
        return $res;
    }
}

if ($inputfile) {
    my $handle;
    if ($inputfile eq '-') {
        $handle = *STDIN;
    } else {
        open($handle, '<', $inputfile) or die
        "Cannot open input file $@\n";
    }
    my $res = input_from_handle($handle);
    close($handle);
    exit(!$res);
} else {
    exit ! LATMOS::Accounts::Utils::dump_read_temp_file(
        sub {
            my ($fh) = @_;
            $labase->text_empty_dump($fh, $otype,
                {
                    only_rw => !$with_ro,
                }
            );
        },
        sub {
            my ($fh) = @_;
            return input_from_handle($fh);
        }
    );
}