http://qs1969.pair.com?node_id=47569

   1: package SuperSplit;
   2: use strict;
   3: 
   4: =head1 NAME
   5: 
   6: SuperSplit - Provides methods to split/join in two dimensions
   7: 
   8: =head1 SYNOPSIS
   9:  use SuperSplit;
  10:  
  11:  #first example: split on newlines and whitespace and print
  12:  #the same data joined on tabs and whitespace. The split works on STDIN
  13:  #
  14:  print superjoin( supersplit() );
  15:  
  16:  #second: split a table in a text file, and join it to HTML
  17:  #
  18:  my $array2D   = supersplit( \*INPUT )  #filehandle must be open
  19:  my $htmltable = superjoin( '</TD><TD>', "</TD></TR>\n  <TR><TD>", 
  20:                                  $array2D );
  21:  $htmltable    = "<TABLE>\n  <TR><TD>" . $htmltable . "</TD></TR>\n</TABLE>";
  22:  print $htmltable;
  23:  
  24:  #third: perl allows you to have varying number of columns in a row,
  25:  # so don't stop with simple tables. To split a piece of text into 
  26:  # paragraphs, than words, try this:
  27:  #
  28:  undef $/;
  29:  $_ = <>;
  30:  tr/.!();:?/ /; #remove punctiation
  31:  my $array = supersplit( '\s+', '\n\s*\n', $_ );
  32:  # now you can do something nifty as counting the number of words in each
  33:  # paragraph
  34:  my @numwords = (); my $i=0;
  35:  for my $rowref (@$array) {
  36:     push( @numwords, scalar(@$rowref) );  #2D-array: array of refs!
  37:     print "Found $numwords[$i] \twords in paragraph \t$i\n";
  38:     $i++;
  39:  }
  40: 
  41: =head1 DESCRIPTION
  42: 
  43: Supersplit is just a consequence of the possibility to use 2D arrays in 
  44: perl. Because this is possible, one also wants a way to conveniently split 
  45: data into a 2D-array (at least I want to). And vice versa, of course. 
  46: Supersplit/join just do that. 
  47: 
  48: Because I intend to use these methods in numerous one-liners and in my 
  49: collection of handy filters, an object interface is more often than not 
  50: cumbersome.  So, this module exports two methods, but it's also all it has.  
  51: If you think modules shouldn't do that, period, use the object interface, 
  52: SuperSplit::Obj. TIMTOWTDI
  53: 
  54: =over 4
  55: 
  56: =item supersplit($colseparator,$rowseparator,$filehandleref || $string);
  57: 
  58: The first method, supersplit, returns a 2D-array.  To do that, it needs data
  59: and the strings to split with.  Data may be provided as a reference to a
  60: filehandle, or as a string.  If you want use a string for the data, you MUST
  61: provide the strings to split with (3 argument mode).  If you don't provide
  62: data, supersplit works on STDIN. If you provide a filehandle (a ref to it,
  63: anyway), supersplit doesn't need the splitting strings, and assumes columns
  64: are separated by whitespace, and rows are separated by newlines.  Strings
  65: are passed directly to split.
  66: 
  67: Supersplit returns a 2D-array or undef if an error occurred. 
  68:  
  69: =item superjoin( $colseparator, $rowseparator, $array2D );
  70: 
  71: The second and last method, superjoin, takes a 2D-array and returns it as a 
  72: string. In the string, columns (adjacent cells) are separated by the first 
  73: argument provided. Rows (normally lines) are separated by the second 
  74: argument. Alternatively, you may give the 2D-array as the only argument. 
  75: In that case, superjoin joins columns with a tab ("\t"), and rows with a 
  76: newline ("\n"). 
  77: 
  78: Superjoin returns an undef if an error occurred, for example if you give a 
  79: ref to an hash. If your first dimension points to hashes, the interpreter
  80: will give an error (use strict).
  81: 
  82: =back
  83: 
  84: 
  85: 
  86: =head1 AUTHOR
  87: 
  88: J. Elassaiss-Schaap
  89: 
  90: =head1 LICENSE
  91: 
  92: Perl/ artisitic license
  93: 
  94: =head1 STATUS
  95: 
  96: Alpha
  97: 
  98: =cut
  99: 
 100: BEGIN{
 101:    use Exporter;
 102:    use vars qw( @EXPORT @ISA @VERSION);
 103:    @VERSION = 0.01;
 104:    @ISA = qw( Exporter );
 105:    @EXPORT = qw( &supersplit &superjoin );
 106: }
 107: 
 108: sub supersplit{
 109:         my $handleref = pop || \*STDIN;
 110:         unless (ref($handleref) =~ /GLOB/){
 111:            push(@_, $handleref);
 112:            undef $handleref;
 113:         }
 114:         my $second = $_[0] || '\s+';
 115:         my $first = $_[1] || '\n';
 116:         $handleref || (my $text = $_[2]);
 117:         my $index = 0;
 118:         my $arrayref = [[]] ; 
 119:         local $/;
 120:         undef $/;
 121:         $text = <$handleref> if( ref($handleref) );
 122:         my @lines = split( $first, $text );
 123:         for (@lines){
 124:             $arrayref->[$index] = [ (split($second) || $_)];
 125:             $index++;
 126:         }
 127:         return $arrayref;
 128: }
 129: 
 130: sub superjoin{
 131:         my $array = pop || return undef;
 132:         my $first = shift || "\t";
 133:         my $second = shift || "\n";
 134:         my $text = '';
 135:         return undef unless( ref($array) eq 'ARRAY' );
 136:         return undef unless( ref($array->[0]) =~ /ARRAY|HASH/ );
 137:         my $arrayarray = [];
 138:         for $arrayarray (@$array) {
 139:                 $text .= join( $first, @$arrayarray );
 140:                 $text .= $second;
 141:         }
 142:         return $text;
 143: }
 144: 
 145: 1;