[1865] | 1 | #!/usr/bin/perl |
---|
| 2 | |
---|
| 3 | use strict; |
---|
| 4 | use warnings; |
---|
| 5 | use LATMOS::Accounts; |
---|
| 6 | use Getopt::Long; |
---|
| 7 | use Pod::Usage; |
---|
| 8 | |
---|
| 9 | =head1 NAME |
---|
| 10 | |
---|
| 11 | la-sql-properties - Tools to edit object internals SQL base properties |
---|
| 12 | |
---|
| 13 | =head1 SYNOPSIS |
---|
| 14 | |
---|
| 15 | la-sql-properties [options] obj_id |
---|
| 16 | |
---|
| 17 | =cut |
---|
| 18 | |
---|
| 19 | GetOptions( |
---|
| 20 | 'c|config=s' => \my $config, |
---|
| 21 | 'b|base=s' => \my $base, |
---|
| 22 | 'o|object=s' => \my $otype, |
---|
| 23 | 'nodelete=s' => \my $nodelete, |
---|
| 24 | 'help' => sub { pod2usage(0) }, |
---|
| 25 | ) or pod2usage(); |
---|
| 26 | |
---|
| 27 | $otype ||= 'user'; |
---|
| 28 | |
---|
| 29 | =head1 OPTIONS |
---|
| 30 | |
---|
| 31 | =over 4 |
---|
| 32 | |
---|
| 33 | =item -c|--config configdir |
---|
| 34 | |
---|
| 35 | Use this configuration directory instead of the default one. |
---|
| 36 | |
---|
| 37 | =item -b|--base basename |
---|
| 38 | |
---|
| 39 | Query this specific base instead of the default one. |
---|
| 40 | |
---|
| 41 | =item -o|object object_type |
---|
| 42 | |
---|
| 43 | Query will be performed on this object. Default is the 'User' object. |
---|
| 44 | |
---|
| 45 | =item --nodelete on|off |
---|
| 46 | |
---|
| 47 | Turn attribute C<nodelete> to C<on> or C<off> |
---|
| 48 | |
---|
| 49 | =back |
---|
| 50 | |
---|
| 51 | =cut |
---|
| 52 | |
---|
| 53 | if (!$ARGV[0]) { warn "You must specify 'obj_id', aborting\n"; pod2usage(); } |
---|
| 54 | |
---|
| 55 | my $LA = LATMOS::Accounts->new($config, noacl => 1); |
---|
| 56 | my $labase = $LA->base($base); |
---|
| 57 | $labase && $labase->load or die "Cannot load base"; |
---|
| 58 | $labase->wexported(1); |
---|
| 59 | |
---|
| 60 | my $ouid = shift(@ARGV) or do { pod2usage(1); }; |
---|
| 61 | |
---|
| 62 | my $obj = $labase->GetRawObject($otype, $ouid) or do { |
---|
| 63 | die "Object $otype $ouid not found\n"; |
---|
| 64 | }; |
---|
| 65 | |
---|
| 66 | sub checkonoff { |
---|
| 67 | my ($value, $step) = @_; |
---|
| 68 | if (! $value =~ /^(on|off)$/) { |
---|
| 69 | warn "Value for --$step must be on or off\n"; |
---|
| 70 | pod2usage(1); |
---|
| 71 | } |
---|
| 72 | return $value eq 'on' ? 1 : 0; |
---|
| 73 | } |
---|
| 74 | |
---|
| 75 | if (defined($nodelete)) { |
---|
| 76 | my $v = checkonoff($nodelete, 'nodelete'); |
---|
| 77 | $obj->SetNoDelete($v); |
---|
| 78 | } |
---|
| 79 | |
---|
| 80 | print 'internal: ' . ($obj->get_field('internobject') ? 'yes' : 'no') . "\n"; |
---|
| 81 | print 'nodelete: ' . ($obj->get_field('nodelete') ? 'yes' : 'no') . "\n"; |
---|