"makefml newml" virtual domain support. For exmaple,

makefml newml elena@nuinui.net
The ml_home_dir is speculated from $virtual_maps in main.cf.

1 files changed, 70 insertions, 8 deletions

diff --git a/fml/lib/FML/Command/Admin/newml.pm b/fml/lib/FML/Command/Admin/newml.pm
index 22c5ce38..77534266 100644
--- a/fml/lib/FML/Command/Admin/newml.pm
+++ b/fml/lib/FML/Command/Admin/newml.pm
@@ -1,10 +1,10 @@
 #-*- perl -*-
 #
-#  Copyright (C) 2001 Ken'ichi Fukamachi
+#  Copyright (C) 2001,2002 Ken'ichi Fukamachi
 #   All rights reserved. This program is free software; you can
 #   redistribute it and/or modify it under the same terms as Perl itself.
 #
-# $FML: newml.pm,v 1.8 2001/12/23 03:50:27 fukachan Exp $
+# $FML: newml.pm,v 1.9 2001/12/23 11:39:45 fukachan Exp $
 #
 
 package FML::Command::Admin::newml;
@@ -54,18 +54,19 @@ sub process
     my $main_cf        = $curproc->{ 'main_cf' };
     my $member_map     = $config->{ 'primary_member_map' };
     my $recipient_map  = $config->{ 'primary_recipient_map' };
-    my $ml_name        = $command_args->{ 'ml_name' };
-    my $ml_home_prefix = $main_cf->{ 'ml_home_prefix' };
-    my $ml_home_dir    = "$ml_home_prefix/$ml_name";
+    my ($ml_name, $ml_domain, $ml_home_prefix, $ml_home_dir) = 
+	$self->_get_virtual_domain_info($curproc, $command_args);
     my $params         = {
-	ml_name           => $ml_name,
-	ml_domain         => $main_cf->{ 'default_domain' },
 	executable_prefix => $main_cf->{ executable_prefix },
+	ml_name           => $ml_name,
+	ml_domain         => $ml_domain, 
 	ml_home_prefix    => $ml_home_prefix,
+	ml_home_dir       => $ml_home_dir,
     };
 
     # fundamental check
     croak("\$ml_name is not specified") unless $ml_name;
+    croak("\$ml_home_dir is not specified") unless $ml_home_dir;
 
     unless (-d $ml_home_dir) {
 	eval q{
@@ -92,6 +93,67 @@ sub process
 }
 
 
+# Descriptions: check argument and prepare virtual domain information 
+#               if needed.
+#    Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args)
+# Side Effects: none
+# Return Value: ARRAY
+sub _get_virtual_domain_info
+{
+    my ($self, $curproc, $command_args) = @_;
+    my $main_cf        = $curproc->{ 'main_cf' };
+    my $ml_name        = $command_args->{ 'ml_name' };
+    my $ml_domain      = $main_cf->{ 'default_domain' };
+    my $ml_home_prefix = $main_cf->{ 'ml_home_prefix' };
+    my $ml_home_dir    = '';
+
+    # virtual domain support: e.g. "makefml newml elena@nuinui.net"
+    if ($ml_name =~ /\@/) {
+	my $virtual_domain = '';
+
+	# overwrite $ml_name
+	($ml_name, $virtual_domain) = split(/\@/, $ml_name);
+
+	# check virtual domain list.
+	my ($virtual_maps) = $curproc->get_virtual_maps();
+	if (@$virtual_maps) {
+	    my $dir = '';
+	    eval q{ use IO::Adapter; };
+	    unless ($@) {
+	      MAP:
+		for my $map (@$virtual_maps) {
+		    my $obj  = new IO::Adapter $map;
+		    $obj->open();
+		    $dir = $obj->find("^$virtual_domain");
+		    last MAP if $dir;
+		}
+		($virtual_domain, $dir) = split(/\s+/, $dir);
+		$dir =~ s/[\s\n]*$// if defined $dir;
+
+		# found
+		if ($dir) {
+		    $ml_home_prefix = $dir;
+
+		    use File::Spec;
+		    $ml_domain   = $virtual_domain;
+		    $ml_home_dir = File::Spec->catfile($dir, $ml_name);
+		}
+	    }
+	    else {
+		croak("cannot load IO::Adapter");
+	    }
+	}
+    }
+    # default domain: e.g. "makefml newml elena"
+    else {
+	use File::Spec;
+	$ml_home_dir = File::Spec->catfile($ml_home_prefix, $ml_name);
+    }
+
+    return ($ml_name, $ml_domain, $ml_home_prefix, $ml_home_dir);
+}
+
+
 # Descriptions: install $dst with variable expansion of $src
 #    Arguments: STR($src) STR($dst) HASH_REF($config)
 # Side Effects: create $dst
@@ -132,7 +194,7 @@ Ken'ichi Fukamachi
 
 =head1 COPYRIGHT
 
-Copyright (C) 2001 Ken'ichi Fukamachi
+Copyright (C) 2001,2002 Ken'ichi Fukamachi
 
 All rights reserved. This program is free software; you can
 redistribute it and/or modify it under the same terms as Perl itself.