├── LICENSE ├── README.md ├── cpan ├── Changes ├── Makefile.PL ├── README.pod ├── bin │ └── titlecase ├── inc │ └── boilerplate.pl ├── lib │ └── Lingua │ │ └── EN │ │ └── Titlecase │ │ └── Simple.pm └── t │ ├── 00-load.t │ ├── titlecase.t │ └── wantarray.t ├── test.pl └── titlecase /LICENSE: -------------------------------------------------------------------------------- 1 | This software is Copyright (c) 2018 by John Gruber, Aristotle Pagaltzis. 2 | 3 | This is free software, licensed under: 4 | 5 | The MIT (X11) License 6 | 7 | The MIT License 8 | 9 | Permission is hereby granted, free of charge, to any person 10 | obtaining a copy of this software and associated 11 | documentation files (the "Software"), to deal in the Software 12 | without restriction, including without limitation the rights to 13 | use, copy, modify, merge, publish, distribute, sublicense, 14 | and/or sell copies of the Software, and to permit persons to 15 | whom the Software is furnished to do so, subject to the 16 | following conditions: 17 | 18 | The above copyright notice and this permission notice shall 19 | be included in all copies or substantial portions of the 20 | Software. 21 | 22 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT 23 | WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, 24 | INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 25 | MERCHANTABILITY, FITNESS FOR A PARTICULAR 26 | PURPOSE AND NONINFRINGEMENT. IN NO EVENT 27 | SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 28 | LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 29 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 30 | TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 31 | CONNECTION WITH THE SOFTWARE OR THE USE OR 32 | OTHER DEALINGS IN THE SOFTWARE. 33 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | This is a refactoring of [John Gruber’s Title Case program](http://daringfireball.net/2008/05/title_case), which also includes a universal test suite containing all the test cases listed by John. 2 | 3 | The test suite is provided in the form of a Perl script called `test.pl` which expects to be passed a command line for invoking a program that performs titlecasing. E.g. to test the provided `titlecase` itself: 4 | 5 | ```` 6 | perl test.pl ./titlecase 7 | ```` 8 | 9 | The program under test should work like John’s: it should read any number of titles from standard input, one title per line, and write the case-corrected titles to standard output in the same form. 10 | -------------------------------------------------------------------------------- /cpan/Changes: -------------------------------------------------------------------------------- 1 | Release history for Lingua-EN-Titlecase-Simple 2 | 3 | 1.015 Wed 16 Oct 2024 4 | - No /o switch in substitutions; the list of small words can now be changed at any time 5 | - Special cases for small words in two-word compounds, like "stand-in" and "in-flight" (but not "man-in-the-middle") 6 | 7 | 1.005 Tue 09 Aug 2022 8 | - No functional changes 9 | - Packaging fix to stop installing boilerplate.pl 10 | 11 | 1.004 Tue 21 Aug 2018 12 | - Fix for “100's” capitalisation 13 | - Cover script for command line use 14 | 15 | 1.003 Tue 27 Feb 2018 16 | - Removal of Exporter::Tidy dependency 17 | 18 | 1.002 Mon 26 Feb 2018 19 | - Perl 5.8.1 support 20 | - Packaging cleanups 21 | 22 | 1.001 Sat 08 Aug 2015 23 | - Correct dependency metadata 24 | 25 | 1.000 Sat 08 Aug 2015 26 | - Proper capitalization for slashed/joined words 27 | - Unix path case preservation 28 | - Configurable small word list 29 | - Improved documentation 30 | 31 | 0.1 Fri 10 Sep 2010 32 | - Initial release 33 | -------------------------------------------------------------------------------- /cpan/Makefile.PL: -------------------------------------------------------------------------------- 1 | use 5.008001; use strict; use warnings; 2 | 3 | my $sc = q; 4 | my $bt = q; 5 | 6 | my %META = ( 7 | name => 'Lingua-EN-Titlecase-Simple', 8 | author => [ 9 | 'John Gruber ', 10 | 'Aristotle Pagaltzis ', 11 | ], 12 | x_copyright => { holder => 'John Gruber, Aristotle Pagaltzis', year => 2018 }, 13 | license => 'mit', 14 | resources => { 15 | repository => { type => 'git', url => "$sc.git", web => $sc }, 16 | bugtracker => { web => $bt }, 17 | }, 18 | dynamic_config => 0, 19 | prereqs => { 20 | runtime => { 21 | requires => {qw( 22 | perl 5.008001 23 | )}, 24 | }, 25 | test => { 26 | requires => {qw( 27 | Data::Dumper 0 28 | Test::More 0 29 | )}, 30 | }, 31 | }, 32 | ); 33 | 34 | my %MM_ARGS = ( EXE_FILES => [ 'bin/titlecase' ] ); 35 | 36 | sub MY::postamble { -f 'META.yml' ? return : <<'' } 37 | create_distdir : MANIFEST 38 | distdir : MANIFEST 39 | MANIFEST : 40 | ( git ls-files ':!README.pod' ; echo MANIFEST ) > MANIFEST 41 | distdir : boilerplate 42 | .PHONY : boilerplate 43 | boilerplate : distmeta 44 | $(PERL) -Ilib inc/boilerplate.pl $(DISTVNAME) 45 | 46 | ## BOILERPLATE ############################################################### 47 | require ExtUtils::MakeMaker; 48 | 49 | # have to do this since old EUMM dev releases miss the eval $VERSION line 50 | my $eumm_version = eval $ExtUtils::MakeMaker::VERSION; 51 | my $mymeta = $eumm_version >= 6.57_02; 52 | my $mymeta_broken = $mymeta && $eumm_version < 6.57_07; 53 | 54 | (my $basepath = (-d 'lib' && 'lib/') . $META{name}) =~ s{-}{/}g; 55 | 56 | ($MM_ARGS{NAME} = $META{name}) =~ s/-/::/g; 57 | $MM_ARGS{VERSION_FROM} = "$basepath.pm"; 58 | $MM_ARGS{ABSTRACT_FROM} = -f "$basepath.pod" ? "$basepath.pod" : "$basepath.pm"; 59 | $META{license} = [ $META{license} ] 60 | if $META{license} && !ref $META{license}; 61 | $MM_ARGS{LICENSE} = $META{license}[0] 62 | if $META{license} && $eumm_version >= 6.30; 63 | $MM_ARGS{NO_MYMETA} = 1 64 | if $mymeta_broken; 65 | $MM_ARGS{META_ADD} = { 'meta-spec' => { version => 2 }, %META } 66 | unless -f 'META.yml'; 67 | $MM_ARGS{PL_FILES} ||= {}; 68 | $MM_ARGS{NORECURS} = 1 69 | if not exists $MM_ARGS{NORECURS}; 70 | 71 | for (qw(configure build test runtime)) { 72 | my $key = $_ eq 'runtime' ? 'PREREQ_PM' : uc $_.'_REQUIRES'; 73 | my $r = $MM_ARGS{$key} = { 74 | %{$META{prereqs}{$_}{requires} || {}}, 75 | %{delete $MM_ARGS{$key} || {}}, 76 | }; 77 | defined $r->{$_} or delete $r->{$_} for keys %$r; 78 | } 79 | 80 | $MM_ARGS{MIN_PERL_VERSION} = eval delete $MM_ARGS{PREREQ_PM}{perl} || 0; 81 | 82 | delete $MM_ARGS{MIN_PERL_VERSION} 83 | if $eumm_version < 6.47_01; 84 | $MM_ARGS{BUILD_REQUIRES} = {%{$MM_ARGS{BUILD_REQUIRES}}, %{delete $MM_ARGS{TEST_REQUIRES}}} 85 | if $eumm_version < 6.63_03; 86 | $MM_ARGS{PREREQ_PM} = {%{$MM_ARGS{PREREQ_PM}}, %{delete $MM_ARGS{BUILD_REQUIRES}}} 87 | if $eumm_version < 6.55_01; 88 | delete $MM_ARGS{CONFIGURE_REQUIRES} 89 | if $eumm_version < 6.51_03; 90 | 91 | ExtUtils::MakeMaker::WriteMakefile(%MM_ARGS); 92 | ## END BOILERPLATE ########################################################### 93 | -------------------------------------------------------------------------------- /cpan/README.pod: -------------------------------------------------------------------------------- 1 | lib/Lingua/EN/Titlecase/Simple.pm -------------------------------------------------------------------------------- /cpan/bin/titlecase: -------------------------------------------------------------------------------- 1 | ../../titlecase -------------------------------------------------------------------------------- /cpan/inc/boilerplate.pl: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | 3 | use CPAN::Meta; 4 | use Software::LicenseUtils 0.103011; 5 | use Pod::Readme::Brief 1.001; 6 | 7 | sub slurp { open my $fh, '<', $_[0] or die "Couldn't open $_[0] to read: $!\n"; local $/; readline $fh } 8 | sub trimnl { s/\A\s*\n//, s/\s*\z/\n/ for @_; wantarray ? @_ : $_[-1] } 9 | sub mkparentdirs { 10 | my @dir = do { my %seen; sort grep s!/[^/]+\z!! && !$seen{ $_ }++, my @copy = @_ }; 11 | if ( @dir ) { mkparentdirs( @dir ); mkdir for @dir } 12 | } 13 | 14 | chdir $ARGV[0] or die "Cannot chdir to $ARGV[0]: $!\n"; 15 | 16 | my %file; 17 | 18 | my $meta = CPAN::Meta->load_file( 'META.json' ); 19 | 20 | my $license = do { 21 | my @key = ( $meta->license, $meta->meta_spec_version ); 22 | my ( $class, @ambiguous ) = Software::LicenseUtils->guess_license_from_meta_key( @key ); 23 | die if @ambiguous or not $class; 24 | $class->new( $meta->custom( 'x_copyright' ) ); 25 | }; 26 | 27 | $file{'LICENSE'} = trimnl $license->fulltext; 28 | 29 | my $binfn = 'bin/titlecase'; 30 | my ( $libfn ) = map { s!-!/!g; s!^!lib/! if -d 'lib'; -f "$_.pod" ? "$_.pod" : "$_.pm" } $meta->name; 31 | 32 | $file{ $binfn } = slurp $binfn; 33 | $file{ $binfn } =~ s!(?<=\n\n)(.*)(?=\n\nuse open )!use Lingua::EN::Titlecase::Simple;!s or die "Couldn't fixup $binfn\n"; 34 | my $body = $1; 35 | 36 | $file{ $libfn } = slurp $libfn; 37 | $file{ $libfn } =~ s!.*BEGIN.*FIXUP(?s:.*?)END.*FIXUP.*!$body!e or die "Couldn't fixup $libfn\n"; 38 | $file{ $libfn } =~ s{(^=cut\s*\z)}{ join "\n", ( 39 | "=head1 AUTHOR\n", trimnl( $meta->authors ), 40 | "=head1 COPYRIGHT AND LICENSE\n", trimnl( $license->notice ), 41 | "=cut\n", 42 | ) }me; 43 | 44 | die unless -e 'Makefile.PL'; 45 | $file{'README'} = Pod::Readme::Brief->new( $file{ $libfn } )->render( installer => 'eumm' ); 46 | 47 | my @manifest = split /\n/, slurp 'MANIFEST'; 48 | my %manifest = map /\A([^\s#]+)()/, @manifest; 49 | $file{'MANIFEST'} = join "\n", @manifest, ( sort grep !exists $manifest{ $_ }, keys %file ), ''; 50 | 51 | mkparentdirs sort keys %file; 52 | for my $fn ( sort keys %file ) { 53 | unlink $fn if -e $fn; 54 | open my $fh, '>', $fn or die "Couldn't open $fn to write: $!\n"; 55 | print $fh $file{ $fn }; 56 | close $fh or die "Couldn't close $fn after writing: $!\n"; 57 | } 58 | 59 | chmod 0755, $binfn or die "Couldn't chmod +x $binfn: $!\n"; 60 | -------------------------------------------------------------------------------- /cpan/lib/Lingua/EN/Titlecase/Simple.pm: -------------------------------------------------------------------------------- 1 | use 5.008001; use strict; use warnings; use utf8; 2 | 3 | package Lingua::EN::Titlecase::Simple; 4 | 5 | our $VERSION = '1.015'; 6 | 7 | BEGIN { # FIXUP: this stuff is here to allow `prove` to Just Work during development 8 | my $fn = '../titlecase'; 9 | open my $fh, '<', $fn or die "Couldn't read $fn: $!\n"; 10 | local $/; 11 | ( my $src = "#line 1 $fn\n" . readline $fh ) =~ s!\nuse open .*!1!s or die "Source fixup failed"; 12 | open $fh, '<', \$src; 13 | my @saved_inc = @INC; 14 | @INC = sub { @INC = @saved_inc; $fh }; 15 | require 'titlecase'; 16 | } # END FIXUP 17 | 18 | sub import { 19 | my ( $class, $pkg, $file, $line ) = ( shift, caller ); 20 | die "Unknown symbol: $_ at $file line $line.\n" for grep 'titlecase' ne $_, @_; 21 | no strict 'refs'; 22 | *{ $pkg . '::titlecase' } = \&titlecase if @_; 23 | } 24 | 25 | 1; 26 | 27 | __END__ 28 | 29 | =pod 30 | 31 | =encoding UTF-8 32 | 33 | =head1 NAME 34 | 35 | Lingua::EN::Titlecase::Simple - John Gruber's headline capitalization script 36 | 37 | =head1 SYNOPSIS 38 | 39 | use Lingua::EN::Titlecase::Simple 'titlecase'; 40 | 41 | print titlecase 'Small word at end is nothing to be afraid of'; 42 | # output: Small Word at End Is Nothing to Be Afraid Of 43 | 44 | print titlecase 'IF IT’S ALL CAPS, FIX IT'; 45 | # output: If It’s All Caps, Fix It 46 | 47 | =head1 DESCRIPTION 48 | 49 | This module capitalizes English text suitably for use as a headline, based on 50 | traditional editorial rules from I. 51 | 52 | =head1 INTERFACE 53 | 54 | There are no default exports. 55 | 56 | =head2 C 57 | 58 | Takes one or more strings as arguments, each representing one headline to capitalize. 59 | 60 | When given a single string, returns a scalar. 61 | When given several strings, returns a list in list context, but an arrayref in scalar context. 62 | When given nothing, returns nothing in list context or undef in scalar context. 63 | 64 | This function can be exported on request. 65 | 66 | Note that the arrayref return is problematic because it depends on the number 67 | of arguments. If you have a variable number of arguments to pass, and that 68 | number can sometimes be less than 2, you will sometimes get a plain scalar or 69 | an undefined value instead of the arrayref you expected. Passing multiple 70 | strings in scalar context is therefore L. 71 | 72 | =head2 C<@SMALL_WORD> 73 | 74 | Contains the list of words to avoid capitalizing. 75 | 76 | =head1 SEE ALSO 77 | 78 | L provides a much more heavyweight, modular solution 79 | for the same problem. If you seriously disagree with the style rules in this 80 | module somewhere, you may be happier with that one. 81 | 82 | =cut 83 | -------------------------------------------------------------------------------- /cpan/t/00-load.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | 3 | use Test::More; 4 | 5 | my @module = qw( 6 | Lingua::EN::Titlecase::Simple; 7 | ); 8 | 9 | plan tests => 0+@module; 10 | 11 | diag "Testing on Perl $] at $^X"; 12 | 13 | for my $module ( @module ) { 14 | use_ok( $module ) or BAIL_OUT "Cannot load module '$module'"; 15 | no warnings 'uninitialized'; 16 | diag "Testing $module @ " . $module->VERSION; 17 | } 18 | -------------------------------------------------------------------------------- /cpan/t/titlecase.t: -------------------------------------------------------------------------------- 1 | ../../test.pl -------------------------------------------------------------------------------- /cpan/t/wantarray.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | 3 | use Test::More tests => 3; 4 | use Lingua::EN::Titlecase::Simple qw/titlecase/; 5 | use open qw/:encoding(UTF-8)/; 6 | use utf8; 7 | 8 | my @xyz = qw( X Y Z ); 9 | 10 | is_deeply [ titlecase @xyz ], \@xyz, 'list context, many args => return list'; 11 | is_deeply scalar( titlecase @xyz ), \@xyz, 'scalar context, many args => return arrayref'; 12 | is_deeply [ titlecase 'X' ], ['X'], 'list context, single arg => return scalar'; 13 | -------------------------------------------------------------------------------- /test.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | use strict; use warnings; 3 | 4 | use Test::More; 5 | use if @ARGV != 0, 'IPC::Open2' => 'open2'; 6 | use if @ARGV == 0, 'Lingua::EN::Titlecase::Simple' => 'titlecase'; 7 | use Data::Dumper 'Dumper'; 8 | use constant TEXTMODE => ':encoding(UTF-8)'; 9 | 10 | sub pp { s/\A\$VAR1 = //, s/;\s*\z//, return $_ for Dumper $_[0]; } 11 | 12 | defined &titlecase or *titlecase = sub { 13 | open2( my $cout, my $cin, @ARGV ) or die "Couldn't execute @ARGV\: $!\n"; 14 | binmode $_, TEXTMODE for $cin, $cout; 15 | 16 | print { $cin } join "\n", @_; 17 | close $cin or die $!; 18 | 19 | chomp( my @result = readline $cout ); 20 | close $cout or die $!; 21 | 22 | @result; 23 | }; 24 | 25 | binmode DATA, TEXTMODE; 26 | 27 | my @testcase = 28 | map [ split /\n/ ], 29 | do { local $/ = ""; }; # $/ = "" is paragraph mode 30 | 31 | plan tests => 0+@testcase; 32 | 33 | my @result = titlecase( map $_->[0], @testcase ); 34 | 35 | for ( @testcase ) { 36 | my ( $input, $expect ) = @$_; 37 | is shift @result, $expect, pp $input; 38 | } 39 | 40 | __END__ 41 | 42 | For step-by-step directions email someone@gmail.com 43 | For Step-by-Step Directions Email someone@gmail.com 44 | 45 | 2lmc Spool: 'Gruber on OmniFocus and Vapo(u)rware' 46 | 2lmc Spool: 'Gruber on OmniFocus and Vapo(u)rware' 47 | 48 | Have you read “The Lottery”? 49 | Have You Read “The Lottery”? 50 | 51 | your hair[cut] looks (nice) 52 | Your Hair[cut] Looks (Nice) 53 | 54 | People probably won't put http://foo.com/bar/ in titles 55 | People Probably Won't Put http://foo.com/bar/ in Titles 56 | 57 | Scott Moritz and TheStreet.com’s million iPhone la‑la land 58 | Scott Moritz and TheStreet.com’s Million iPhone La‑La Land 59 | 60 | BlackBerry vs. iPhone 61 | BlackBerry vs. iPhone 62 | 63 | Notes and observations regarding Apple’s announcements from ‘The Beat Goes On’ special event 64 | Notes and Observations Regarding Apple’s Announcements From ‘The Beat Goes On’ Special Event 65 | 66 | Read markdown_rules.txt to find out how _underscores around words_ will be interpretted 67 | Read markdown_rules.txt to Find Out How _Underscores Around Words_ Will Be Interpretted 68 | 69 | Q&A with Steve Jobs: 'That's what happens in technology' 70 | Q&A With Steve Jobs: 'That's What Happens in Technology' 71 | 72 | What is AT&T's problem? 73 | What Is AT&T's Problem? 74 | 75 | Apple deal with AT&T falls through 76 | Apple Deal With AT&T Falls Through 77 | 78 | this v that 79 | This v That 80 | 81 | this vs that 82 | This vs That 83 | 84 | this v. that 85 | This v. That 86 | 87 | this vs. that 88 | This vs. That 89 | 90 | The SEC's Apple probe: what you need to know 91 | The SEC's Apple Probe: What You Need to Know 92 | 93 | 'by the way, small word at the start but within quotes.' 94 | 'By the Way, Small Word at the Start but Within Quotes.' 95 | 96 | Small word at end is nothing to be afraid of 97 | Small Word at End Is Nothing to Be Afraid Of 98 | 99 | Starting sub-phrase with a small word: a trick, perhaps? 100 | Starting Sub-Phrase With a Small Word: A Trick, Perhaps? 101 | 102 | Sub-phrase with a small word in quotes: 'a trick, perhaps?' 103 | Sub-Phrase With a Small Word in Quotes: 'A Trick, Perhaps?' 104 | 105 | Sub-phrase with a small word in quotes: "a trick, perhaps?" 106 | Sub-Phrase With a Small Word in Quotes: "A Trick, Perhaps?" 107 | 108 | "Nothing to Be Afraid of?" 109 | "Nothing to Be Afraid Of?" 110 | 111 | a thing 112 | A Thing 113 | 114 | Dr. Strangelove (or: how I Learned to Stop Worrying and Love the Bomb) 115 | Dr. Strangelove (Or: How I Learned to Stop Worrying and Love the Bomb) 116 | 117 | this is trimming 118 | This Is Trimming 119 | 120 | this is trimming 121 | This Is Trimming 122 | 123 | this is trimming 124 | This Is Trimming 125 | 126 | IF IT’S ALL CAPS, FIX IT 127 | If It’s All Caps, Fix It 128 | 129 | ___if emphasized, keep that way___ 130 | ___If Emphasized, Keep That Way___ 131 | 132 | What could/should be done about slashes? 133 | What Could/Should Be Done About Slashes? 134 | 135 | Never touch paths like /var/run before/after /boot 136 | Never Touch Paths Like /var/run Before/After /boot 137 | 138 | There are 100's of buyer's guides 139 | There Are 100's of Buyer's Guides 140 | 141 | To-do: in-house en-Route BY-pass 142 | To-Do: In-House En-Route By-Pass 143 | -------------------------------------------------------------------------------- /titlecase: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | use 5.008001; use strict; use warnings; use utf8; 3 | 4 | our @SMALL_WORD 5 | = qw/ (? In-Flight 57 | s{ 58 | \b 59 | (? "Stand-In" (Stand is already capped at this point) 65 | s{ 66 | \b 67 | (? 1 ) ? \@str : $str[0]; 75 | } 76 | 77 | use open qw( :encoding(UTF-8) :std ); 78 | use Getopt::Std 'getopts'; 79 | 80 | getopts 'f', \my %opt; 81 | 82 | while ( readline ) { 83 | $_ = lc if $opt{'f'}; 84 | print titlecase( $_ ), "\n"; 85 | } 86 | --------------------------------------------------------------------------------