Initial revision

Changes

@@ -0,0 +1,8 @@
+Revision history for Perl module Lingua::Strfname.
+
+0.02  Sat Dec 29 17:54:03 2001
+      Corrected some inconsistencies in the documentation. Otherwise unchanged.
+
+0.01  Sat Dec 29 16:38:08 2001
+      Initial Public Release.
+

MANIFEST

@@ -0,0 +1,6 @@
+Changes
+Makefile.PL
+MANIFEST
+README
+Strfname.pm
+test.pl

Makefile.PL

@@ -0,0 +1,11 @@
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+    'NAME'		=> 'Lingua::Strfname',
+    'VERSION_FROM'	=> 'Strfname.pm', # finds $VERSION
+    'PREREQ_PM'		=> {}, # e.g., Module::Name => 1.1
+    ($] >= 5.005 ?    ## Add these new keywords supported since 5.005
+      (ABSTRACT_FROM => 'Strfname.pm', # retrieve abstract from module
+       AUTHOR     => 'David Wheeler <david@wheeler.net>') : ()),
+);

README

@@ -0,0 +1,27 @@
+Lingua/Strfname version 0.02
+============================
+
+This module exports a single function, strfname(), that may be used to format
+people's names. It features a flexible formatting syntax roughly based on the
+well-known printf and strftime formats.
+
+INSTALLATION
+
+To install this module type the following:
+
+   perl Makefile.PL
+   make
+   make test
+   make install
+
+DEPENDENCIES
+
+This module requires no other modules or libraries not already included with
+Perl.
+
+COPYRIGHT AND LICENCE
+
+Copyright (c) 2000-2002, David Wheeler. All Rights Reserved.
+
+This module is free software; you can redistribute it and/or modify it under the
+same terms as Perl itself.

Strfname.pm

