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

#!/bin/env perl

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

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

$otype ||= 'user';

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 @fields = $labase->list_canonicals_fields($otype, 'w');
my %attr;

while (1) {
    my ($fh, $filename) = File::Temp::tempfile();
    printf $fh "## new object %s: %s\n", $otype, $ARGV[0];
    foreach (@fields) {
        print $fh "$_:" . ($attr{$_} || '') . "\n";
    }
    close($fh);
    my @stat = stat($filename);
    system('vi', $filename, '+ 1');
    if ((stat($filename))[9] == $stat[9]) {
        warn "No change, aborting\n";
        unlink($filename);
        last;
    } else {
        open($fh, '<', $filename);
        while (my $line = <$fh>) {
            chomp($line);
            $line =~ s/#.*//;
            my ($fi, $val) = $line =~ /^(\w+)\s*:\s*(.*)/ or next;
            $attr{$fi} = $val;
        }
        close($fh);
        unlink($filename);
        $labase->create_c_object($otype, $ARGV[0], %attr) or do {
            warn "Cannot create object: Redit ?\n";
            my $reply = <STDIN>;
            $reply =~ /^[yY]/ or exit(1);
            next;
        };
        $labase->commit;

        warn $LA->default_synchro;
        if (!$base) {
            if (my $sync = $LA->default_synchro) {
                for (1) {
                    $sync->load_dest and do {
                        warn  "Cannot load dest";
                        last;
                    };
                    $sync->process();
                }
            }
        }
        last;
    }
}