syphon

#!/usr/bin/perl

=head1 NAME

syphon - removes lines from top of file 

=head1 SYNOPSIS

    $ syphon    [-v] $regexp $src_filename > $outfile
    $ syphon -i [-v] $regexp $src_filename [ $removed_file ]

=head1 DESCRIPTION

Removes lines from the beginning of a file.  Stops when a pattern is
encountered (the first line matching the pattern is not removed).
Outputs the file minus the lines syphoned off to STDOUT, unless C<-i>
is specified, in which case the file is syphoned in place - the inode
is preserved by filtering to a temporary file and then copying back
over the original file.  This means it will work with log files whose
daemon opens them with C<O_APPEND>.  If C<$removed_file> is specified,
the removed lines will be written to that file.

C<-v> turns on verbose output.

=head1 EXAMPLE USAGE

syphon -i '^... Jul .. ........ ... 2010' get-fbcal.log get-fbcal.log-2010-06

Use of multi-syphon wrapper highly recommended!

=cut

use strict;
use warnings;

use File::Copy;
use File::Temp qw/ :mktemp  /;
use Getopt::Long;

(my $me = $0) =~ s,.*/,,;

sub usage {
  warn @_, "\n" if @_;
  die <<EOF;
Usage: $me    [-v] \$regexp \$src_filename > \$outfile
       $me -i [-v] \$regexp \$src_filename [ \$removed_file ]
EOF
}

my %opts;
GetOptions(\%opts, 'in-place|i', 'verbose|v') or usage();

usage() unless @ARGV == 2 or ($opts{'in-place'} && @ARGV == 3);
my ($re, $src, $removed) = @ARGV;
my $compiled = qr/$re/;

open(FILE, $src) or die "$me: open($src): $!\n";
if ($removed) {
  usage("$removed already exists.\n") if -e $removed;
  open(REMOVED, ">$removed") or die "$me: open(>$removed): $!\n";
}

my ($temp_fh, $temp_fn) = get_dest();

remove_lines();
warn "Line removal finished.\n"
  if $opts{'in-place'} && $opts{verbose};
print $temp_fh $_;
print $temp_fh $_ while <FILE>;
close(FILE);

if ($opts{'in-place'}) {
  warn "Remainder written to $temp_fn.\n"
    if $opts{verbose};
  close($temp_fh);
#  print "Written to $temp_fn\n";
  copy $temp_fn, $src;
  unlink $temp_fn;
}

sub remove_lines {
  if ($removed) {
    while (<FILE>) {
      last if /$compiled/;
      print REMOVED $_;
    }
  }
  else {
    while (<FILE>) {
      last if /$compiled/;
    }
  }
}

sub get_dest {
  return (\*STDOUT) unless $opts{'in-place'};
  return mkstemp( "/tmp/syphon-XXXXXXX" );
}

=head1 SEE ALSO

L<csplit(1)>, which I only discovered after writing this :-(
I needed the "in-place" feature though.

=head1 VERSION

$Id$

=head1 LICENSE

Copyright (c) 2003 Adam Spiers <adam@spiers.net>

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.

=cut