diff options
| author | fukachan <fukachan> | 2003-03-15 09:07:02 +0000 |
|---|---|---|
| committer | fukachan <fukachan> | 2003-03-15 09:07:02 +0000 |
| commit | 8f0de2c3a3af433f566d8d03e33899234301ae90 (patch) | |
| tree | 7854c16bd72732193be4b4334863973f28e1b6da /fml | |
| parent | e3ac0563c97586c0976b0c6a0b6fcfadf1797545 (diff) | |
| download | fml8-8f0de2c3a3af433f566d8d03e33899234301ae90.tar.gz fml8-8f0de2c3a3af433f566d8d03e33899234301ae90.tar.bz2 fml8-8f0de2c3a3af433f566d8d03e33899234301ae90.zip | |
remove fmlspool
Diffstat (limited to 'fml')
| -rwxr-xr-x | fml/bin/fmlspool.in | 17 | ||||
| -rw-r--r-- | fml/etc/install.cf.in | 3 | ||||
| -rw-r--r-- | fml/lib/FML/Command/Admin/spool.pm | 112 | ||||
| -rw-r--r-- | fml/lib/FML/Spool.pm | 232 |
4 files changed, 345 insertions, 19 deletions
diff --git a/fml/bin/fmlspool.in b/fml/bin/fmlspool.in deleted file mode 100755 index 15e70a81..00000000 --- a/fml/bin/fmlspool.in +++ /dev/null @@ -1,17 +0,0 @@ -#! @SHELL@ -# -# Copyright (C) 2001 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: fmlspool.in,v 1.3 2002/04/01 23:40:53 fukachan Exp $ -# - -prefix=@prefix@ -exec_prefix=@exec_prefix@ -libexec_dir=@libexecdir@/fml - -exec $libexec_dir/fmlspool $* - -echo 'not reach here' -exit 0; diff --git a/fml/etc/install.cf.in b/fml/etc/install.cf.in index 88d78fdc..cd36b8e9 100644 --- a/fml/etc/install.cf.in +++ b/fml/etc/install.cf.in @@ -3,7 +3,7 @@ # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. # -# $FML: install.cf.in,v 1.8 2003/03/14 06:55:59 fukachan Exp $ +# $FML: install.cf.in,v 1.9 2003/03/14 12:49:48 fukachan Exp $ # @@ -93,7 +93,6 @@ bin_programs = fml makefml fmlsch fmlhtmlify - fmlspool libexec_programs = fml.pl diff --git a/fml/lib/FML/Command/Admin/spool.pm b/fml/lib/FML/Command/Admin/spool.pm new file mode 100644 index 00000000..ab5d42f4 --- /dev/null +++ b/fml/lib/FML/Command/Admin/spool.pm @@ -0,0 +1,112 @@ +#-*- perl -*- +# +# Copyright (C) 2003 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: spool.pm,v 1.2 2003/03/14 06:53:22 fukachan Exp $ +# + +package FML::Command::Admin::spool; +use strict; +use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD); +use Carp; + + +=head1 NAME + +FML::Command::Admin::spool - small maintenance jobs on the spool directory + +=head1 SYNOPSIS + +See C<FML::Command> for more details. + +=head1 DESCRIPTION + +show spool status or convert the structure. + +=head1 METHODS + +=head2 C<process($curproc, $command_args)> + +=cut + + +# Descriptions: constructor. +# Arguments: OBJ($self) +# Side Effects: none +# Return Value: OBJ +sub new +{ + my ($self) = @_; + my ($type) = ref($self) || $self; + my $me = {}; + return bless $me, $type; +} + + +# Descriptions: need lock or not +# Arguments: none +# Side Effects: none +# Return Value: NUM( 1 or 0) +sub need_lock { 1;} + + +# Descriptions: subcommand dispatch table for "spool" command. +# Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args) +# Side Effects: update $recipient_map +# Return Value: none +sub process +{ + my ($self, $curproc, $command_args) = @_; + my $config = $curproc->config(); + my $fp = $command_args->{ comsubname } || 'status'; + + # XXX-TODO: makefml $ml spool ... what arguments is appropriate ? + # use $dst_dir as $src_dir if --srcdir=DIR not specified. + # you can specify the spool type by --style=subdir ? + # but only "subdir" is supported now :) ? + + # prepare arguments on $*_dir directory info. + my $dst_dir = $config->{ spool_dir }; + my $src_dir = $dst_dir; + $command_args->{ _src_dir } = $src_dir; + $command_args->{ _dst_dir } = $dst_dir; + + # output channel (we suppose only makefml here). + $command_args->{ _output_channel } = \*STDOUT; + + use FML::Spool; + my $spool = new FML::Spool $curproc; + if ($spool->can($fp)) { + $spool->$fp($curproc, $command_args); + } + else { + croak("no such method: $fp"); + } +} + + +=head1 CODING STYLE + +See C<http://www.fml.org/software/FNF/> on fml coding style guide. + +=head1 AUTHOR + +Ken'ichi Fukamachi + +=head1 COPYRIGHT + +Copyright (C) 2003 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. + +=head1 HISTORY + +FML::Command::Admin::spool first appeared in fml8 mailing list driver package. +See C<http://www.fml.org/> for more details. + +=cut + +1; diff --git a/fml/lib/FML/Spool.pm b/fml/lib/FML/Spool.pm new file mode 100644 index 00000000..c851c637 --- /dev/null +++ b/fml/lib/FML/Spool.pm @@ -0,0 +1,232 @@ +#-*- perl -*- +# +# Copyright (C) 2003 Ken'ichi Fukamachi +# All rights reserved. +# +# $FML: Spool.pm,v 1.16 2003/02/01 08:51:41 fukachan Exp $ +# + +package FML::Spool; + +use strict; +use Carp; +use vars qw($debug @ISA @EXPORT @EXPORT_OK); +use FML::Log qw(Log LogWarn LogError); +use FML::Config; + +use FML::Process::Kernel; +@ISA = qw(FML::Process::Kernel); + +my $debug = 0; + + +=head1 NAME + +FML::Spool -- utilities for small maintenance jobs on the spool directory + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +This class provides utilitiy functions for the spool directory. + +=head1 METHODS + +=head2 C<new($curproc)> + +constructor. + +=cut + + +# Descriptions: constructor. +# Arguments: OBJ($self) OBJ($curproc) +# Side Effects: none +# Return Value: OBJ +sub new +{ + my ($self, $curproc) = @_; + my ($type) = ref($self) || $self; + + # we use methods provided by article object. + use FML::Article; + my $article = new FML::Article $curproc; + + my $me = { + _curproc => $curproc, + _article => $article, + }; + + return bless $me, $type; +} + + +# Descriptions: convert files from src_dir/ to dst_dir/ +# Arguments: OBJ($self) OBJ($curproc) HASH_RER($command_args) +# Side Effects: none +# Return Value: none +sub convert +{ + my ($self, $curproc, $command_args) = @_; + my $wh = $command_args->{ _output_channel } || \*STDOUT; + my $article = $self->{ _article }; + my $src_dir = $command_args->{ _src_dir }; + my $dst_dir = $command_args->{ _dst_dir }; + my $ml_name = $command_args->{ ml_name }; + my $use_link = 0; + + print $wh "convert spool of $ml_name ML.\n\n"; + + if ($src_dir eq $dst_dir) { + $src_dir .= ".old"; + rename($dst_dir, $src_dir); + $curproc->mkdir($dst_dir, "mode=private"); + $use_link = 1; + } + + print $wh "converting $dst_dir from $src_dir\n"; + + use File::Spec; + use DirHandle; + my $dh = new DirHandle $src_dir; + if (defined $dh) { + my $source = ''; + my $dir; + + while (defined($dir = $dh->read)) { + next if $dir =~ /^\./o; + + $source = File::Spec->catfile($src_dir, $dir); + + if (-d $source) { + print $wh " $source is a subdir.\n"; + } + elsif (-f $source) { + my $subdirpath = $article->subdirpath($dir); + my $filepath = $article->filepath($dir); + + next if -f $filepath; + + # may conflict $subdirpath (directory) name with + # $source file name. + if (-f $subdirpath) { + croak("$subdirpath file/dir conflict"); + } + else { + unless (-d $subdirpath) { + $curproc->mkdir($subdirpath, "mode=private"); + } + + if (-d $subdirpath) { + if ($use_link) { + link($source, $filepath); + } + else { + use File::Utils qw(copy); + copy($source, $filepath); + } + } + else { + croak("cannot mkdir $filepath\n"); + } + } + + if (-f $filepath) { + print $wh " $source -> $filepath\n"; + } + else { + print $wh " Error: fail $source -> $filepath\n"; + } + } + } + } + + print $wh "done.\n\n"; +} + + +# Descriptions: show information on spool and articles. +# Arguments: OBJ($self) OBJ($curproc) HASH_RER($command_args) +# Side Effects: none +# Return Value: none +sub status +{ + my ($self, $curproc, $command_args) = @_; + my $wh = $command_args->{ _output_channel } || \*STDOUT; + my $dst_dir = $command_args->{ _dst_dir }; + my $suffix = ''; + + my ($num_file, $num_dir) = $self->_scan_dir( $dst_dir ); + + print $wh "spool directory = $dst_dir\n"; + + $suffix = $num_file > 1 ? 's' : ''; + printf $wh "%20d %s\n", $num_file, "file$suffix"; + + $suffix = $num_dir > 1 ? 's' : ''; + printf $wh "%20d %s\n", $num_dir, "subdir$suffix"; +} + + +# Descriptions: return directory information +# Arguments: OBJ($self) STR($dir) +# Side Effects: none +# Return Value: ARRAY(NUM, NUM) +sub _scan_dir +{ + my ($self, $dir) = @_; + my $num_dir = 0; + my $num_file = 0; + + use File::Spec; + use DirHandle; + my $dh = new DirHandle $dir; + if (defined $dh) { + my ($file, $entry); + while (defined($entry = $dh->read)) { + next if $entry =~ /^\./o; + + $file = File::Spec->catfile($dir, $entry); + if (-f $file) { + $num_file++; + } + elsif (-d $file) { + $num_dir++; + my ($x_num_file, $x_num_dir) = $self->_scan_dir( $file ); + $num_file += $x_num_file; + $num_dir += $x_num_dir; + } + } + } + + return ($num_file, $num_dir); +} + + +=head1 CODING STYLE + +See C<http://www.fml.org/software/FNF/> on fml coding style guide. + +=head1 AUTHOR + +Ken'ichi Fukamachi + +=head1 COPYRIGHT + +Copyright (C) 2003 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. + +=head1 HISTORY + +Core functions of FML::Process::Spool is moved to FML::Spool at +2003/03. + +FML::Spool first appeared in fml8 mailing list driver package. +See C<http://www.fml.org/> for more details. + +=cut + + +1; |
