File Coverage

File:blib/lib/Text/Names/Abbreviate.pm
Coverage:92.8%

linestmtbrancondsubtimecode
1package Text::Names::Abbreviate;
2
3
2
2
2
2
175224
2
26
use strict;
4
2
2
2
2
2
2
33
use warnings;
5
6
2
2
2
2
4
0
47
use Carp;
7
2
2
2
2
3
2
29
use Exporter 'import';
8
2
2
2
2
345
8780
44
use Params::Get 0.13;
9
2
2
2
2
573
26770
671
use Params::Validate::Strict 0.13;
10
11our @EXPORT_OK = qw(abbreviate);
12our $VERSION = '0.01';
13
14 - 82
=head1 NAME

Text::Names::Abbreviate - Create abbreviated name formats from full names

=head1 SYNOPSIS

  use Text::Names::Abbreviate qw(abbreviate);

  say abbreviate("John Quincy Adams");                 # "J. Q. Adams"
  say abbreviate("Adams, John Quincy");               # "J. Q. Adams"
  say abbreviate("George R R Martin", { format => 'initials' }); # "G.R.R.M."

=head1 DESCRIPTION

This module provides simple abbreviation logic for full personal names,
with multiple formatting options and styles.

=head1 SUBROUTINES/METHODS

=head2 abbreviate

Make the abbreviation.
It takes the following optional arguments:

=over

=item format

One of: default, initials, compact, shortlast

=item style

One of: first_last, last_first

=item separator

Customize the spacing/punctuation for initials (default: ". ")

=back

=head3  API SPECIFICATION

=head4  INPUT

  {
    'name' => { 'type' => 'string', 'min' => 1, 'optional' => 0 },
    'format' => {
      'type' => 'string',
      'memberof' => [ 'default', 'initials', 'compact', 'shortlast' ],
      'optional' => 1
    }, 'style' => {
      'type' => 'string',
      'memberof' => [ 'first_last', 'last_first' ],
      'optional' => 1
    }, 'separator' => {
      'type' => 'string',
      'optional' => 1
    }
  }

=head4  OUTPUT

Argument error: croak

  {
    'type' => 'string',
  }

=cut
83
84sub abbreviate
85{
86
13
13
77650
        my $params = Params::Validate::Strict::validate_strict({
87                args => Params::Get::get_params('name', @_),
88                schema => {
89                        'name' => { 'type' => 'string', 'min' => 1, 'optional' => 0 },
90                        'format' => {
91                                'type' => 'string',
92                                'memberof' => [ 'default', 'initials', 'compact', 'shortlast' ],
93                                'optional' => 1
94                        }, 'style' => {
95                                'type' => 'string',
96                                'memberof' => [ 'first_last', 'last_first' ],
97                                'optional' => 1
98                        }, 'separator' => {
99                                'type' => 'string',
100                                'optional' => 1
101                        }
102                }
103        });
104
105
13
1785
        my $name = $params->{'name'};
106
13
100
18
        if(!defined($name)) {
107
1
10
                Carp::croak(__PACKAGE__, '::abbreviate: Usage($name, { options })')
108        }
109
110
12
100
20
        my $format = $params->{format} // 'default'; # default, initials, compact, shortlast
111
12
100
34
        my $style = $params->{style} // 'first_last'; # first_last or last_first
112
12
100
13
        my $sep = defined $params->{separator} ? $params->{separator} : '.';
113
114        # Normalize commas (e.g., "Adams, John Q." -> ("Adams", "John Q."))
115
12
11
        my $had_leading_comma = 0;
116
12
100
15
        if ($name =~ /,/) {
117
3
6
11
11
                my ($last, $rest) = map { s/^\s+|\s+$//gr } split(/\s*,\s*/, $name, 2);
118
3
100
10
                $rest ||= '';
119
3
100
5
                $last ||= '';
120
121                # Track if we had a leading comma (empty last name part)
122
3
100
67
6
                $had_leading_comma = 1 if !length($last) && length($rest);
123
124
3
100
100
50
100
7
                if (length($last) && length($rest)) {
125
1
1
                        $name = "$rest $last";
126                } elsif (length($rest)) {
127
1
1
                        $name = $rest;
128                } elsif (length($last)) {
129
1
1
                        $name = $last;
130                } else {
131
0
0
                        return '';
132                }
133
134
3
4
                $name =~ s/^\s+|\s+$//g;
135
3
5
                $name =~ s/\s+/ /g;
136        }
137
138
12
16
        my @parts = split /\s+/, $name;
139
12
50
12
        return '' unless @parts;
140
141
12
11
        my $last_name;
142        my @initials;
143
144        # If we had a leading comma (", John"), treat all parts as first names
145
12
100
6
        if ($had_leading_comma) {
146
1
1
                $last_name = '';
147
1
1
2
1
                @initials = map { substr($_, 0, 1) } @parts;
148        } else {
149
11
11
                $last_name = pop @parts;
150
11
15
12
17
                @initials = map { substr($_, 0, 1) } @parts;
151
152                # For last_first style in non-default formats, put last name initial first
153
11
100
75
20
                if ($style eq 'last_first' && $format ne 'default' && length($last_name)) {
154
2
2
                        unshift @initials, substr($last_name, 0, 1);
155
2
1
                        $last_name = '';
156                }
157        }
158
159
12
100
13
        if(@initials) {
160
8
18
5
20
                @initials = grep { $_ } @initials;      # Remove empty elements
161        }
162
163
12
100
100
100
18
        if ($format eq 'compact') {
164
2
100
8
                return join('', @initials, length($last_name) ? substr($last_name, 0, 1) : ());
165        } elsif ($format eq 'initials') {
166
3
3
                my @letters = @initials;
167
3
100
7
                push @letters, substr($last_name, 0, 1) if length $last_name;
168
169
3
10
                return join($sep, @letters) . $sep;
170        } elsif ($format eq 'shortlast') {
171
1
50
2
                if(@initials) {
172
0
0
0
0
                        return join(' ', map { "${_}$sep" } @initials) . " $last_name";
173                }
174
1
2
                return $last_name;
175        } else { # default: "J. Q. Adams"
176
6
100
12
                if(@initials) {
177
3
5
3
7
                        my $joined = join(' ', map { "${_}$sep" } @initials);
178
3
50
5
                        if(length($joined)) {
179
3
100
50
9
                                return $style eq 'last_first'
180                                        ? "$last_name, $joined"
181                                        : $last_name ? "$joined $last_name" : $joined;
182                        }
183                }
184
3
9
                return $last_name;
185        }
186}
187
1881;
189