#!/usr/bin/perl
# $Id$
#
# Output filter extracting matching lines to different files
# (output files will be 'unmerged.01', 'unmerged.02', etc)
#
# Usage:
#  ./unmerge <input_file> <pattern1> [<pattern2>] ...
#
# 2007-02-03 altblue@n0i.net
#
use strict;
use warnings;
our $VERSION = sprintf '0.%d.%d', '\$Revision: 1.0 $' =~ /(\d+)\.(\d+)/xm;
use English qw( -no_match_vars );
use Carp;

unmerge( shift @ARGV, patterns(@ARGV) );

sub unmerge {
    my ( $file, @patterns ) = @_;
    croak 'No patterns?' if !@patterns;
    open my $ifh, q{<}, $file
        or croak "Cannot open $file: $OS_ERROR";
    my $matches = 0;
    while ( my $line = <$ifh> ) {
        for my $pat (@patterns) {
            next if $line !~ $pat->[1];
            $matches++;
            open my $fh, q{>>}, $pat->[0]
                or croak "Cannot open $pat->[0]: $OS_ERROR";
            print {$fh} $line
                or croak "Cannot append line to $pat->[0]: $OS_ERROR";
            close $fh
                or croak "Cannot close $pat->[0]: $OS_ERROR";
        }
    }
    close $ifh;
    return $matches;
}

sub patterns {
    my $idx       = 1;
    my $ftemplate = 'unmerged.%0' . length( scalar @_ ) . 'd%s';
    my @patterns;
    for my $pattern (@_) {
        my $re = eval { qr{$pattern} };
        if ($EVAL_ERROR) {
            croak "ERROR: Invalid regular expression $pattern";
        }
        my $fn = $pattern =~ /(\w+)/xm ? ".$1" : q{};
        push @patterns, [ sprintf( $ftemplate, $idx++, $fn ), $re ];
    }
    return @patterns;
}