Subversion Repositories OpenARM Single-board Computer

# Text::Aligner - Align text in columns

package Text::Aligner;

use strict;

use warnings;

BEGIN    {

    use Exporter ();

    use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

    $VERSION     = 0.03;

    @ISA         = qw (Exporter);

    #Give a hoot don't pollute, do not export more than needed by default

    @EXPORT      = qw ();

    @EXPORT_OK   = qw ( align);

    %EXPORT_TAGS = ();

}

# this is a non-method, and currently the only user interface

sub align ($@) {

    my $ali = Text::Aligner->new( shift);

    $ali->alloc( map ref eq 'SCALAR' ? $$_ : $_, @_);

    if ( defined wantarray ) {

        my @just = map $ali->justify( ref eq 'SCALAR' ? $$_ : $_), @_;

        return @just if wantarray;

        return join "\n", @just, '';

    } else {

        for ( @_ ) {

            $_ = $ali->justify( $_) for ref eq 'SCALAR' ? $$_ : $_; # one-shot

        }

    }

}

### class Text::Aligner

sub _new { # internal creator

    my $class = shift;

    my ( $width, $pos) = @_; # both method-or-coderef (this is very general)

    bless {

        width => $width,

        pos => $pos,

        left => Text::Aligner::MaxKeeper->new,

        right => Text::Aligner::MaxKeeper->new,

    }, $class;

}

# create an aligner

sub new {

    my ( $class, $spec) = @_;

    $spec ||= 0; # left alignment is default

    my $al;

    if ( !ref( $spec) and $spec =~ s/^auto/num/ ) {

        $al = Text::Aligner::Auto->_new( $spec);

    } else {

        $al = $class->_new( _compile_alispec( $spec));

    }

    $al;

}

# return left and right field widths for an object

sub _measure0 {

    my $al = shift;

    my $obj = shift;

    $obj = '' unless defined $obj;

    my ( $w, $p);

    if ( ref $obj ) {

        ( $w, $p) = ( $obj->$al->{ width}->(), $obj->$al->{ pos}->() );

    } else {

        ( $w, $p) = ( $al->{ width}->( $obj), $al->{ pos}->( $obj) );

    }

    $_ ||= 0 for $w, $p;

    ( $p, $w - $p);

}

# return left and right field widths for an object

sub _measure {

    my $al = shift;

    my $obj = shift;

    $obj = '' unless defined $obj;

    my ( $wmeth, $pmeth) = @{ $al}{ qw( width pos)};

    my $w = ref $wmeth ? $wmeth->( $obj) : $obj->$wmeth;

    my $p = ref $pmeth ? $pmeth->( $obj) : $obj->$pmeth;

    $_ ||= 0 for $w, $p;

    ( $p, $w - $p);

}

# return left and rigth maxima, or nothing if the aligner is empty

sub _status {

    my @lr = ( $_[ 0]->{ left}->max, $_[ 0]->{ right}->max);

    # $l and $r should be both defined or undefined, unless the

    # MaxKeeper memory is corrupted by forgetting unremembered things.

    return unless defined( $lr[ 0]) and defined( $lr[ 1]);

    @lr;

}

# remember alignment requirements

sub alloc {

    my $al = shift;

    for ( @_ ) {

#       $_ ||= ''; print "allocing '$_'\n";

        my ( $l, $r) = $al->_measure( $_);

        $al->{ left}->remember( $l); # space needed left of pos

        $al->{ right}->remember( $r); # ...and right of pos

    }

    $al;

}

# release alignment requirement.  it disturbs an aligner deeply to forget

# things it hasn't remembered.  the effects may be delayed.

sub _forget {

    my $al = shift;

    for ( map defined() ? $_ : '', @_ ) {

#       print "forgetting '$_'\n";

        my ( $l, $r) = $al->_measure( $_);

        $al->{ left}->forget( $l);

        $al->{ right}->forget( $r);

    }

    $al;

}

# justify a string.  a string is aligned within the aligner's field, and

# filled with blanks or cut to size, as appropriate.  a string that has

# been allocated will never be trimmed (that is the point of allocation).

# if the aligner is empty it returns the string unaltered.

sub justify {

    my $al = shift;

    my $str  = shift;

#   print "justifying '$str'\n";

    $str .= ''; # stringify (objects, numbers, undef)

    my ( $l_pad, $r_pad) = $al->_padding( $str);

    substr( $str, 0, -$l_pad) = '' if $l_pad < 0; # trim if negative

    substr( $str, $r_pad) = '' if $r_pad < 0; # ... both ends

    join $str, ' ' x $l_pad, ' ' x $r_pad; # pad if positive

}

