#!/usr/bin/perl
#
# multi_seq [-f]  format_string  [start[,inc],]end...
#
# This is like the linux 'seq' command, but can handle multiple sequences of
# numbers.  Each substitution is incremented with the last substitution
# incrementing before previous ones.
#
# Each "printf" number substitution ("%d", "%x", %f etc.) found in the
# {format_string} is replaced by a number from the comma separated argument
# ranges, specifying the start,inc,end for that substitution.
#
# Any number of "printf" substitutions can be given.
#
# Options
#   -f    Increment the first substitution before later ones
#
# Examples
#   Count up and/or down
#   Note that the last substitution is incremented first
#     multi_seq "file_%d_%d"  3  3,1
#
#   Instead of decimal you can also count in hex (as per perl conventions)
#     multi_seq "...%02x..."  0x2a,0x4f
#
#   Incrementing ISO standard date (including some illegal dates)
#     multi_seq "file_%d-%02d-%02d"  2010,2011  12  31
#
#   Incrementing Dates, in day-month-year order
#     multi_seq -f "%02d/%02d/%d"  31  12  2010,2011
#
# In some ways this is also like bash brace expandsion, but the '-f' reverses
# the order of the increments.  That the bash equivelent of the previous, will
# increment 'year' before 'day' and 'month', resulting in, the bad ordering
# of: 1/1/2010, 1/1/2011, 1/2/2010,...
#
#     printf '%s\n' {1..31}/{1..12}/{2010,2011}
#
###
#
# Re-Written by Anthony Thyssen      18 May 2007
# Update to reverse increment order  4 March 2019
#

use strict;
use FindBin;
my $PROGNAME = $FindBin::Script;

sub Usage {
  print STDERR "$PROGNAME: ", @_, "\n"  if @_;
  @ARGV = ( "$FindBin::Bin/$PROGNAME" ); # locate script file
  while( <> ) {
    next if 1 .. 2;
    last if /^###/;
    last unless /^#/;
    s/^#$//; s/^# //;
    last if /^$/;
    print STDERR "Usage: " if 3 .. 3;
    print STDERR;
  }
  print STDERR "For full manual use --help\n";
  exit 10;
}
sub Help {
  @ARGV = ( "$FindBin::Bin/$PROGNAME" ); # locate script file
  while( <> ) {
    next if $. == 1;
    last if /^###/;
    last unless /^#/;
    s/^#$//; s/^# //;
    print STDERR;
  }
  exit 10;
}

my ($first_inc) = map(0, 0..10);  # initialise flags

# Option handler
OPTION:  # Multi-switch option handling
while( @ARGV && $ARGV[0] =~ s/^-(?=.)// ) {
  $_ = shift; {
    m/^$/  && do { next };       # Next option
    m/^-$/ && do { last };       # End of options '--'
    m/^\?/ && do { Help };       # Usage Help     '-?'
    m/^-?(help|doc|man|manual)$/ && Help;  # Print help manual comments

    s/^f// && do { $first_inc++; redo };    # increment first sub first

    Usage( "Unknown Option \"-$_\"" );
  } continue { next OPTION }; last OPTION;
}

# Format argument
my $format = shift || Usage "Missing format string";
Usage "No % escape in format string" unless  $format =~ /%/;
do{
  my @c = ($format =~ /%[\d.]*[dxXofg]/g);
  Usage "Incorrect argument count for % escapes" unless @c == @ARGV;
};

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

# recursively replace the % substitutions with values...
@ARGV = reverse @ARGV    if $first_inc;  # substitute in reverse
do_substitutions( $format, @ARGV );

sub do_substitutions {
  my $f =  shift;       # get the first format string only
  unless ( @_ ) {       # output if no more substitutions need to be made
    do_job($f); return;
  }

  # fill in missing range arguments
  my @r = split(',', shift);       # get the range for first % escape
  map { $_ = oct $_ if /^0x/ } @r; # convert hexadecimal to decimal
  splice(@r, 0, 0, 1) if @r == 1;  # add default start
  splice(@r, 1, 0, ($r[0]<$r[1]?1:-1)) if @r == 2;  # add default increment

  Usage "Zero Increment in range argument." if $r[1] == 0;
  Usage "No numbers within range argument '", join(',',@r), "'."
                if $r[1] > 0 && $r[0] > $r[2]
                || $r[1] < 0 && $r[0] < $r[2];

  my $n = $r[0];          # start
  while(1) {
    last if $r[1] > 0 && $n > $r[2];  # end (inc up)
    last if $r[1] < 0 && $n < $r[2];  # end (inc down)

    (my $format = $f);  # make a copy of given format string
    if ( $first_inc ) {
      # replace last - so first substitution, increments first
      $format =~ s/(.*)(%[\d.]*[dxXofg])/ $1.sprintf($2, $n) /e; # substitute
    } else {
      # replace first substitution pattern
      $format =~ s/%[\d.]*[dxXofg]/ sprintf($&, $n) /e;  # substitute
    }

    do_substitutions( $format, @_ );  # continue with next substitution

    $n += $r[1];                       # increment

  }
}

# What to do with the substituted string  (just print)
# If you want to expand this to some other specific purpose
sub do_job {
  print "@_\n";
}