Category: | Utility Scripts |
Author/Contact Info | Corion |
Description: | I often have to split up text files for consumption in Excel. A convenient way of splitting up a file meaningfully is to split it up by the value of a column. The program does this by accumulating the input into a hash of arrays keyed by the column value. There is an awk oneliner (I'm told) that circumvents the memory limitations this program encounters:
If you want something like this program in a module, see List::Part Update: Also see join - join two files according to a common key. If you need one, you'll likely need the other too. Update: v0.03 now can part according to more than one column. Update: v0.04 now can output multiple header lines into every file. Update: v0.06 fixes two errors: The column at the end of each line couldn't be used (well) as the key column. Header lines are now actually printed. Update: Now there also is a Github repository for the case that you want to submit a patch. Update: The code is now also on CPAN as App::part. |
#!/usr/bin/perl -w
use strict;
use Getopt::Long;
use vars qw($VERSION);
$VERSION = '0.06';
# Try to load Pod::Usage and install a fallback if it doesn't exist
eval {
require Pod::Usage;
Pod::Usage->import();
1;
} or do {
*pod2usage = sub {
die "Error in command line.\n";
};
};
=head1 NAME
part - split up a single input file into multiple files according to a
+ column value
=head1 SYNOPSIS
part FILES
=head1 OPTIONS
=item B<--out> - set the output template
If the output template is not given it is guessed from
the name of the first input file or set to C<part-%s.txt>.
The C<%s> will be replaced by the column value.
=item B<--column> - set the column to part on
This is the zero-based number of the column.
Multiple columns may be given.
=item B<--separator> - set the column separator
This is the separator for the columns. It defaults
to a tab character ("\t").
=item B<--header-line> - output the first line into every file
This defines the line as header line which is output
into every file. If it is given an argument that string
is output as header, otherwise the first line read
will be repeated as the header.
If the value is a number, that many lines will be read from
the file and used as the header. This makes it impossible
to use just a number as the header.
=item B<--verbose> - output the generated filenames
In normal operation, the program will be silent. If you
need to know the generated filenames, the C<--verbose>
option will output them.
=item B<--filename-sep> - set the separator for the filenames
If you prefer a different separator for the filenames
than a newline, this option allows you to set it. If
the separator looks like an octal number (three digits)
it is interpreted as such. Otherwise it will
be taken literally. A common
use is to set the separator to C<000> to separate the
files by the zero character if you suspect that your
filenames might contain newlines.
It defaults to C<012>, a newline.
=item B<--version> - output version information
=head1 CAVEAT
The program loads the whole input into RAM
before writing the output. A future enhancement
might be a C<uniq>-like option that tells the
program to assume that the input will be grouped
according to the parted column so it does not
need to allocate memory.
If your memory is not large enough, the following
C<awk> one-liner might help you:
# Example of parting on column 3
awk -F '{ print $0 > $3 }' FILE
=head1 AUTHOR
Copyright (c) 2007 Max Maischein (C<< corion@cpan.org >>)
=cut
GetOptions(
'out=s' => \my $tmpl,
'column=i' => \my @col,
'separator=s' => \my $sep,
'verbose' => \my $verbose,
'filename-sep=s' => \my $filename_sep,
'header-line:s' => \my $header,
'help' => \my $help,
'version' => \my $version,
) or pod2usage(2);
pod2usage(1) if $help;
if (defined $version) {
print "$VERSION\n";
exit 0;
};
pod2usage("$0: No files given.") if ((@ARGV == 0) && (-t STDIN));
if (! defined $tmpl) {
# Let's hope we can guess from the first filename
my $placeholder = '-%s' x @col;
($tmpl = $ARGV[0] || 'part.txt') =~ s/\.(\w+)$/$placeholder.$1/;
};
if (! defined $sep) {
$sep = "\t";
};
$filename_sep ||= "012";
if ($filename_sep =~ /^\d{3}$/) {
$filename_sep = chr oct $filename_sep
};
my %lines;
if (defined $header) {
$header ||= 1;
if ($header =~ /^\d+$/) {
my $count = $header;
$header = "";
$header .= <>
while $count--;
};
};
while (<>) {
s/\r?\n$//;
my @c = split /$sep/o;
my $key = join $sep, @c[ @col ];
if (not defined $lines{ $key }) {
$lines{ $key } ||= [];
};
push @{ $lines{$key}}, $_
}
for my $key (sort keys %lines) {
my @vals = split /$sep/o, $key;
my $name = sprintf $tmpl, @vals;
open my $fh, ">", $name
or die "Couldn't create '$name': $!";
if ($header) {
print {$fh} $header;
}
print "$name$filename_sep"
if $verbose;
print {$fh} "$_\n"
for (@{ $lines{ $key }});
};
|
|
---|