package Text::Table::Squish; use strict; use warnings; use Exporter; use vars qw( @EXPORT_OK %EXPORT_TAGS ); use subs qw( transpose squishtable ); BEGIN { *import = \&Exporter::import; @EXPORT_OK = qw( squishtable squishtable_emacs squishtable_sql squishtable_spaces squishtable_dwim ); %EXPORT_TAGS = ( all => \ @EXPORT_OK ); } use Algorithm::Loops qw( MapCarU Filter ); sub squishtable_dwim { # Attempts to squish on anything potentially reasonable. # 1 |22 |333 |4444 # . |.. |... |.... # . |.. |... |.... # . |.. |... |.... # . |.. |... |.... # . |.. |... |.... # . |.. |... |.... squishtable $_[0], "^([^\\w\r\n])\\1+[\r\n]+", "^ +[\r\n]+"; } sub squishtable_emacs { # Squishes emacs tables. # +---+---+---+ # | | | | # +---+---+---+ # | | | | # +---+---+---+ squishtable $_[0], "^\\+(?:\\|\\+)+[\r\n]+", "^-(?: -)+[\r\n]+"; } sub squishtable_sql { # 1 |22 |333 |4444 # . |.. |... |.... # . |.. |... |.... # . |.. |... |.... # . |.. |... |.... # . |.. |... |.... # . |.. |... |.... squishtable $_[0], "^\\|+[\r\n]+", "^ +[\r\n]+"; } sub squishtable_spaces { # Squishes to space delimited columns. Stuff that was printed in fixed width columns is also handled here. # 1 22 333 4444 # . .. ... .... # . .. ... .... # . .. ... .... # . .. ... .... # . .. ... .... # . .. ... .... squishtable $_[0], "^ +[\r\n]+", "^ +[\r\n]+", } my %CompiledPatterns; sub squishtable { # Removes extra trailing space at the end of columns in a # table. my ( $table, $column_separator, $empty_column ) = @_; if ( not( defined $column_separator and defined $empty_column ) ) { # If I was not given a spec to squish by, use dwimmery to get what I want. $column_separator = "^([^\\w\r\n])\\1+[\r\n]+"; $empty_column = "^ +[\r\n]+"; } # Compile and cache this pattern. my $pattern = "(?m)(?:$empty_column)+(?=$column_separator)"; $pattern = $CompiledPatterns{$pattern} || qr/$pattern/m; return transpose Filter { s/$pattern//mg } transpose $table; } sub transpose { my ( $table ) = @_; return join( '', map join( '', @$_ ) . "\n", MapCarU( sub { [@_] }, map( [ split // ], split( /[\r\n]+/, $table ) ) ) ); } 1; __END__ =head1 NAME =head1 DESCRIPTION =head1 SYNOPSIS =head1 FUNCTIONS =over 4 =item $table = squishtable( $table ) =item $table = squishtable_dwim( $table ) =item $table = squishtable_spaces( $table ) =item $table = squishtable_sql( $table ) =item $table = squishtable_emacs( $table ) =item $table = squishtable( $table, $column_separator, $empty_column ) =back =cut