Text::Beautify - Beautifies text


Text-Beautify documentation Contained in the Text-Beautify distribution.

Index


Code Index:

NAME

Top

Text::Beautify - Beautifies text

SYNOPSIS

Top

  use Text::Beautify;

  $text = "badly written text ,,you know ?"

  $new_text = beautify($text);
  # $new_text now holds "Badly written text, you know?"

  # or

  $text = Text::Beautify->new("badly written text ,,you know ?");
  $new_text = $text->beautify;

  # and also

  enable_feature('repeated_punctuation'); # enables the feature
  disable_feature('trailing_space');      # disables the feature

  @features_enables = enabled_features();

  @all_features = features();

  enable_all();
  disable_all();

DESCRIPTION

Top

Beautifies text. This involves operations like squeezing double spaces, removing spaces from the beginning and end of lines, upper casing the first character in a string, etc.

You can enable / disable features with enable_feature / disable_feature. These commands return a true value if they are successful.

To know which features are beautified, see FEATURES

FEATURES

Top

All features are enabled by default

* heading_space
        Removes heading spaces

* trailing_space
        Removes trailing spaces

* double_spaces
        Squeezes double spaces

* repeated_punctuation
        Squeezes repeated punctuation

* space_in_front_of_punctuation
        Removes spaces in front of punctuation

* space_after_punctuation
        Puts a spaces after punctuation

* uppercase_first
        Uppercases the first character in the string

METHODS

Top

new

Creates a new Text::Beautify object

beautify

Applies all the enabled features

enabled_features

Returns a list with the enabled features

features

Returns a list containing all the features

enable_feature

Enables a feature

disable_feature

Disables a feature

enable_all

Enables all features

disable_all

Disables all features

TO DO

Top

* Allow the user to select the order in which features are applied
* Allow creation of new features

AUTHOR

Top

Jose Castro, <cog@cpan.org>

COPYRIGHT & LICENSE

Top


Text-Beautify documentation Contained in the Text-Beautify distribution.
package Text::Beautify;

use 5.006;
use strict;
use warnings;

require Exporter;

our @ISA = qw(Exporter);

our %EXPORT_TAGS = ( 'all' => [ qw(
        beautify enable_feature disable_feature features enabled_features
        enable_all disable_all
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw();

our $VERSION = '0.08';

my $debug = 0;
my (%features,@features,%status);

BEGIN {
  my $empt = '\'\'';
  %features = (
    heading_space                 => [[qr/^ +/                    , $empt    ]],
    trailing_space                => [[qr/ +$/                    , $empt    ]],
    space_in_front_of_punctuation => [[qr/ +(?=[,!?]|[:;](?![-)(]))/,$empt   ]],
    double_spaces                 => [[qr/  +/                    , '\' \''  ]],
    repeated_punctuation          => [[qr/([;:,!?])(?=\1)/        , $empt    ],
                                      [qr/\.{3,}/                 , '\'...\''],
                                      [qr/(?<!\.)\.\.(?!\.)/      , '\'.\''  ]],

    space_after_punctuation       =>[[qr/([;:,!?])(?=[[:alnum:]])/, '"$1 "'  ]],
    uppercase_first               => [[qr/([.!?]+\s*[a-z])/i      , 'uc($1)' ],
                                      [qr/^(\s*[[:alnum:]])/      , 'uc($1)' ],
                                      [qr/(?<=[!?] )([a-z])/      , 'uc($1)' ],
                                      [qr/(?<=[^.]\. )([a-z])/    , 'uc($1)' ]],
  );

  @features = qw(
    heading_space
    trailing_space
    double_spaces
    repeated_punctuation
    space_in_front_of_punctuation
    space_after_punctuation
    uppercase_first
  );

  %status = map { ( $_ , 1 ) } @features; # all features enabled by default
}

sub new {
  my ($self,@text) = @_;
  bless \@text, 'Text::Beautify';
}

sub beautify {

  my @text;
  if (ref($_[0]) eq 'Text::Beautify') {
    my $self = shift;
    @text = @$self;
  }
  else {
    @text = wantarray ? @_ : $_[0];
  }

  for (join "\n", @text) {

    for my $feature (@features) {
      next unless $status{$feature};
      my ($str,$end) = ('','');
      ($str,$end) = ("<$feature>","</$feature>") if $debug;

      for my $f (@{$features{$feature}}) {
        s/$$f[0]/$str . (eval $$f[1]) . $end/ge;
      }
    }

    return $_;
  }

}

sub enabled_features { grep $status{$_}, keys %features; }

sub features         { keys %features; }

sub enable_feature   { _auto_feature(1,@_); }

sub disable_feature  { _auto_feature(0,@_); }

sub enable_all       { _auto_feature(1,features()) }

sub disable_all      { _auto_feature(0,features()) }

sub _auto_feature {
  my $newstatus = shift;
  for (@_) { defined $features{$_} || return undef; }
  for (@_) { $status{$_} = $newstatus; }
  1
}

1;
__END__