@@ -0,0 +1,130 @@
+package Lingua::Strfname;
+
+use strict;
+require Exporter;
+use vars qw($VERSION @EXPORT @EXPORT_OK @ISA);
+
+$VERSION = "0.02";
+@ISA = qw(Exporter);
+@EXPORT = qw(strfname);
+@EXPORT_OK = qw(strfname);
+
+sub strfname {
+    my $format = shift;
+    my %t = ( '%' => '%' );
+
+    foreach my $a (0..$#_) {
+        my $def = defined $_[$a] && $_[$a] ne '';
+        $t{qw(l f m p s a b c d e)[$a]} = $def && $_[$a];
+        $t{qw(L F M _ _ A B C D E)[$a]} = $def && substr($_[$a], 0, 1) . '.';
+        $t{qw(T S I _ _ 1 2 3 4 5)[$a]} = $def && substr($_[$a], 0, 1);
+    }
+
+    local $^W;
+    $format =~ s/%([^lfmpsabcdeLFMABCDETSI12345%]*)(.)/($_ = $t{$2}) && "$1$_"/ge;
+    return $format;
+}
+
+1;
+__END__
+
+=pod
+
+=head1 NAME
+
+Lingua::Strfname - Formats people's names.
+
+=head1 SYNOPSIS
+
+  use Lingua::Strfname;
+
+  my $format = "%f% m% l";
+  my @names = qw(Clinton William Jefferson Mr. JD);
+  my $name = strfname($format, @names);
+
+=head1 DESCRIPTION
+
+This module exports one function, strfname():
+
+  strfname($format, $last, $first, $middle, $prefix, $suffix, @extra_names)
+
+The strfname function uses the formatting string passed in $format to format a
+person's name. The remaining arguments make up the name: last name, first name,
+middle name, prefix ('Mr.', 'Ms.', 'Dr.', etc.) and suffix ('Ph.D., 'MD', etc.).
+Up to five additional names may also be passed.
+
+The formats are roughly based on the ideas behind sprintf formatting or strftime
+formatting. Each format is denoted by a percent sign (%) and a single
+alpha-numeric character. The character represents the data that will be filled
+in to the string. Any non-alphanumeric characters placed between the % and the
+conversion character will be included in the string B<only if> the data
+represented by the conversion character exists.
+
+For example, if I wanted to get a full name, but didn't have a middle name, I
+would specify a format string like so:
+
+  my $format = "%f% m% l";
+
+In which case, this call
+
+  strfname($format, 'Clinton', 'William');
+
+would yield 'William Clinton'. But this call
+
+  strfname($format, 'Clinton', 'William', 'Jefferson');
+
+would yield 'William Jefferson Clinton'. Similarly, you can add a comma where
+you need one, but only if you need one:
+
+  strfname("%p% f% M% l%, s", 'Clinton', 'William', 'Jefferson', 'Mr.', 'JD');
+
+would yield 'Mr. William J. Clinton, JD', but if there is no suffix (delete 'JD'
+from the call above), it yeilds 'Mr. William J. Clinton', leaving off the comma
+that would preceed the suffix, if it existed.
+
+Here are the supported formats:
+
+  %l Last Name
+  %f First Name
+  %m Middle Name
+  %p Prefix
+  %s Suffix
+  %L Last Name Initial with period
+  %F First Name Initial with period
+  %M Middle Name Initial with period
+  %T Last Name Initial
+  %S First Name Initial
+  %I Middle Name Initial
+  %a Extra Name 1
+  %b Extra Name 2
+  %c Extra Name 3
+  %d Extra Name 4
+  %e Extra Name 5
+  %A Extra Name 1 Initial with period
+  %B Extra Name 2 Initial with period
+  %C Extra Name 3 Initial with period
+  %D Extra Name 4 Initial with period
+  %E Extra Name 5 Initial with period
+  %1 Extra Name 1 Initial
+  %2 Extra Name 2 Initial
+  %3 Extra Name 3 Initial
+  %4 Extra Name 4 Initial
+  %5 Extra Name 5 Initial
+
+=head1 AUTHOR
+
+David Wheeler E<lt>david@wheeler.netE<gt>, with implementation assistance from
+David Lowe.
+
+=head1 SEE ALSO
+
+perl
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (c) 2000-2002, David Wheeler. All Rights Reserved.
+
+This module is free software; you can redistribute it and/or modify it under the
+same terms as Perl itself.
+
+=cut

test.pl

@@ -0,0 +1,56 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test;
+use constant DEBUG => 0;
+BEGIN { plan tests => 27 };
+use Lingua::Strfname;
+ok(1); # If we made it this far, we're ok.
+
+#########################
+
+my @names = qw(Clinton William Jefferson Mr. JD "Bill");
+
+my %tests = ( "%f% m% l" => 'William Jefferson Clinton',
+	      "%p% f% M% l%, s" => 'Mr. William J. Clinton, JD',
+	      "%f% a% l" => 'William "Bill" Clinton',
+	      "%l,% F%M" => 'Clinton, W.J.',
+	      "%a% l,% s" => '"Bill" Clinton, JD',
+	      '%l%, f% m' => 'Clinton, William Jefferson',
+	      '%l%, f% M' => 'Clinton, William J.',
+	      '%l%, f' => 'Clinton, William',
+	      '%l%, F% m' => 'Clinton, W. Jefferson',
+	      '%f% l' => 'William Clinton',
+	      '%f% M% l' => 'William J. Clinton',
+	      '%F%M% l' => 'W.J. Clinton',
+	      '%F% m% l' => 'W. Jefferson Clinton',
+);
+
+while (my ($f, $r) = each %tests) {
+    DEBUG && print "$f:\n$r\n", strfname($f, @names), "\n\n";
+    ok( strfname($f, @names) eq $r );
+}
+
+@names[2,5] = ('', '');
+
+%tests = ( "%f% m% l" => 'William Clinton',
+	   "%p% f% M% l%, s" => 'Mr. William Clinton, JD',
+	   "%f% a% l" => 'William Clinton',
+	   "%l,% F%M" => 'Clinton, W.',
+	   "%a% l,% s" => ' Clinton, JD',
+	   '%l%, f% m' => 'Clinton, William',
+	   '%l%, f% M' => 'Clinton, William',
+	   '%l%, f' => 'Clinton, William',
+	   '%l%, F% m' => 'Clinton, W.',
+	   '%f% l' => 'William Clinton',
+	   '%f% M% l' => 'William Clinton',
+	   '%F%M% l' => 'W. Clinton',
+	   '%F% m% l' => 'W. Clinton',
+);
+
+while (my ($f, $r) = each %tests) {
+    DEBUG && print "$f:\n$r\n", strfname($f, @names), "\n\n";
+    ok( strfname($f, @names) eq $r );
+}
+
+__END__