#!/usr/bin/perl -w

# Copyright 2008, 2009, 2010 Kevin Ryde

# This file is part of Perl-Critic-Pulp.
#
# Perl-Critic-Pulp 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, or (at your option) any
# later version.
#
# Perl-Critic-Pulp 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 Perl-Critic-Pulp.  If not, see <http://www.gnu.org/licenses/>.

use 5.010;
use strict;
use warnings;
use Regexp::Common qw /delimited/;

use FindBin;
my $progname = $FindBin::Script;

use lib::abs '.';
use MyLocatePerl;
use MyStuff;

my $verbose = 0;
my $count = 0;

my $string_re = qr/$RE{delimited}{-delim=>q{'"}}/o;
# ($string_re)

my $l = MyLocatePerl->new;
OUTER: while (my ($filename, $str) = $l->next) {
  if ($verbose) { print "look at $filename\n"; }
  $count++;

  while ($str =~ /\b(?:un)?pack
                  [\t (]+
                  ['"]([^'"]*)['"]
                 /gsxo) {
    my $pos = pos($str);
    my $format = $1;

    next if ($format =~ /\$/);  # interpolations

    #     # 5.002 supported
    #     next if ($format =~ /^[%*0-9 AabBhHcCsSiIlLnNvVfdpPuxX\@]*$/);

    #     # 5.004 supported
    #     next if ($format =~ /^[%*0-9 AabBhHcCsSiIlLnNvVfdpPuxX\@w]*$/);

    # 5.006 supported
    next if ($format =~ /^[%*0-9! AabBhHcCsSiIlLnNvVfdpPuxX\@wqQZ]*$/);

    my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos);
    print "$filename:$line:$col: pack $format\n  ",
      MyStuff::line_at_pos($str, $pos);
  }
}

print "looked at $count\n";
exit 0;



__END__



# 5.002
#     %NUM for unpack
#
#     A	An ascii string, will be space padded.
#     a	An ascii string, will be null padded.
#     b	A bit string (ascending bit order, like vec()).
#     B	A bit string (descending bit order).
#     h	A hex string (low nybble first).
#     H	A hex string (high nybble first).
#
#     c	A signed char value.
#     C	An unsigned char value.
#     s	A signed short value.
#     S	An unsigned short value.
#     i	A signed integer value.
#     I	An unsigned integer value.
#     l	A signed long value.
#     L	An unsigned long value.
#
#     n	A short in "network" order.
#     N	A long in "network" order.
#     v	A short in "VAX" (little-endian) order.
#     V	A long in "VAX" (little-endian) order.
#
#     f	A single-precision float in the native format.
#     d	A double-precision float in the native format.
#
#     p	A pointer to a null-terminated string.
#     P	A pointer to a structure (fixed-length string).
#
#     u	A uuencoded string.
#
#     x	A null byte.
#     X	Back up a byte.
#     @	Null fill to absolute position.
#
# 5.004
#     w	A BER compressed integer.  Its bytes represent an unsigned
# 	integer in base 128, most significant digit first, with as few
# 	digits as possible.  Bit eight (the high bit) is set on each
# 	byte except the last.
#
# 5.6.0
#     q	A signed quad (64-bit) value.
#     Q	An unsigned quad value.
# 	  (Quads are available only if your system supports 64-bit
# 	   integer values _and_ if Perl has been compiled to support those.
#            Causes a fatal error otherwise.)
#
#     Z	A null terminated (asciz) string, will be null padded.
#
# 5.8.0
#     F	A floating point value in the native native format
#            (a Perl internal floating point value, NV).
#     D	A long double-precision float in the native format.
# 	  (Long doubles are available only if your system supports long
# 	   double values _and_ if Perl has been compiled to support those.
#            Causes a fatal error otherwise.)
#
#     j   A signed integer value (a Perl internal integer, IV).
#     J   An unsigned integer value (a Perl internal unsigned integer, UV).