[prev] [thread] [next] [lurker] [Date index for 2003/08/13]
Author: richardc
Date: 2003-08-13 16:17:44 +0100 (Wed, 13 Aug 2003)
New Revision: 1341
Modified:
trunk/siesta/bin/nacho2
Log:
initial checkin of jodys code. this still needs some hosing down
Modified: trunk/siesta/bin/nacho2
===================================================================
--- trunk/siesta/bin/nacho2 2003-08-13 14:58:44 UTC (rev 1340)
+++ trunk/siesta/bin/nacho2 2003-08-13 15:17:44 UTC (rev 1341)
@@ -1,504 +1,563 @@
-#!/usr/local/bin/perl -w
+#!/usr/bin/perl -w
# $Id$
use strict;
use File::Path qw(mkpath);
use File::Basename;
use Data::Dumper;
-use Tie::IxHash;
use String::ShellQuote;
use UNIVERSAL::require;
-use Siesta::Config;
+use Pod::Usage;
+use Getopt::ArgvFile qw(argvFile);
+use Getopt::Long;
-BEGIN {
- while (@ARGV) {
- if ($ARGV[0] eq '-d') {
- shift;
- @Siesta::Config::STORAGE = split / /, shift;
- next;
- }
+use vars qw/ $VERSION %COMMANDS /;
+$VERSION = "1.1";
- if ($ARGV[0] eq '-f') {
- shift;
- Siesta::Config->load_from( shift );
- next;
- }
- # do create-database before the require of Siesta::List
- # otherwise Siesta::List &c will choke when they come to
- # __PACKAGE__->set_up_table
-
- if ($ARGV[0] eq 'create-database' ) {
- require Siesta::DBI;
- Siesta::DBI->init_db;
- exit;
- }
- last;
- }
-}
-
-eval {
- require Siesta;
- require Siesta::List;
-};
-if ($@) {
- print "Error initializing Siesta:\n$@\n";
- print "\n\nTry 'nacho create-database' if you are installing siesta for the first time\n";
- exit;
-}
-
-use YAML;
-Siesta->log("nacho invoked by $< $> args\n" . Dump \@ARGV);
-
-tie my %commands, 'Tie::IxHash';
-
=head1 NAME
-nacho - the siesta command line configuration tool
+nacho-ex - the siesta command line configuration tool
-=head1 DESCRIPTION
+=head1 SYNOPSIS
-Via nacho you can control pretty much every aspect of you Siesta system.
+nacho-ex [command [options]...]
-This includes things like creating new lists, creating new members, adding
-members to lists, setting up and configuring plugins for lists and, later,
-probably handling administrative tasks.
+ Generic Options:
+ -d, --database=DBI_URI \ these two options allow you to override
+ -f, --config-file=FILE / the values defined in Siesta::Config
-=head1 COMMANDS
+ -h, --help help text detailing the commands and their options
+ -V, --version prints the version number
-You can optionally pass a database to act on (the default is the
-one defined in Siesta::Config). By doing
- -d database
+ Misc Commands: create-database run-mariache create-backup
+ List Commands: show-lists show-alias describe-list
+ create-list modify-list delete-list
+ set-plugins add-member remove-member
+ Member Commands: show-members describe-member create-member
+ modify-member delete-member
+ Plugin Commands: show-plugins describe-plugins modify-plugin
+ Options and commands may be read from a file by giving the name of the
+ file prefixed by a @. The database and config-file options affect all
+ of the supplied commands. if either of them is supplied more than once,
+ the last one will take priority.
-You can also specify an alternative config file using
+=head1 OPTIONS
- -f <path to config file>
+ NOTE: All command options are mandatory unless otherwise stated
+ Misc Commands:
+ create-database initialises a new database
+ run-mariachi invoke mariachi to make webified archives
+ (depends on the Archive plugin)
+ create-backup prints out a shell script that will restore your system when run
+ -l, --list=NAME limit the backup script to this list (optional)
-The following commands are then valid
+ List Commands:
+ show-lists shows all the lists that are in the system
+ create-list creates a new list
+ -l, --list=NAME the name of the list
+ -o, --owner=EMAIL the administrator of the list
+ -p, --post=EMAIL the address to send mail to for posting to the list
+ -b, --bounces=EMAIL the address that bounces should come back to
-=cut
+ show-alias prints out an alias file entry for a list
+ -l, --list=NAME|ID the name or id of the list
-=head2 create-database
+ describe-list shows all the properties of a list and their values
+ -l, --list=NAME|ID the name or id of the list
-Initialise a new database
+ modify-list change one or more properties of a list
+ -l, --list=NAME|ID the name or id of the list
+ -pr, --property KEY=VALUE
+ sets the property KEY to VALUE (repeatable)
-=cut
+ Note: you can effectively copy the configuration of a list by modifiying
+ the 'id' property - a new list with the new id will be created for you.
-$commands{'create-database'} = sub { die "dummy" };
+ delete-list remove a lists from the system
+ -l, --list=NAME|ID the name or id of the list
-# dummy to put a space in
-$commands{' '} = sub { };
+ set-plugins sets the plugins of a list
+ (any existing plugins not specified will be deleted)
+ -l, --list=NAME|ID the name or id of the list
+ -q, --queue=NAME the name of the queue (eg post, sub, unsub, ...)
+ -p, --plugin=NAME the name of a plugin (repeatable)
-#####
-#
-# List stuff
-#
-#####
+ add-member adds one or more members to a list
+ (will create new members if necessary)
+ -l, --list=NAME|ID the name or id of the list
+ -m, --member=EMAIL the email address of a member (repeatable)
-=head2 show-lists
+ remove-member removes one or more members from a list
+ -l, --list=NAME|ID the name or id of the list
+ -m, --member=EMAIL the email address of a member (repeatable)
-Show all the lists that are in the system
-=cut
+ Member Commands:
+ show-members shows the members in the system, or one or more lists
+ -l, --list=NAME|ID show the members subbed to this list (optional, repeatable)
-$commands{'show-lists'} = sub {
- foreach my $list ( Siesta::List->retrieve_all ) {
- print $list->name . "\n";
- }
- return;
-};
+ create-member adds one or more new members to the system
+ -m, --member=EMAIL the email address of a member (repeatable)
+ describe-member shows all the properties of a member and their values
+ -m, --member=EMAIL|ID the email address or id of a member
+ modify-member change one or more properties of a member
+ -m, --member=EMAIL|ID the email address or id of a member
+ -pr, --property KEY=VALUE
+ sets the property KEY to VALUE (repeatable)
-=head2 create-list I<list_id> I<list_owner> I<post_address> I<return_path>
+ Note: you can effectively copy the configuration of a member by modifiying
+ the 'id' property - a new member with the new id will be created for you.
-I<list_id> is the name of the list, I<list_owner> is the administrator
-of the list, I<post_address> is the email address that member's send mail
-to post to the list and I<return_path> is the address that bounces
-should come back to.
+ delete-member removes one or more members from the system
+ -m, --member=EMAIL|ID the email address or id of a member (repeatable)
-=cut
+ Plugin Commands:
+ show-plugins display a list of plugins (on the system, or set on lists)
+ -l, --list=NAME|ID show the plugins set on this list (optional, repeatable)
-$commands{'create-list'} = sub {
- my $list_id = shift || die "You must supply a list id\n";
- my $list_owner = shift || die "You must supply a list owner\n";
- my $post_addr = shift || die "You must supply a post address\n";
- my $return_path = shift || die "You must supply a bounce address\n";
+ describe-plugin shows all the options for a particular plugin
+ -p, --plugin=NAME the name of the plugin
+ -l, --list=NAME|ID show the current settings for this list (optional)
+ -m, --member=EMAIL|ID show the options for this member for the specified list (optional)
- my $list = Siesta::List->new (
- name => $list_id,
- owner => Siesta::Member->find_or_create({ email => $list_owner }),
- post_address => $post_addr,
- return_path => $return_path,
- )
- or die "Failed to create a new list\n";
+ modify-plugin sets one or more plugin preferences for a list
+ -pl, --plugin=NAME the name of the plugin
+ -l, --list=NAME|ID the name or id of a list
+ -m, --member=EMAIL|ID set the personal preference of this member for this list (optional)
+ -pr, --preference KEY=VALUE
+ sets the property KEY to VALUE (repeatable)
- # set up default plugin queues
- $list->set_plugins( post => qw( Archive Send ) );
- $list->set_plugins( sub => qw( Subscribe ) );
- $list->set_plugins( unsub => qw( UnSubscribe ) );
-
- print "Created the new list '$list_id' <$post_addr>\n";
- print "put this in your /etc/aliases";
- $commands{'show-alias'}->( $list_id);
-};
-
-
-=head2 show-alias I<list_id>
-
-Print out an alias file entry for the list specified.
-
=cut
-$commands{'show-alias'} = sub {
- my $list_id = shift || die "You must pass a list id\n";
- my $list = Siesta::List->load( $list_id )
- or die "Not a valid list id\n";
+BEGIN {
- print $list->alias('nacho (the siesta configuration tool)');
+ # %COMMANDS needs to be populated before something happens. I
+ # think. I'm not terribly keen, it make everything even uglier
+ # than before --richardc
-};
+ $COMMANDS{'create-database'} = {
+ action => sub {
+ require Siesta::DBI;
+ Siesta::DBI->init_db;
+ },
+ };
+ $COMMANDS{'run-mariachi'} = {
+ action => sub {
+ for my $list ( map { $_->name } Siesta::List->retrieve_all ) {
+ my $input;
+ my $output;
+ {
+ no warnings;
+ $input = $Siesta::Config::ARCHIVE . "/$list";
+ $output = $Siesta::Config::ROOT . "/mariachi-html/$list";
+ }
+ mkpath($output);
+ print "invoking mariachi for $list\n";
+ system 'mariachi', '-i', $input, '-o', $output, '-n', $list;
+ }
+ }
+ };
+ $COMMANDS{'create-backup'} = {
+ optional => [qw/ list=s /],
+ action => sub {
+ my %opts = @_;
-=head2 describe-list I<list_id>
+ my @members;
+ my @lists;
-Show all the properties of a list and their values.
+ #have we been passed a list
+ if (defined $opts{list}) {
+ my $list = Siesta::List->load($_)
+ or die "create-backup: No such list '$_'\n";
+ push @lists, $list;
+ @members = $list->members();
-=cut
+ # otherwise do everything
+ }
+ else {
+ @members = Siesta::Member->retrieve_all;
+ @lists = Siesta::List->retreive_all;
+ }
-$commands{'describe-list'} = sub {
- my $list_id = shift || die "You must pass a list id\n";
+ print Siesta->bake('backup',
+ 'members' => \@members,
+ 'lists' => \@lists,
+ 'shellq' => sub { return shell_quote $_[0] },
+ );
+ }
+ };
- my $list = Siesta::List->load( $list_id )
- or die "Not a valid list id\n";
+ #####
+ #
+ # List stuff
+ #
+ #####
- foreach my $key ($list->columns) {
- my $value = $list->$key() || '';
- print "$key = $value\n";
- }
- for my $queue ($list->queues) {
- print "$queue plugins: ", join( ' ', map { ($_->personal)? "+".$_->name:$_->name } $list->plugins( $queue )), "\n";
- }
-};
+ $COMMANDS{'show-lists'} = {
+ action => sub {
+ foreach my $list ( Siesta::List->retrieve_all ) {
+ print $list->name . "\n";
+ }
+ }
+ };
-=head2 modify-list I<list_id> I<key> I<value>
+ $COMMANDS{'create-list'} = {
+ required => [qw/ list=s owner=s post=s bounce=s /],
+ action => sub {
+ my %opts = @_;
-Change a property of the list specified. See B<Siesta::List> for
-valid properties.
+ my $list = Siesta::List->new(
+ name => $opts{list},
+ owner => Siesta::Member->find_or_create({ email => $opts{owner} }),
+ post_address => $opts{post},
+ return_path => $opts{bounce},
+ )
+ or die "create-list: Failed to create a new list\n";
-Note: you can effectively copy the configuration of a list by modifying
-the id - a new list with the new id will be created for you.
+ # set up default plugin queues
+ $list->set_plugins( post => qw( Archive Send ) );
+ $list->set_plugins( sub => qw( Subscribe ) );
+ $list->set_plugins( unsub => qw( UnSubscribe ) );
-=cut
+ print "Created the new list '$opts{list}' <$opts{post}>\n";
+ print "nacho show-alias will show you what to include in /etc/aliases\n";
+ }
+ };
-$commands{'modify-list'} = sub {
- my $list_id = shift || die "You must pass a list id\n";
+ $COMMANDS{'show-alias'} = {
+ required => [qw/ list=s /],
+ action => sub {
+ my %opts = @_;
- my $list = Siesta::List->load( $list_id )
- or die "Not a valid list id\n";
+ my $list = Siesta::List->load( $opts{list} )
+ or die "show-alias: Not a valid list name or id\n";
- my ( $key, $value ) = @_;
+ print $list->alias('nacho (the siesta configuration tool)');
+ }
+ };
- die "You must pass a key\n" unless defined $key;
- die "You must pass a value\n" unless defined $value;
+ $COMMANDS{'describe-list'} = {
+ required => [qw/ list=s /],
+ action => sub {
+ my %opts = @_;
- my %fields = map { $_ => 1 } $list->columns;
- die "'$key' is not a valid property - valid properties are\n",
- (join "\n",$list->columns),"\n" unless $fields{$key};
+ my $list = Siesta::List->load( $opts{list} )
+ or die "describe-list: Not a valid list name or id\n";
- $list->$key($value);
- print "Property '$key' set to '$value' for the list $list_id\n";
-};
+ foreach my $key ($list->columns) {
+ my $value = $list->$key() || '';
+ print "$key = $value\n";
+ }
+ for my $queue ($list->queues) {
+ print "$queue plugins: ", join( ' ', map { ($_->personal)? "+".$_->name:$_->name } $list->plugins( $queue )), "\n";
+ }
+ }
+ };
-=head2 delete-list I<list_id>
+ $COMMANDS{'modify-list'} = {
+ required => [qw/ list=s property=s% /],
+ action => sub {
+ my %opts = @_;
-Remove the list indicated from the system.
+ my $list = Siesta::List->load( $opts{list} )
+ or die "modify-list: Not a valid list name or id\n";
-=cut
+ while (my ($key, $value) = each %{$opts{property}}) {
+ my %fields = map { $_ => 1 } $list->columns;
+ die "modify-list: '$key' is not a valid property - valid properties are\n",
+ (join "\n",$list->columns),"\n" unless $fields{$key};
-$commands{'delete-list'} = sub {
- my $list_id = shift || die "You must pass a list id\n";
+ $list->$key($value);
+ print "Property '$key' set to '$value' for the list $opts{list}\n";
+ }
+ }
+ };
- my $list = Siesta::List->load( $list_id )
- or die "Not a valid list id\n";
+ $COMMANDS{'delete-list'} = {
+ required => [qw/ list=s /],
+ action => sub {
+ my %opts = @_;
- # gosh, Class::DBI makes this easy
- $list->delete;
+ my $list = Siesta::List->load( $opts{list} )
+ or die "delete-list: Not a valid list name or id\n";
- print "List '$list_id' deleted\n";
-};
+ # gosh, Class::DBI makes this easy
+ $list->delete;
-=head2 set-plugins I<list_id> I<queue> [ I<plugin> [ I<plugin>... ] ]
+ print "List '$opts{list}' deleted\n";
+ }
+ };
-Set the list plugins to be the ones specified.
+ $COMMANDS{'set-plugins'} = {
+ required => [qw/ list=s queue=s /],
+ optional => [qw/ plugin=s@ /],
+ action => sub {
+ my %opts = @_;
-=cut
+ my $list = Siesta::List->load( $opts{list} )
+ or die "set-plugins: Not a valid list name or id\n";
-$commands{'set-plugins'} = sub {
- my $list_id = shift || die "You must pass a list id\n";
- my $queue = shift || die "need a queue\n";
- my @plugins = @_;
+ $list->set_plugins( $opts{queue} => @{$opts{plugin}} )
+ or die "set-plugins: Sorry, couldn't do that for some reason\n";
- my $list = Siesta::List->load( $list_id )
- or die "Not a valid list id\n";
+ unless (@{$opts{plugin}}) {
+ print "Deleted plugins from $opts{list}\n";
+ return;
+ }
+ }
+ };
- $list->set_plugins( $queue => @plugins )
- or die "Sorry, couldn't do that for some reason\n";
+ $COMMANDS{'add-member'} = {
+ required => [qw/ list=s member=s@ /],
+ action => sub {
+ my %opts = @_;
- unless (@plugins) {
- print "Deleted plugins from $list_id\n";
- return;
- }
-};
+ my $list = Siesta::List->load( $opts{list} )
+ or die "add-member: Not a valid list name or id\n";
+ for my $member_id (@{$opts{member}}) {
+ my $member = Siesta::Member->find_or_create({ email => $member_id })
+ or die "add-member: Couldn't get/create a member '$member_id'\n";
+ $list->add_member($member);
+ print "Member <".$member->email."> (".$member->id.") added to list '$opts{list}'\n";
+ };
+ }
+ };
-=head2 add-member I<list_id> I<member> [I<member> ...]
+ $COMMANDS{'remove-member'} = {
+ required => [qw/ list=s member=s@ /],
+ action => sub {
+ my %opts = @_;
-Add the member(s) specified to the list specified. This will create new
-members if necessary.
+ my $list = Siesta::List->load( $opts{list} )
+ or die "remove-member: Not a valid list name or id\n";
-=cut
+ for my $member_id (@{$opts{member}}) {
+ my $member = Siesta::Member->load($member_id)
+ or die "remove-member: $member_id is not a valid member id\n";
-$commands{'add-member'} = sub {
- my $list_id = shift || die "You must pass a list id\n";
- my $member_id = shift || die "You must pass a member id\n";
+ $list->remove_member($member);
+ print "Member '$member_id' removed from list '$opts{list}'\n";
+ };
+ }
+ };
- my $list = Siesta::List->load( $list_id )
- or die "Not a valid list id\n";
+ #####
+ #
+ # Member stuff
+ #
+ #####
- while ($member_id) {
- my $member = Siesta::Member->find_or_create({ email => $member_id })
- or die "Couldn't get/create a member '$member_id'\n";
- $list->add_member($member);
- print "Member <".$member->email."> (".$member->id.") added to list '$list_id'\n";
- $member_id = shift;
- }
-};
+ $COMMANDS{'show-members'} = {
+ optional => [qw/ list=s@ /],
+ action => sub {
+ my %opts = @_;
+ if (!defined $opts{list}) {
+ print "All members for system:\n";
+ foreach my $member ( Siesta::Member->retrieve_all ) {
+ print $member->email, "\n";
+ }
+ return;
+ }
+ else {
+ for (@{$opts{list}}) {
+ my $list = Siesta::List->load($_)
+ or die "show-members: No list '$_'!\n";
+ print "Members of $_:\n";
-=head2 remove-member I<list_id> I<member> [I<member>...]
+ foreach my $member ($list->members) {
+ print $member->email, "\n";
+ }
+ }
+ }
+ }
+ };
-removes the specified I<member>(s) from the list.
+ $COMMANDS{'create-member'} = {
+ required => [qw/ member=s@ /],
+ action => sub {
+ my %opts = @_;
-=cut
+ for my $member_id (@{$opts{member}}) {
+ my $member = Siesta::Member->find_or_create({ email => $member_id })
+ or die "add-member: Couldn't create a member '$member_id'\n";
-$commands{'remove-member'} = sub {
- my $list_id = shift || die "You must pass a list id\n";
- my $member_id = shift || die "You must pass a member id\n";
+ print "Member $member_id added\n";
+ }
+ }
+ };
- my $list = Siesta::List->load( $list_id )
- or die "Not a valid list id\n";
+ $COMMANDS{'describe-member'} = {
+ required => [qw/ member=s /],
+ action => sub {
+ my %opts = @_;
- while ($member_id) {
- my $member = Siesta::Member->load($member_id)
- or die "$member_id is not a valid member id\n";
+ my $member = Siesta::Member->load($opts{member})
+ or die "describe-member: $opts{member} is not a valid member id\n";
- $list->remove_member($member);
- print "Member '$member_id' removed from list '$list_id'\n";
- $member_id = shift;
- }
-};
+ foreach my $key ($member->columns) {
+ my $value = $member->$key() || '';
+ print "$key = $value\n";
+ }
+ print "Subscribed to : ", (join ", ", map { $_->name } $member->lists), "\n";
+ }
+ };
-# dummy to put a space in
-$commands{' '} = sub { };
+ $COMMANDS{'modify-member'} = {
+ required => [qw/ member=s property=s% /],
+ action => sub {
+ my %opts = @_;
-#####
-#
-# Member stuff
-#
-#####
+ my $member = Siesta::Member->load( $opts{member} )
+ or die "modify-member: Not a valid member id\n";
+ while (my ($key, $value) = each %{$opts{property}}) {
+ my %fields = map { $_ => 1 } $member->columns;
+ die "modify-member: '$key' is not a valid property - valid properties are\n",
+ (join "\n",$member->columns),"\n" unless $fields{$key};
-=head2 show-members [ I<list_id> ]
-
-Show all the members that are in the system or, if a list-id is
-passed, then just the ones subbed to that list
-
-=cut
-
-$commands{'show-members'} = sub {
- if (!@_) {
- print "All members for system:\n";
- foreach my $member ( Siesta::Member->retrieve_all ) {
- print $member->email, "\n";
+ $member->$key($value);
+ print "Property '$key' set to '$value' for the member $opts{member}\n";
+ }
}
- return;
- }
- for (@_) {
- my $list = Siesta::List->load($_)
- or die "No list '$_'!\n";
- print "Members of $_:\n";
+ };
- foreach my $member ($list->members) {
- print $member->email, "\n";
- }
- }
-};
+ $COMMANDS{'delete-member'} = {
+ required => [qw/ member=s@ /],
+ action => sub {
+ my %opts = @_;
+ foreach my $member_id (@{$opts{member}}) {
+ my $member = Siesta::Member->load($member_id)
+ or die "delete-member: $member_id is not a valid member id\n";
-=head2 create-member I<member_id>
+ foreach my $list ( Siesta::List->retrieve_all ) {
+ $list->remove_member($member);
+ }
-Add a new member to the system.
+ $member->delete;
-=cut
+ print "Member '$member_id' deleted\n";
+ }
+ }
+ };
-$commands{'create-member'} = sub {
- my $email = shift
- || die "You need to pass an email address as a member id\n";
- my $member = Siesta::Member->find_or_create({ email => $email })
- or die "Errk : couldn't create a member";
+ #####
+ #
+ # Plugin stuff
+ #
+ #####
- print "Member $email added\n";
-};
+ $COMMANDS{'show-plugins'} = {
+ optional => [qw/ list=s@ /],
+ action => sub {
+ my %opts = @_;
-=head2 describe-member I<member_id>
+ if (!defined $opts{list}) {
+ print "This system currently has these plugins installed: \n\n";
+ foreach my $name ( Siesta->available_plugins ) {
+ my $p = "Siesta::Plugin::$name";
+ $p->require;
+ printf "%s\n -\n %s\n\n", $name, $p->description;
+ }
+ }
+ else {
+ for (@{$opts{list}}) {
+ my $list = Siesta::List->load($_)
+ or die "show-plugins: No list '$_'!\n";
+ print "Plugins for $_:\n";
+ foreach my $plugin ($list->plugins('post')) {
+ print $plugin->name, "\n";
+ }
+ }
+ }
+ }
+ };
-Show all the properties of a member and their values.
+ $COMMANDS{'describe-plugin'} = {
+ required => [qw/ plugin=s /],
+ optional => [qw/ list=s member=s /],
+ dependencies => { member => 'list' },
+ action => sub {
+ my %opts = @_;
-=cut
+ if (defined $opts{list}) {
+ _plugin_list_options(%opts);
+ }
+ else {
+ _plugin_options($opts{plugin});
+ }
+ }
+ };
-$commands{'describe-member'} = sub {
- my $member_id = shift || die "You must pass a member id (i.e an email address)\n";
+ $COMMANDS{'modify-plugin'} = {
+ required => [qw/ plugin=s list=s /],
+ optional => [qw/ member=s preference=s% /],
+ action => sub {
+ my %opts = @_;
- my $member = Siesta::Member->load($member_id) || die "Not a valid member id\n";
+ my $list = Siesta::List->load($opts{list})
+ or die "modify-plugin: Not a valid list $opts{list}\n";
- foreach my $key ($member->columns) {
- my $value = $member->$key() || '';
- print "$key = $value\n";
- }
+ my %plugins = map { $_->name => $_ } $list->plugins;
+ my $plugin = $plugins{$opts{plugin}}
+ or die "modify-plugin: Not a valid plugin $opts{plugin}\n";
- print "Subscribed to : ", (join ", ", map { $_->name } $member->lists), "\n";
-};
+ my $member;
+ if (defined $opts{member}) {
+ $member = Siesta::Member->load($opts{member})
+ or die "modify-plugin: No such member $opts{member}\n";
+ die "modify-plugin: $opts{member} is not subscribed to $opts{list}\n"
+ unless $list->is_member($member);
-=head2 modify-member I<member_id> I<key> I<value>
+ $plugin->member($member);
+ }
-Change a property of the member specified. See B<Siesta::Member> for
-valid properties.
+ while (my ($key, $value) = each %{$opts{preference}}) {
+ $plugin->pref($key, $value);
+ }
-Note: you can effectively copy the configuration of a member by modifying
-the id - a new member with the new id will be created for you.
+ my $options = $plugin->options;
-=cut
+ if (defined $member) {
+ printf "Personal preferences for member %s on list %s\n",
+ $opts{member}, $opts{list};
+ }
+ else {
+ printf "Preferences for list %s\n", $opts{list};
+ }
-$commands{'modify-member'} = sub {
- my $member_id = shift || die "You must pass a member id\n";
-
- my $member = Siesta::Member->load( $member_id )
- or die "Not a valid member id\n";
-
- my ( $key, $value ) = @_;
-
- die "You must pass a key\n" unless defined $key;
- die "You must pass a value\n" unless defined $value;
-
- my %fields = map { $_ => 1 } $member->columns;
- die "'$key' is not a valid property - valid properties are\n",
- (join "\n",$member->columns),"\n" unless $fields{$key};
-
- $member->$key($value);
- $member->update;
- print "Property '$key' set to '$value' for the list $member_id\n";
-};
-
-=head2 delete-member I<member_id>
-
-Remove a member from the system.
-
-=cut
-
-$commands{'delete-member'} = sub {
- my $member_id = shift || die "You must pass a member id (i.e an email address)\n";
-
- my $member = Siesta::Member->load($member_id) || die "Not a valid member id\n";
-
- foreach my $list ( Siesta::List->retrieve_all ) {
- $list->remove_member($member);
- }
-
- $member->delete;
-
- print "Member '$member_id' deleted\n";
-};
-
-
-# dummy to put a space in
-$commands{' '} = sub { };
-
-
-#####
-#
-# Plugin stuff
-#
-#####
-
-=head2 show-plugins
-
-List all plugins available to the system or just the plugins
-for a list.
-
-=cut
-
-$commands{'show-plugins'} = sub {
- if (!@_) {
- print "This system currently has these plugins installed : \n\n";
- foreach my $name ( Siesta->available_plugins ) {
- my $p = "Siesta::Plugin::$name";
- $p->require;
- printf "%s\n -\n %s\n\n",$name, $p->description;
+ foreach my $option ( keys %{$options} ) {
+ print " - ", $option, " : ", $plugin->pref($option), "\n";
+ }
}
- }
+ };
- for (@_) {
- my $list = Siesta::List->load($_)
- or die "No list '$_'!\n";
- print "Plugins for $_:\n";
- foreach my $plugin ($list->plugins('post')) {
- print $plugin->name,"\n";
- }
- }
-};
+ argvFile;
+}
-
-=head2 describe-plugin I<plugin> [ I<list_id> ] [ I<member_id> ]
-
-List all the options for a particular plugin. If a I<list_id> is
-passed then it will show the current settings for that list. If,
-additionally, a I<member_id> is passed then the member's options
-for that list will be shown.
-
-=cut
-
-$commands{'describe-plugin'} = sub {
- my $plugin_id = shift || die "You must pass a plugin name\n";
- my $list_id = shift;
-
- if ($list_id) {
- _plugin_list_options($plugin_id,$list_id,@_);
- }
- else {
- _plugin_options($plugin_id);
- }
-
-};
-
-
sub _plugin_options {
my $plugin_id = shift;
my %plugins = map { $_ => 1 } Siesta->available_plugins;
- die "Not a valid plugin\n" unless $plugins{$plugin_id};
+ die "describe-plugin: Not a valid plugin\n" unless $plugins{$plugin_id};
my $class = "Siesta::Plugin::$plugin_id";
$class->require;
@@ -513,25 +572,22 @@
}
sub _plugin_list_options {
- my ($plugin_id, $list_id, $member_id) = @_;
+ my %opts = @_;
- die "No plugin name passed\n" unless defined $plugin_id;
- die "No list name passed\n" unless defined $list_id;
+ my $list = Siesta::List->load($opts{list})
+ or die "describe-plugin: Not a valid list $opts{list}\n";
- my $list = Siesta::List->load($list_id)
- or die "Not a valid list $list_id\n";
-
my %plugins = map { $_->name => $_ } $list->plugins;
- my $plugin = $plugins{$plugin_id}
- or die "That plugin is not used in the list '$list_id'\n";
+ my $plugin = $plugins{$opts{plugin}}
+ or die "describe-plugin: That plugin is not used in the list '$opts{list}'\n";
my $member;
- if (defined $member_id) {
- $member = Siesta::Member->load($member_id)
- or die "Not a valid member id\n";
+ if (defined $opts{member}) {
+ $member = Siesta::Member->load($opts{member})
+ or die "describe-plugin: Not a valid member id\n";
- die "$member_id is not subscribed to $list_id\n"
+ die "describe-plugin: $opts{member} is not subscribed to $opts{list}\n"
unless $list->is_member($member);
$plugin->member($member);
@@ -540,10 +596,10 @@
my $options = $plugin->options;
if (defined $member) {
- printf "Personal preferences for member %s on list %s\n", $member_id, $list_id;
+ printf "Personal preferences for member %s on list %s\n", $opts{member}, $opts{list};
}
else {
- printf "Preferences for list %s\n", $list_id;
+ printf "Preferences for list %s\n", $opts{list};
}
foreach my $option ( keys %{$options} ) {
@@ -552,206 +608,134 @@
print $plugin->name," is set personal\n" if $plugin->personal();
}
+#####
+#
+# Dispatch stuff
+#
+#####
-=head2 modify-plugin I<list_id> I<plugin> I<key> I<val> [ I<member_id> ]
-Sets the preference for a list. If optionally passed a member email,
-it will set their personal preference.
+use Getopt::Auto (
+ map { my $name = $_; [ $name, '', sub { run($name) } ] }
+ keys %COMMANDS
+ );
-=cut
+BEGIN {
+ no warnings;
+ *Getopt::Auto::helpme = \&helpme;
+ *Getopt::Auto::unrecognized = \&unrecognized;
+}
+use Siesta::Config;
+BEGIN{
+ my $database;
+ my $config;
-$commands{'modify-plugin'} = sub {
- my ($list_id, $plugin_id, $key, $val, $member_id) = @_;
+ Getopt::Long::Configure ("pass_through");
+ GetOptions('database=s' => \$database,
+ 'config-file|f=s' => \$config);
- die "No list name passed\n" unless defined $list_id;
- die "No plugin name passed\n" unless defined $plugin_id;
- die "You must pass a preference to change\n" unless defined $key;
- die "You must pass a value to the '$key' preference to\n" unless defined $val;
+ @Siesta::Config::STORAGE = split / /, $database if defined $database;
+ $Siesta::Config::CONFIG_FILE = $config if defined $config;
+}
- my $list = Siesta::List->load($list_id) || die "Not a valid list $list_id\n";
+sub run {
+ my $command = shift;
- my %plugins = map { $_->name => $_ } $list->plugins;
- my $plugin = $plugins{$plugin_id} || die "Not a valid plugin $plugin_id\n";
-
-
- my $member;
- if (defined $member_id) {
- $member = Siesta::Member->load($member_id)
- || die "No such member $member_id\n";
-
- die "$member_id is not subscribed to $list_id\n"
- unless $list->is_member($member);
-
- $plugin->member($member);
+ if ($command ne "create-database") {
+ eval {
+ require Siesta;
+ require Siesta::List;
+ };
+ if ($@) {
+ print "Error initializing Siesta:\n$@\n";
+ print "\n\nTry 'nacho create-database' if you are installing siesta for the first time\n";
+ exit;
+ }
}
- $plugin->pref($key, $val);
+ my %h = ();
+ my @options = grep { defined } (
+ @{$COMMANDS{$command}{required}},
+ @{$COMMANDS{$command}{optional}}
+ );
- my $options = $plugin->options;
+ Getopt::Long::Configure ("no_pass_through", "require_order");
+ GetOptions(\%h, @options) or exit(2);
- if (defined $member) {
- printf "Personal preferences for member %s on list %s\n", $member_id, $list_id;
+ my @missing;
+ for my $required (@{$COMMANDS{$command}{required}}) {
+ my $required2 = $required;
+ $required2 =~ s/[^a-zA-Z].*//;
+ push @missing, $required2 if !defined $h{$required2};
}
- else {
- printf "Preferences for list %s\n", $list_id;
+ while (my ($key, $value) = each %{$COMMANDS{$command}{dependencies}} ) {
+ push @missing, $value if defined $h{$key} and !defined $h{$value};
}
-
- foreach my $option ( keys %{$options} ) {
- print " - ", $option, " : ", $plugin->pref($option), "\n";
+ if (scalar @missing) {
+ local $" = ", ";
+ print "The following options to the command $command are missing:\n";
+ print " " . "@missing\n";
+ exit(2);
}
-};
-
-#####
-#
-# Deferred message stuff
-#
-#####
-
-# dummy to put a space in
-$commands{' '} = sub { };
-
-
-
-=head2 show-deferred [ deferred_id ]
-
-Show all the deferred messages or, if an id is
-passed in, show that deferred message.
-
-=cut
-
-
-$commands{'show-deferred'} = sub {
- my $mess_id = shift;
-
-
- # show an individual deferred message
- if (defined $mess_id) {
- my $deferred = Siesta::Deferred->retrieve($mess_id)
- or die "No such deferred message\n";
- print $deferred->message->as_string;
- return;
+ eval { $COMMANDS{$command}{action}->(%h); };
+ if ($@) {
+ print $@;
+ return 0;
}
+ if (scalar @ARGV != 0) {
+ print "#################\n";
+ print "## end of command\n";
+ print "#################\n";
- # otherwise
- foreach my $deferred ( Siesta::Deferred->retrieve_all ) {
- print $deferred->id(),") ",$deferred->message->subject(), " (by ", $deferred->who->email(), " because '",$deferred->why,"')\n";
+ return 1;
}
-};
+ else {
+ return 0;
+ }
+}
+sub unrecognized {
+ my $command = shift;
-=head2 resume-deferred deferred_id
+ print STDERR "Unrecognised command $command\n";
+ helpme(0);
+}
-Resume a deferred message.
-
-=cut
-
-$commands{'resume-deferred'} = sub {
- my $mess_id = shift;
-
- my $message = Siesta::Deferred->retrieve($mess_id)
- or die "No such deferred message\n";
-
- Siesta::Message->resume( $mess_id );
-
- print "Sucessfully resumed message $mess_id\n";
-};
-
#####
#
-# Misc stuff
+# Help stuff
#
#####
-# dummy to put a space in
-$commands{' '} = sub { };
-=head2 run-mariachi
+sub helpme {
+ my $verbosity = shift;
-invoke mariachi to make webified archives (depends on the Archive plugin)
+ $verbosity = 1 if !defined $verbosity;
-=cut
+ pod2usage(-verbose => $verbosity);
+}
-$commands{'run-mariachi'} = sub {
- for my $archive (Siesta::Plugin->search( name => 'Archive' )) {
- $archive = $archive->promote;
- my $input = $archive->pref('path');
- my $name = $archive->list->name;
- my $output = $Siesta::Config::ROOT . "/mariachi-html/$name";
- print "invoking mariachi for $name\n";
- system 'mariachi', '-i', $input, '-o', $output, '-n', $name;
- }
-};
-
-
-=head2 create-backup [list name]
-
-Prints out shell script that will restore you system when run
-
-Optionally can take a list anme and will only dump a backup script
-for that list.
-
-=cut
-
-$commands{'create-backup'} = sub {
- my @members;
- my @lists;
-
- if ($_[0]) {
- # we have been passed a list
- my $list = Siesta::List->load($_[0]) || die "No such list '$_[0]'\n";
- push @lists, $list;
- @members = $list->members();
- }
- else {
- # otherwise do everything
- @members = Siesta::Member->retrieve_all;
- @lists = Siesta::List->retrieve_all;
- }
-
- print Siesta->bake('backup',
- 'members' => \@members,
- 'lists' => \@lists,
- 'shellq' => sub { return shell_quote $_[0] },
- );
-};
-
-
-sub usage {
- my $name = basename $0;
-
- return join '', "Usage: $name <-d database> COMMAND\nRecognised commands:",
- (map { "\n\t $_" } keys %commands ),
- "\n\nSee the $name manpage for more details";
+sub default {
+ helpme(0);
}
-# not enough arguments
-die usage() . "\n" unless @ARGV;
-
-# what are we doing?
-my $mode = shift @ARGV;
-
-my $cmd = $commands{$mode}
- or die usage;
-
-$cmd->(@ARGV);
-
-exit 0;
-__END__
-
=head1 SEE ALSO
L<Siesta>, L<Siesta::UserGuide>
=head1 AUTHOR
-Written by Simon Wistow <simon@xxxxxxxxxx.xxx>
+Written by Simon Wiston <simon@xxxxxxxxxx.xxx>
+New dispatch code written by Jody Belka <belkajm-cpan@xxxxxxxxxxx.xxx>
+
=head1 COPYRIGHT
-Copyright (C) 2002 the Siesta dev team.
+(C)opyright 2002 the Siesta dev team.
Distributed under the same terms as Perl itself.
Generated at 13:57 on 01 Jul 2004 by mariachi 0.52