#!/usr/bin/env perl

# Copyright (c) 2015 Christian Jaeger, copying@christianjaeger.ch
# This is free software. See the file COPYING.md that came bundled
# with this file.

use strict; use warnings; use warnings FATAL => 'uninitialized';

# find modules from functional-perl working directory (not installed)
use Cwd 'abs_path';
our ($mydir, $myname); BEGIN {
    my $location= (-l $0) ? abs_path ($0) : $0;
    $location=~ /(.*?)([^\/]+?)_?\z/s or die "?";
    ($mydir, $myname)=($1,$2);
}
use lib "$mydir/../lib";



our $BUFSIZ= 1024*16;

sub usage {
    print STDERR map{"$_\n"} @_ if @_;
    print "$myname n [m]

  Skip n bytes of input, output the rest. If m is given, don't output
  the last m bytes. Example: `echo -n 'Hi World' | skip 3 2` -> 'Wor'

   --bufsize n   use n instead of default $BUFSIZ as buffer size
   --silent      don't give error if the input is too short
";
exit @_ ? 1 : 0;
}

use Getopt::Long;
use FP::Predicates 'is_natural0';
use Chj::xopen 'glob_to_fh';
use FP::IOStream 'fh_to_chunks';
use FP::Stream ":all";
use FP::List ":all";
use FP::Lazy ":all";
use POSIX 'ESPIPE';
use Chj::TEST;

sub resource_rss () {
    require BSD::Resource;
    (BSD::Resource::getrusage(BSD::Resource::RUSAGE_SELF()))[2]
}

# ---- sliding buffer ----------------------------------------

# Handle a sliding buffer window to make sure we don't output the
# input too soon (so that when we hit EOF, we've got at least m bytes
# still buffered). Do this by using a lazy list of chunks as the input
# and keep two pointers into it as the window.

# `chunks_change_tail` returns a stream of the unmodified chunks until
# passing through one more would make the sum of the remaining chunks
# till the end of the stream smaller than $minsize; pass the remainder
# to &$fn($tail, $remainingsize) and use its result as the tail of the
# output stream. (See test cases below for illustration.)

sub chunks_change_tail {
    @_==3 or die "wrong number of arguments";
    my ($chunks,  $minsize, $fn)=@_;
    weaken $_[0];

    is_null $chunks
      and die "got empty input";

    # start and rest are parts of the same stream of chunks,
    # windowsize is the number of bytes between them
    my $next; $next= sub {
	@_==3 or die "wrong number of arguments";
	my ($start, $rest, $windowsize)= @_;
	my $next=$next;
	lazy {
	  NEXT: {
		FORCE $start, $rest; # optional (since is_null, first
                                     # etc. are forcing promises
                                     # anyway), but might reduce
                                     # overhead slightly?
		my $first= first $start;
		my $lenfirst= length $first;
		my $reserve= $windowsize - $minsize;
		if ($lenfirst <= $reserve) {
		    cons ($first,
			  &$next(rest $start, $rest, $windowsize - $lenfirst))
		} else {
		    if (is_null $rest) {
			&$fn($start, $windowsize)
		    } else {
			#&$next($start, rest $rest, $windowsize + length first $rest)
			$windowsize= $windowsize + length first $rest;
			$rest= rest $rest;
			redo NEXT;
		    }
		}
	    }
	}
    };
    Weakened ($next)->($chunks, $chunks, 0);
}

sub test_with_size ($) {
    my ($size)=@_;
    stream_to_array
	chunks_change_tail(array_to_stream (["foo","bars","baz"]),
			   $size,
			   sub { my ($tail, $len)=@_; cons $len, $tail });
}

use FP::Equal;

TEST { test_with_size 1 }
[
 'foo',
 'bars',
 3,
 'baz'
];

TEST { equal test_with_size 2, test_with_size 1
	   and
       equal test_with_size 3, test_with_size 1 }
1;

TEST { test_with_size 4 }
[
 'foo',
 7,
 'bars',
 'baz'
];

TEST { test_with_size 999 }
[
 10,
 'foo',
 'bars',
 'baz'
];


# ------------------------------------------------------------

our $verbose=0;
our $opt_repl;
our $opt_leaktest;
our $opt_silent;
GetOptions("verbose"=> \$verbose,
	   "help"=> sub{usage},
	   "bufsize=n"=> \$BUFSIZ,
	   "repl"=> \$opt_repl,
	   "leaktest"=> \$opt_leaktest,
	   "silent"=> \$opt_silent,
	   ) or exit 1;


# called for testing or debugging:

if ($opt_repl) {
    require Chj::repl;
    Chj::repl();
    exit 0
}

if (perhaps_run_tests "main") {
    exit 0;
}

# called as tool:

usage unless (@ARGV==1 or @ARGV==2);

our ($n, $maybe_m)= @ARGV;

is_natural0 $n
  or usage "n must be a non-negative integer";

if (defined $maybe_m) {
    is_natural0 $maybe_m
      or usage "m must be a non-negative integer";
}


our $mem_start= resource_rss if $opt_leaktest;
our $mem_end;

our $in= glob_to_fh *STDIN;
our $out= glob_to_fh *STDOUT;

if ($n) {
    $in->seek($n) || do {
	if ($! == ESPIPE) {
	    # non-seekable device
	    my $nbufs= int ($n / $BUFSIZ);
	    my $nrest= $n % $BUFSIZ;
	    $nbufs * $BUFSIZ + $nrest == $n
		or die "Perl can't calculate?";
	    my $buf;
	    for (1..$nbufs) {
		$in->xsysreadcompletely($buf, $BUFSIZ);
	    }
	    $in->xsysreadcompletely($buf, $nrest);
	    # XX: seek does not complain when file is too short; this
	    # does. This is inconsistent. Also, check $opt_silent ?
	} else {
	    die "seek: $!";
	}
    };
}

if ($maybe_m) {
    my $chunks= force fh_to_chunks $in, $BUFSIZ;
    if (is_null $chunks) {
	die "$myname: no remainder left after skipping $n byte(s)\n"
	    unless $opt_silent;
    } else {
	my $chunks2= chunks_change_tail
	    ($chunks, $maybe_m, sub {
		my ($rest, $remainingsize)=@_;
		$mem_end= resource_rss if $opt_leaktest;

		if ($remainingsize < $maybe_m) {
		    if ($opt_silent) {
			null
		    } else {
			die "$myname: only $remainingsize byte(s) left ".
			  "after skipping $n byte(s)\n"
		    }
		} else {
		    my $last= first $rest;
		    cons(substr ($last, 0, $remainingsize - $maybe_m), null)
		}
	     });
	stream_for_each sub {
	    $out->xprint($_[0])
	}, $chunks2;
    }
} else {
    $in->xsendfile_to($out);
    $in->xclose;
}

$out->xclose;

if ($opt_leaktest
    and
    (($mem_end - $mem_start) / $mem_start > 1.5)) {
    die "there was a leak";
}

