File Coverage

blib/lib/Lingua/ManagementSpeak.pm

Criterion	Covered	Total	%
statement	122	123	99.1
branch	44	46	95.6
condition	31	36	86.1
subroutine	16	16	100.0
pod	11	11	100.0
total	224	232	96.5

package Lingua::ManagementSpeak;
# ABSTRACT: Tool to generate managerial-sounding text and full documents

use 5.008;
use strict;
use warnings;

our $VERSION = '1.04'; # VERSION

sub new {
    my $self = shift;
    return bless( {
        pronouns      => [ qw( I we they ) ],
        articles      => [ qw( the your my our its ) ],
        conj_adverbs  => [ qw( however moreover nevertheless consequently ) ],
        conjuntors    => [ 'though', 'although', 'notwithstanding that', 'yet', 'still' ],
        sub_conjuncs  => [
            'after', 'although', 'as', 'as if', 'as long as', 'as though', 'because',
            'before', 'even if', 'even though', 'if', 'if only', 'in order that',
            'now that', 'once', 'since', 'so that', 'though',
            'unless', 'until', 'when', 'whenever', 'where', 'whereas', 'wherever',
            'while'
        ],
        power_words => [ qw(
            accomplished dealt implemented projected achieved debated improved
            promoted acquired decided included proofed adjusted defined increased
            purchased administered delegated indicated qualified advised delivered
            initiated questioned analyzed demonstrated inspected rated applied
            designed instructed received appraised determined insured recognized
            arranged developed interpreted recommended assessed devised interviewed
            recorded assisted directed introduced recruited assured discovered
            investigated reduced awarded dispensed joined rehabilitated bought
            displayed kept related briefed distributed launched renovated brought
            earned led repaired budgeted edited located reported calculated educated
            maintained represented cataloged elected managed researched chaired
            encouraged maximized reviewed changed enlisted measured revised
            classified ensured mediated selected closed entertained modified served
            coached established motivated simplified combined evaluated named
            sketched communicated examined negotiated sold compared excelled
            observed solved completed executed obtained spearheaded computed
            exhibited operated specified conceived expanded ordered started
            concluded expedited organized streamlined conducted explained paid
            strengthened confronted facilitated participated studied constructed
            financed perceived suggested continued forecast performed summarized
            contracted formulated persuaded supervised controlled gained placed
            targeted convinced gathered planned taught coordinated graded predicted
            tested corrected greeted prepared trained corresponded guided presented
            translated counseled handled processed treated created helped produced
            updated critiqued identified programmed wrote
        ) ],
        verbs => [ qw(
            aggregate architect benchmark brand cultivate deliver deploy
            disintermediate drive e-enable embrace empower enable engage engineer
            enhance envision evolve expedite exploit extend facilitate generate grow
            implement incentivize incubate innovate integrate iterate
            leverage maximize mesh monetize morph optimize orchestrate
            recontextualize reintermediate reinvent repurpose revolutionize scale
            seize strategize streamline syndicate synergize synthesize target
            transform transition unleash utilize visualize whiteboard
        ) ],
        aux_verbs => [
            'will', 'shall', 'may', 'might', 'can', 'could', 'must',
            'ought to', 'should', 'would', 'need to'
        ],
        adjectives => [ qw (
            24/365 24/7 B2B B2C back-end best-of-breed bleeding-edge
            bricks-and-click clicks-and-mortar collaborative compelling
            cross-platform cross-media customized cutting-edge
            distributed dot-com dynamic e-business efficient
            end-to-end enterprise extensible frictionless front-end
            global granular holistic impactful innovative integrated interactive
            intuitive killer leading-edge magnetic mission-critical next-generation
            one-to-one open-source out-of-the-box plug-and-play proactive real-time
            revolutionary robust scalable seamless sexy sticky strategic synergistic
            transparent turn-key ubiquitous user-centric value-added vertical
            viral virtual visionary web-enabled wireless world-class
        )],
        nouns => [ qw(
            action-item application architecture bandwidth channel community
            content convergence deliverable e-business e-commerce e-market
            e-service e-tailer experiences functionality infomediary
            infrastructure initiative interface market methodology metric
            mindshare model network niche paradigm partnership platform
            portal relationship ROI synergy web-readiness schema solution
            supply-chain system technology user
        ) ],
        nounss => [ qw(
            action-items applications architectures channels communities
            convergences deliverables e-businesses e-commerces e-markets
            e-services e-tailers experiences eyeballs functionalities infomediaries
            infrastructures initiatives interfaces markets methodologies metrics
            models networks niches paradigms partnerships platforms
            portals relationships synergies schemas solutions
            supply-chains systems technologies users vortals
        ) ],
    }, ref($self) || $self );
}