# return two numbers that indicate how many blanks are needed on each side

# of a string to justify it.  Negative values mean trim that many characters.

# an empty aligner returns ( 0, 0), so doesn't change anything.

sub _padding {

    my $al = shift;

    my $str = shift;

    my ( $this_l, $this_r) = $al->_measure( $str);

    my ( $l_pad, $r_pad) = ( 0, 0);

    if ( $al->_status ) {

        ( $l_pad, $r_pad) = $al->_status;

        $l_pad -= $this_l;

        $r_pad -= $this_r;

    }

    ( $l_pad, $r_pad);

}

# _compile_alispec() returns positioners according to specification.  In

# effect, it is is the interpreter for alignment specifications.

sub _compile_alispec { # it's a dirty job...

    my $width = sub { length shift }; # this is always so for string aligners

    my $pos; # the positioner we actually compile

    local $_ = shift || ''; # alignment specification

    if ( ref() eq 'Regexp' ) {

        my $regex = $_; # lexical copy!

        $pos = sub {

            local $_ = shift;

            m/$regex/ ? $-[ 0] : length; # assume match after string

        };

    } else {

        s/^left/0/;

        s/^center/0.5/;

        s/^right/1/;

        if ( _is_number( $_) ) {

            my $proportion = $_; # use lexical copy

            $pos = sub { int( $proportion*length shift) };

        } elsif ( $_ =~ /^(?:num|point)(?:\((.*))?/ ) {

            my $point = defined $1 ? $1 : '';

            $point =~ s/\)$//; # ignore trailing paren, if present

            length $point or $point = '.';

            $pos = sub { index( shift() . $point, $point) }

        } else {

            $pos = sub { 0 };

        }

    }

    ( $width, $pos);

}

# decide if a string is a number. (see perlfaq4).  This needs to become

# more flexible for auto-alignment

sub _is_number { defined( $_[ 0]) and $_[ 0] =~ /^-?\d+\.?\d*$/ }

package Text::Aligner::Auto;

# Combined numeric and left alignment.  Numbers are aligned numerically,

# other strings are left-aligned.  The resulting columns are interleaved

# flush left and filled on the right if necessary.

sub _new { # only called by Text::Aligner->new()

    my $class = shift;

    my $numspec = shift; # currently ignored

    bless {

        num => Text::Aligner->new( 'num'),    # align numbers among themselves

        other => Text::Aligner->new,          # left-align anything else

    }, $class;

}

sub alloc {

    my $aa = shift;

    my @num = grep _is_number( $_), @_;

    my @other = grep !_is_number( $_), @_;

    $aa->{ num}->alloc( @num);

    $aa->{ other}->alloc( @other);

    $aa;

}

sub _forget {

    my $aa = shift;

    $aa->{ num}->_forget( grep _is_number( $_), @_);

    $aa->{ other}->_forget( grep !_is_number( $_), @_);

    $aa;

}

# justify as required

sub justify {

    my ( $aa, $str) = @_;

    # align according to type

    $str = $aa->{ _is_number( $str) ? 'num' : 'other'}->justify( $str);

    my $combi = Text::Aligner->new; # left-justify pre-aligned string

    # initialise to size of partial aligners.  (don't initialise from

    # empty aligner)

    $combi->alloc( $aa->{ num}->justify( '')) if $aa->{ num}->_status;

    $combi->alloc( $aa->{ other}->justify( '')) if $aa->{ other}->_status;

    $combi->justify( $str);

}

# for convenience

BEGIN { # import _is_number()

    *_is_number = \ &Text::Aligner::_is_number;

}

package Text::Aligner::MaxKeeper;

# Keep the maximum of a dynamic set of numbers.  Optimized for the case of

# a relatively small range of numbers that may occur repeatedly.

sub new {

    bless {

        max => undef,

        seen => {},

    }, shift;

}

sub max { $_[ 0]->{ max} }

sub remember {

    my ( $mk, $val) = @_;

    _to_max( $mk->{ max}, $val);

    $mk->{ seen}->{ $val}++;

    $mk;

}

sub forget {

    my ( $mk, $val) = @_;

    if ( exists $mk->{ seen}->{ $val} ) {

        my $seen = $mk->{ seen};

        unless ( --$seen->{ $val} ) {

            delete $seen->{ $val};

            if ( $mk->{ max} == $val ) {

                # lost the maximum, recalculate

                undef $mk->{ max};

                _to_max( $mk->{ max}, keys %$seen);

            }

        }

    }

    $mk;

}

sub _to_max {

    my $var = \ shift;

    defined $_ and ( not defined $$var or $$var < $_) and $$var = $_ for @_;

    $$var;

}

