move FML::SequenceFile and Utils to File::

add File::Errors also to avoid errors

3 files changed, 390 insertions, 0 deletions

diff --git a/fml/lib/File/Errors.pm b/fml/lib/File/Errors.pm
new file mode 100644
index 00000000..4d5399a3
--- /dev/null
+++ b/fml/lib/File/Errors.pm
@@ -0,0 +1,87 @@
+#-*- perl -*-
+#
+#  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. 
+#
+# $Id$
+# $FML$
+#
+
+package File::Errors;
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK);
+use Carp;
+
+require Exporter;
+@ISA       = qw(Exporter);
+@EXPORT_OK = qw(error_reason error error_reset);
+
+=head1 NAME
+
+File::Errors.pm - error handling utilities
+
+=head1 SYNOPSIS
+
+	package Something;
+	use File::Errors qw(error_reason error error_reset);
+
+	sub xxx
+	{
+		if something errors ...
+		$self->error_reason( error reason );
+	}
+
+When you use Something module,
+
+	use Something;
+	$obj = new Something;
+	unless ($obj->error) { $obj->do_somting( ...); };
+
+
+=head1 DESCRIPTION
+
+=head1 AUTHOR
+
+Ken'ichi Fukamachi
+
+=head1 COPYRIGHT
+
+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. 
+
+=head1 HISTORY
+
+File::Errors appeared in fml5 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+
+sub error_reason
+{
+    my ($self, $mesg) = @_;
+    $self->{'_error_reason'} = $mesg;
+}
+
+
+sub error
+{
+    my ($self, $args) = @_;
+    return $self->{'_error_reason'};
+}
+
+
+sub error_reset
+{
+    my ($self, $args) = @_;
+    my $msg = $self->{'_error_reason'};
+    undef $self->{'_error_reason'} if defined $self->{'_error_reason'};
+    undef $self->{'_error_action'} if defined $self->{'_error_action'};
+    return $msg;
+}
+
+
+1;
diff --git a/fml/lib/File/Sequence.pm b/fml/lib/File/Sequence.pm
new file mode 100644
index 00000000..e0da18ae
--- /dev/null
+++ b/fml/lib/File/Sequence.pm
@@ -0,0 +1,140 @@
+#-*- perl -*-
+#
+#  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. 
+#
+# $Id$
+# $FML$
+#
+
+package File::Sequence;
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK);
+use Carp;
+use File::Errors qw(error_reason error error_reset);
+
+=head1 NAME
+
+File::Sequence - maintain the sequence number
+
+=head1 SYNOPSIS
+
+   use File::Sequence;
+   my $sfh = new File::Sequence { sequence_file => $seq_file };
+   my $id  = $sfh->increment_id;
+   if ($sfh->error) { use Carp; carp( $sfh->error ); }
+
+If you divide the $id by some modulus, use
+
+   my $sfh = new File::Sequence { 
+       sequence_file => $seq_file,
+       modulus       => $modules,
+   };
+   my $id  = $sfh->increment_id;
+
+For example, if you do new() with modulus 3,
+
+   my $sfh = new File::Sequence { 
+       sequence_file => $seq_file,
+       modulus       => 3,
+   };
+
+$id becomes 0, 1, 2, 0, 1, 2...
+
+=head1 DESCRIPTION
+
+=head2 C<new($args)>
+
+$args->{ sequence_file } is the file holding the current sequence number.
+
+=head2 C<increment_id([$file])>
+
+increment the sequence number.
+
+=cut
+
+require Exporter;
+@ISA = qw(Exporter);
+
+
+sub new
+{
+    my ($self, $args) = @_;
+    my ($type) = ref($self) || $self;
+    my $me     = {};
+    $me->{ _sequence_file } = $args->{ sequence_file };
+    $me->{ _modulus }       = $args->{ modulus };
+    return bless $me, $type;
+}
+
+
+sub increment_id
+{
+    my ($self, $file) = @_;
+    my $id = 0;
+    my $seq_file = $file || $self->{ _sequence_file };
+
+    unless ($seq_file) {
+	$self->error_reason("the sequence file is not specified");
+	return 0;
+    };
+
+    # touch the sequence file if it does not exist.
+    unless (-f $seq_file) {
+	use File::Utils qw(touch);
+	touch($seq_file);
+    };
+
+    use IO::File::Atomic;
+    my ($rh, $wh) = IO::File::Atomic->rw_open($seq_file);
+
+    # read the current sequence number
+    if (defined $rh) {
+	$id = $rh->getline;
+	$rh->close;
+    }
+    else {
+	$self->error_reason("cannot open the sequence file");
+	return 0;
+    }
+
+    # compute the modulus
+    if (defined $self->{ _modulus }) {
+	my $modulus = $self->{ _modulus };
+	$id++;
+	$id = $id % $modulus;
+    }
+    # increment $id. The incremented number is the current article ID.
+    else {
+	$id++;
+    }
+
+    # save $id
+    print $wh $id, "\n";
+    $wh->close;
+
+    $id;
+}
+
+
+=head1 AUTHOR
+
+Ken'ichi Fukamachi
+
+=head1 COPYRIGHT
+
+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. 
+
+=head1 HISTORY
+
+File::Sequence appeared in fml5 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+
+1;
diff --git a/fml/lib/File/Utils.pm b/fml/lib/File/Utils.pm
new file mode 100644
index 00000000..448bfaa4
--- /dev/null
+++ b/fml/lib/File/Utils.pm
@@ -0,0 +1,163 @@
+#-*- perl -*-
+#
+#  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. 
+#
+# $Id$
+# $File$
+#
+
+package File::Utils;
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK $ErrorString);
+use Carp;
+
+
+require Exporter;
+@ISA       = qw(Exporter);
+@EXPORT_OK = qw(mkdirhier touch search_program copy);
+
+=head1 NAME
+
+File::Utils.pm - error handling utilities
+
+=head1 SYNOPSIS
+
+   use File::Utils qw(mkdiehier);
+   mkdirhier($dir, $mode);
+
+=head1 DESCRIPTION
+
+=head1 AUTHOR
+
+Ken'ichi Fukamachi
+
+=head1 COPYRIGHT
+
+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. 
+
+=head1 HISTORY
+
+File::Utils appeared in fml5 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+sub error       { return $ErrorString;}
+
+sub error_reset { undef $ErrorString;}
+
+
+# Descriptions: "mkdir -p" or "mkdirhier"
+#    Arguments: directory [file_mode]
+# Side Effects: set $ErrorString
+# Return Value: succeeded to create directory or not
+sub mkdirhier
+{
+    my ($dir, $mode) = @_;
+
+    error_reset();
+
+    # XXX $mode (e.g. 0755) should be a numeric not a string
+    eval qq{ 
+	use File::Path;
+	mkpath(\$dir, 0, $mode);
+    };
+    $ErrorString = $@;
+    return ($@ ? undef : 1);
+}
+
+
+# Descriptions: touch: create file if file not exists
+#    Arguments: file file_mode
+# Side Effects: none
+# Return Value: 1 if succeed, 0 if not
+sub touch
+{
+    my ($file, $mode) = @_;
+    my ($ok) = 0;
+
+    error_reset();
+
+    if ( -f $file) {
+	return 1;
+    }
+    else {
+	my $fh = new IO::File $file, "a";
+
+	if (defined $fh) {
+	    $fh->autoflush(1);
+	    close($fh);
+	}
+
+	$ok++        if -f $file;
+	return 0 unless -f $file;
+    };
+
+    if (defined $mode) {
+	chmod $mode, $file && $ok++;
+    }
+
+    return $ok;
+}
+
+
+
+# Descriptions: file $file executable
+#    Arguments: file [path_list]
+#               The "path_list" is an ARRAY_REFERENCE. 
+#               For example, 
+#               search_program('md5'); 
+#               search_program('md5', [ '/bin', '/sbin' ]); 
+# Side Effects: none
+# Return Value: pathname if found, undef if not
+sub search_program
+{
+    my ($file, $path_list) = @_;
+
+    my $default_path_list = [
+			     '/usr/bin', 
+			     '/bin', 
+			     '/sbin', 
+			     '/usr/local/bin', 
+			     '/usr/gnu/bin', 
+			     '/usr/pkg/bin'
+			     ];
+
+    $path_list ||= $default_path_list;
+
+    use File::Spec;
+    my $path;
+    for $path (@$path_list) {
+	my $prog = File::Spec->catfile($path, $file);
+	if (-x $prog) {
+	    return $prog;
+	}
+    }
+
+    return wantarray ? () : undef;
+}
+
+
+
+# wrappers for delegation :-)
+sub copy
+{
+    my ($src, $dst) = @_;
+    my $pkg = 'IO::File::Atomic';
+
+    eval qq{ require $pkg; $pkg->import();};
+    unless ($@) {
+	$pkg->new->copy($src, $dst);
+    }
+    else {
+	undef;
+    }
+}
+
+
+1;