sub _random {
    my $high = shift || 5;
    my $low  = shift || 1;
    return int( rand( $high - $low + 1 ) ) + $low;
}

sub words {
    my ( $self, $meta ) = @_;

    # deal with "maybe_n/n_word" meta words
    while ( $meta =~ /maybe[_-](\d+)\/(\d+)[_-](\w+)\S*/ ) {
        my $word = ( _random( $2, $1 ) == $1 ) ? $3 : '';
        if ($word) {
            $meta =~ s/maybe[_-]\d+\/\d+[_-]\w+(\S*)/$word$1/;
        }
        else {
            $meta =~ s/maybe[_-]\d+\/\d+[_-]\w+\S*\s*//;
        }
    }

    # convert "phrase" into phrase meta words
    $meta =~ s/(\w)\s+phrase/$1, phrase/g;
    $meta =~ s/phrase/conjuntor article noun to_be power_word/g;

    while ( $meta =~ /(
        pronoun|article|sub_conjuc|power_word|verb|aux_verb|
        adjective|noun|conj_adverb|conjuntor|sub_conjunc|adverb
    )/x ) {
        # if the word is an adverb, we have to pick a verb and add "ing" to it
        my ( $t1, $t2 ) = ( $1, $1 );
        $t2 = 'verb' if ( $t1 eq 'adverb' );
        my $word = $self->{ $t2 . 's' }[ _random( $#{ $self->{ $t2 . 's' } }, 0 ) ];
        $word =~ s/[e]*$/ing/ if ( $t1 eq 'adverb' );
        $meta =~ s/$t1/$word/;
    }

    # convert "to_be" into the proper conjugated form
    while ( $meta =~ /\b(\w+)\s+to_be/ ) {
        if ( $1 =~ /ess$/ ) {
            $meta =~ s/to_be/is/;
        }
        elsif ( $1 =~ /s$/ ) {
            $meta =~ s/to_be/are/;
        }
        else {
            $meta =~ s/to_be/is/;
        }
    }

    $meta =~ s/^\s+|\s+$//;
    $meta =~ s/\b(a)(\s[aeiouy])/$1n$2/i;

    return $meta;
}

sub sentence {
    my ( $self, $is_first ) = @_;

    my @meta = (
        'article noun to_be power_word sub_conjunc pronoun verb ' .
            'article maybe_1/2_adjective noun maybe_1/3_phrase',
        'sub_conjunc pronoun power_word article maybe_1/2_adjective ' .
            'noun, article maybe_1/2_adjective noun power_word article ' .
            'maybe_1/2_adjective noun maybe_1/4_phrase',
        'pronoun aux_verb verb article maybe_1/2_adjective noun ' .
            'sub_conjunc article adjective noun aux_verb verb article ' .
            'maybe_1/2_adjective noun maybe_1/5_phrase',
        'sub_conjunc pronoun verb article maybe_1/2_adjective noun, ' .
            'pronoun can verb article ' .
            'maybe_1/2_adjective noun maybe_1/4_phrase',
        'pronoun aux_verb verb article maybe_1/2_adjective noun ' .
            'sub_conjunc pronoun verb article ' .
            'maybe_1/2_adjective noun maybe_1/5_phrase',
        'article noun verbs adjective noun',
        'article noun to_be a adjective noun, sub_conjunc article noun verbs article noun',
    );

    my $meta = $meta[ _random( 6, 0 ) ];
    $meta = 'maybe_1/4_conj_adverb, ' . $meta if ( not $is_first );

    return ucfirst( $self->words($meta) ) . '.';
}

sub paragraph {
    my ( $self, $low, $high ) = @_;
    my $count = 0;
    if ( not defined $low ) {
        $count = _random( 7, 4 );
    }
    elsif ( not defined $high ) {
        $count = $low;
    }
    else {
        $count = _random( $high, $low );
    }
    $count--;
    return join( ' ', $self->sentence(1), map { $self->sentence } ( 1 .. $count ) );
}

sub paragraphs {
    my $self = shift;
    my $count = shift || 2;
    my ( $low, $high ) = @_;
    return map { $self->paragraph( $low, $high ) } ( 1 .. $count );
}

sub bullets {
    my ( $self, $meta ) = ( shift, '' );
    my $count = shift || 5;

    my @bullet_forms = (
        'power_word article adjective noun',
        'power_word adjective noun',
        'power_word adjective noun and power_word adjective noun',
        'power_word article noun power_word by article noun',
    );

    return map { ucfirst $self->words( $bullet_forms[ _random( @bullet_forms - 1, 0 ) ] ) } ( 1 .. $count );
}

sub body {
    my ( $self, $params ) = @_;

    $params->{p_min}  = 1  if ( not exists $params->{p_min}  );
    $params->{p_max}  = 3  if ( not exists $params->{p_max}  );
    $params->{b_freq} = 25 if ( not exists $params->{b_freq} );
    $params->{b_min}  = 3  if ( not exists $params->{b_min}  );
    $params->{b_max}  = 6  if ( not exists $params->{b_max}  );

    my @data = ();
    my $p_count = _random( $params->{p_max}, $params->{p_min} );

    foreach ( 1 .. $p_count ) {
        push @data, {
            type => 'paragraph',
            text => $self->paragraphs (1, $params->{p_s_min}, $params->{p_s_max} ),
        };

        # a bulletted list should never be first in a body block
        if (
            ( $_ != $p_count ) and
            ( _random(100, 1 ) < $params->{b_freq} )
        ) {
            my $type = _random( 4, 1 );
            push @data, {
                type => 'bullet',
                text => $self->bullets( 1, $type )
            } foreach ( 1 .. _random( $params->{b_max}, $params->{b_min} ) );
        }
    }

    return \@data;
}

sub header {
    my ( $self, $level ) = @_;

    my $meta = [
        [
            'noun and noun',
            'noun',
            'article noun',
        ],
        'power_word noun',
        'adverb power_word noun',
        'adverb power_word adjective noun',
        'power_word adjective noun adverb noun',
    ];

    $meta = $meta->[ $level - 1 ] if ($level);
    $meta = $meta->[ _random( @$meta - 1, 0 ) ] while ( ref($meta) );

    # capitalize every word with the exception of: of, and, or
    return join( ' ', map {
        join( '-', map { ( $_ !~ /^(of|and|or)$/ ) ? ucfirst : $_ } split('-') )
    } split( ' ', $self->words($meta) ) );
}

sub structure {
    my ( $self, $depth, $last_push ) = ( shift, 1, 0 );
    my $block_limit = shift || 3;
    my $depth_limit = shift || 3;
    my $mimimum_length = shift || 10;
    my @structure = ();

    my $structure;
    $structure = sub {
        my $block = 0;
        while (
            ( $block < _random( $block_limit, 1 ) ) and
            ( ( _random( 4, 1 ) > 1 ) or ( $last_push ne $depth ) )
            # 1/4 chance of exiting early
        ) {
            push( @structure, $depth );
            my $last_push = $depth;
            $block++;
            if (
                ( $depth < $depth_limit ) and
                ( _random( 5, 1 ) > 1 )
                # 1/5 chance of not nesting
            ) {
                $depth++;
                $structure->();
            }
        }
        $depth--;
    };

    while ( @structure < $mimimum_length ) {
        ( $last_push, $depth ) = ( 0, 1 );
        $structure->();
    }
    return @structure;
}

sub document {
    my $self = shift;
    my $structure = shift || [ $self->structure ];
    my $params = shift || undef;

    return [ map {
        {
            type => 'header' . $_,
            text => $self->header($_)
        }, @{ $self->body($params) }
    } ( @{$structure} ) ];
}

sub to_html {
    my ( $self, $data ) = @_;
    my ( $inside_list, $output ) = ( 0, '' );

    for ( @{$data} ) {
        if ( ( $_->{type} ne 'bullet' ) and ($inside_list) ) {
            $inside_list = 0;
            $output .= "\n";
        }

        if ( $_->{type} =~ /header(\d+)/ ) {
            $output .= '' . $_->{text} . '\n";
        }
        elsif ( $_->{type} eq 'paragraph' ) {
            $output .= '' . $_->{text} . "\n";
        }
        elsif ( $_->{type} eq 'bullet' ) {
            my $ul = (not $inside_list) ? "\n" : '';
            $inside_list++;
            $output .= $ul . '' . $_->{text} . "\n";
        }
        else {
            $output .= '' . $_->{text} . "\n";
        }
    }

    return $output;
}

1;

__END__