########################################### main pod documentation begin ##

=head1 NAME

Text::Aligner

=head1 SYNOPSIS

  use Text::Aligner qw( align);

  # Print the words "just a test!" right-justified each on a line:

  my @lines = align( 'right', qw( just a test!);

  print "$_\n" for @lines;

=head1 DESCRIPTION

Text::Aligner exports a single function, align(), which is

used to justify strings to various alignment styles.  The

alignment specification is the first argument, followed by

any number of scalars which are subject to alignment.

The operation depends on context.  In list context, a list of

the justified scalars is returned.  In scalar context, the

justified arguments are joined into a single string with newlines

appended.  The original arguments remain unchanged.  In void

context, in-place justification is attempted.  In this case, all

arguments must be lvalues.

Align() also does one level of scalar dereferencing.  That is,

whenever one of the arguments is a scalar reference, the scalar

pointed to is aligned instead.  Other references are simply stringified.

An undefined argument is interpreted as an empty string without

complaint.

=head1 ALIGNMENT

The first argument of the align() function is an alignment style, a

single scalar.

It can be one of the strings "left", "right", "center", "num", "point",

or "auto", or a regular expression (qr/.../), or a coderef.

A default style of "left" is assumed for every other value, including

"" and undef.

"left", "right" and "center" have the obvious meanings.  These can

also be given as numbers 0, 1, and 0.5 respectively. (Other numbers

are also possible, but probably not very useful).

"num", and its synonym "point", specify that the decimal points be

aligned (assumed on the right, unless present).  Arbitrary (non-numeric)

strings are also aligned in this manner, so they end up one column left

of the (possibly assumed) decimal point, flush right with any integers.

For the occasional string like "inf", or "-" for missing values, this

may be the right place.  A string-only column ends up right-aligned

(unless there are points present).

The "auto" style seperates numeric strings (that are composed of

"-", ".", and digits in the usual manner) and aligns them numerically.

Other strings are left aligned with the number that sticks out

farthest to the left.  This gives left alignment for string-only

columns and numeric alignment for columns of numbers.  In mixed

columns, strings are reasonably placed to serve as column headings

or intermediate titles.

With "num" (and "point") it is possible to specify another character

for the decimal point in the form "num(,)".  In fact, you can specify

any string after a leading "(", and the closing ")" is optional.

"point(=>)" could be used to align certain pieces of Perl code.  This

option is currently not available with "auto" alignment (because

recognition of numbers is Anglo-centric).

If a regular expression is specified, the points are aligned where

the first match of the regex starts.  A match is assumed immediately

after the string if it doesn't match.

A regular expression is a powerful way of alignment specification.  It

can replace most others easily, except center alignment and, of course,

the double action of "auto".

=head1 POSITIONERS

For entirely self-defined forms of alignment, a coderef, also known

as a positioner, can be given instead of an alignment style.  This

code will be called once or more times with the string to be aligned

as its argument.  It must return two numbers, a width and a position,

that describe how to align a string with other strings.

The width should normally be the length of the string.  The position

defines a point relative to the beginning of the string, which is

aligned with the positions given for other strings.

A zero position for all strings results in left alignment, positioning

to the end of the string results in right alignment, and returning

half the length gives center alignment.  "num" alignment is realized

by marking the position of the decimal point.

Note that the position you return is a relative measure.  Adding a

constant value to all positions results in no change in alignment.

It doesn't have to point inside the string (as in right alignment,

where it points one character past the end of the string).

The first return value of a positioner should almost always be the

length of the given string.  It may be useful to ly about the string

length if the string contains escape sequences that occupy no place

on screen.

=head1 USAGE

  use Text::Aligner qw( align);

  align( $style, $str, ...);

  $style must be given and must be an alignment specification.

  Any number of scalars can follow.  An argument that contains a

  scalar reference is dereferenced before it is used.  In scalar

  and list context, the aligned strings are returned.  In void

  context, the values are aligned in place and must be lvalues.

=head1 BUGS

  None known as of realease, but...

=head1 AUTHOR

    Anno Siegel

    CPAN ID: ANNO

    siegel@zrz.tu-berlin.de

    http://www.tu-berlin.de/~siegel

=head1 COPYRIGHT

Copyright (c) 2002 Anno Siegel. All rights reserved.

This program is free software; you can redistribute

it and/or modify it under the same terms as Perl itself.

The full text of the license can be found in the

LICENSE file included with this module.

=head1 SEE ALSO

perl(1)

Text::Table

=cut

1; #this line is important and will help the module return a true value

__END__