#
# Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
# notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
#
# $Id$
use Prima::VB::CfgMaint;
die <<ABOUT unless @ARGV;
format: cfgmaint [options] command object [parameters]
options:
-r use root config to write
-b use both user and root config to read
-x do not write backups
-o read-only mode
-p execute 'use Prima;' code
commands:
a - add p|m name
l - list w|p|m ( w - [page])
d - remove w|p|m name
r - rename w|p name new_name
m - move w|p name new_page or none to end
objects:
w - widgets
p - pages
m - modules
examples:
cfgmaint -r a m CPAN/Prima/VB/New/MyCtrls.pm
cfgmaint -b l w
ABOUT
my @cmd = ();
my $both = 0;
my $ro = 0;
$Prima::VB::CfgMaint::systemWide = 0;
$Prima::VB::CfgMaint::backup = 1;
for ( @ARGV) {
push( @cmd, $_), next unless /^-/;
$_ = lc $_;
s/^-//;
for ( split( '', $_)) {
if ( $_ eq 'b') {
$both = 1;
} elsif ( $_ eq 'r') {
$Prima::VB::CfgMaint::systemWide = 1;
} elsif ( $_ eq 'x') {
$Prima::VB::CfgMaint::backup = 0;
} elsif ( $_ eq 'o') {
$ro = 1;
} elsif ( $_ eq 'p') {
eval "use Prima;";
die "$@" if $@;
} else {
die "Unknown option: $_\n";
}
}
}
sub check
{
die "format: $cmd[0] [$_[0]]\n" if scalar @cmd < $_[1];
my %h = map { $_ => 1 } split( '', $_[0]);
return if $h{$cmd[1]};
die "Invalid sub-option: $cmd[1]. Use one of '$_[0]'\n";
}
sub assert
{
die "$_[1]\n" unless $_[0];
}
die "Insufficient number of parameters\n" if @cmd < 2;
$cmd[$_] = lc $cmd[$_] for 0..1;
if ( $cmd[0] eq 'a') {
check('pm', 3);
} elsif ( $cmd[0] eq 'l') {
check('wpm', 2);
} elsif( $cmd[0] eq 'd') {
check('wpm', 3);
} elsif( $cmd[0] eq 'r') {
check('wp', 4);
} elsif( $cmd[0] eq 'm') {
check('wp', 3);
die "Insufficient number of parameters\n" if @cmd < 4 && $cmd[1] eq 'w';
} else {
die "Unknown action: $cmd[0]\n";
}
my @r;
if ( $both) {
@r = Prima::VB::CfgMaint::read_cfg();
} else {
@r = Prima::VB::CfgMaint::open_cfg();
}
die "$r[1]\n" unless $r[0];
if ( $cmd[0] eq 'a') {
if ( $cmd[1] eq 'm') {
my %cs = %Prima::VB::CfgMaint::classes;
my %pg = map { $_ => 1} @Prima::VB::CfgMaint::pages;
assert( Prima::VB::CfgMaint::add_module( $cmd[2]));
for ( @Prima::VB::CfgMaint::pages) {
next if $pg{$_};
print "page '$_' added\n";
}
for ( keys %Prima::VB::CfgMaint::classes) {
next if $cs{$_};
print "widget '$_' added\n";
}
} elsif ( $cmd[1] eq 'p') {
my %pg = map { $_ => 1} @Prima::VB::CfgMaint::pages;
die "Page '$cmd[2]' already exists\n" if $pg{$cmd[2]};
push @Prima::VB::CfgMaint::pages, $cmd[2];
}
} elsif ( $cmd[0] eq 'l') {
if ( $cmd[1] eq 'w') {
my $ok = defined $cmd[2] ? 0 : 1;
for ( keys %Prima::VB::CfgMaint::classes) {
next if defined $cmd[2] && $Prima::VB::CfgMaint::classes{$_}-> {page} ne $cmd[2];
print "$_\n";
$ok = 1
}
die "Page '$cmd[2]' doesn't exist\n" unless $ok;
} elsif ( $cmd[1] eq 'p') {
print join( "\n", @Prima::VB::CfgMaint::pages);
} elsif ( $cmd[1] eq 'm') {
my %pk = ();
$pk{$Prima::VB::CfgMaint::classes{$_}-> {module}} = 1
for keys %Prima::VB::CfgMaint::classes;
for ( keys %pk) { print "$_\n"; }
}
exit;
} elsif( $cmd[0] eq 'd') {
if ( $cmd[1] eq 'w') {
die "Widget '$cmd[2]' doesn't exist\n" unless
$Prima::VB::CfgMaint::classes{$cmd[2]};
delete $Prima::VB::CfgMaint::classes{$cmd[2]};
} elsif ( $cmd[1] eq 'p') {
my @p;
for ( @Prima::VB::CfgMaint::pages) {
push ( @p, $_) unless $cmd[2] eq $_;
}
die "Page '$cmd[2]' doesn't exist\n"
if scalar @Prima::VB::CfgMaint::pages == scalar @p;
@Prima::VB::CfgMaint::pages = @p;
for ( keys %Prima::VB::CfgMaint::classes) {
next unless $Prima::VB::CfgMaint::classes{$_}-> {page} eq $cmd[2];
delete $Prima::VB::CfgMaint::classes{$_};
print "Widget '$_' deleted\n";
}
} elsif ( $cmd[1] eq 'm') {
my %dep;
my $ok = 0;
for ( keys %Prima::VB::CfgMaint::classes) {
unless ( $Prima::VB::CfgMaint::classes{$_}-> {module} eq $cmd[2]) {
$dep{$Prima::VB::CfgMaint::classes{$_}-> {page}} = 1;
next;
}
delete $Prima::VB::CfgMaint::classes{$_};
$ok = 1;
print "widget '$_' removed\n";
}
my @newpages;
for ( @Prima::VB::CfgMaint::pages) {
push ( @newpages, $_) , next if $dep{$_};
print "page '$_' removed\n";
}
@Prima::VB::CfgMaint::pages = @newpages;
die "Package '$cmd[2]' not found\n" unless $ok;
}
} elsif( $cmd[0] eq 'r') {
if ( $cmd[1] eq 'w') {
die "Widget '$cmd[2]' doesn't exist\n" unless
$Prima::VB::CfgMaint::classes{$cmd[2]};
die "Widget '$cmd[3]' already exist\n" if
$Prima::VB::CfgMaint::classes{$cmd[3]};
$Prima::VB::CfgMaint::classes{$cmd[3]} = $Prima::VB::CfgMaint::classes{$cmd[2]};
delete $Prima::VB::CfgMaint::classes{$cmd[2]};
} elsif ( $cmd[1] eq 'p') {
my %pg = map { $_ => 1} @Prima::VB::CfgMaint::pages;
die "Page '$cmd[2]' doesn't exist\n" unless $pg{$cmd[2]};
die "Page '$cmd[3]' already exist\n" if $pg{$cmd[3]};
for ( @Prima::VB::CfgMaint::pages) {
$_ = $cmd[3], last if $_ eq $cmd[2];
}
for ( keys %Prima::VB::CfgMaint::classes) {
$Prima::VB::CfgMaint::classes{$_}-> {page} = $cmd[3] if
$Prima::VB::CfgMaint::classes{$_}-> {page} eq $cmd[2];
}
}
} elsif( $cmd[0] eq 'm') {
if ( $cmd[1] eq 'w') {
my %pg = map { $_ => 1} @Prima::VB::CfgMaint::pages;
die "Page '$cmd[3]' doesn't exist\n" unless $pg{$cmd[3]};
die "Widget '$cmd[2]' doesn't exist\n" unless
$Prima::VB::CfgMaint::classes{$cmd[2]};
$Prima::VB::CfgMaint::classes{$cmd[2]}-> {page} = $cmd[3];
} elsif ( $cmd[1] eq 'p') {
my %pg = map { $_ => 1} @Prima::VB::CfgMaint::pages;
die "Page '$cmd[2]' doesn't exist\n" unless $pg{$cmd[2]};
die "Page '$cmd[3]' doesn't exist\n" if ! exists $pg{$cmd[3]} && defined $cmd[3];
my @p;
for ( @Prima::VB::CfgMaint::pages) {
push ( @p, $_) unless $cmd[2] eq $_;
}
@Prima::VB::CfgMaint::pages = @p;
@p = ();
if ( defined $cmd[3]) {
for ( @Prima::VB::CfgMaint::pages) {
push ( @p, $cmd[2]) if $_ eq $cmd[3];
push ( @p, $_);
}
@Prima::VB::CfgMaint::pages = @p;
} else {
push @Prima::VB::CfgMaint::pages, $cmd[2];
}
print join( "\n", @Prima::VB::CfgMaint::pages);
}
}
assert( Prima::VB::CfgMaint::write_cfg) unless $ro;
__DATA__
=pod
=head1 NAME
cfgmaint - configuration tool for Visual Builder
=head1 SYNTAX
cfgmaint [ -rbxop ] command object [ parameters ]
=head1 DESCRIPTION
Maintains widget palette configuration for the Visual Builder.
It can be stored in the system-wide and the local user config files.
C<cfgmaint> allows adding, renaming, moving, and deleting the
classes and pages in the Visual Builder widget palette.
=head1 USAGE
C<cfgmaint> is invoked with C<command> and C<object> arguments,
where C<command> defines the action to be taken, and C<object> -
the object to be handled.
=head2 Options
=over
=item -r
Write configuration to the system-wide config file
=item -b
Read configuration from both system-wide and user config files
=item -x
Do not write backups
=item -o
Read-only mode
=item -p
Execute C<use Prima;> code before start. This option
might be necessary when adding a module that relies on the toolkit
but does not invoke the code itself.
=back
=head2 Objects
=over
=item m
Selects a module. Valid for add, list, and remove commands.
=item p
Selects a page. Valid for all commands.
=item w
Selects a widget. Valid for list, remove, rename, and move commands.
=back
=head2 Commands
=over
=item a
Adds a new object to the configuration. Can be either a page or
a module.
=item d
Removes an object.
=item l
Prints object name. In case object is a widget, prints all
registered widgets. If the string is specified as an additional
parameter, it is treated as a page name and only widgets from
the page are printed.
=item r
Renames an object to a new name, which is passed as additional parameter.
Can be either a widget or a page.
=item m
If C<object> is a widget, relocates one or more widgets to a new page.
If C<object> is a page, moves the page before the page specified as an additional parameter,
or to the end if no additional page specified.
=back
=head1 EXAMPLE
Add a new module to the system-wide configuration:
cfgmaint -r a m CPAN/Prima/VB/New/MyCtrls.pm
List widgets, present in both config files:
cfgmaint -b l w
Rename a page:
cfgmaint r p General Basic
=head1 FILES
F<Prima/VB/Config.pm>, F<~/.prima/vbconfig>
=head1 AUTHOR
Dmitry Karasik, E<lt>dmitry@karasik.eu.orgE<gt>.
=head1 SEE ALSO
L<VB>, L<Prima::VB::CfgMaint>
=cut