#! perl

my $class = shift;
my $curclass = "";
my (@scalar_member, @array_member);

for my $file (@ARGV) {
   open my $fh, "<:utf8", $file
      or die "$file: $!";

   while (<$fh>) {
      while (/ACC\s*\(R([WO])\s*,\s*([^)\]]+)(?:\[(\S+)\])?\)/g) {
         next unless $curclass eq $class;

         if ($3) {
            push @array_member, [$1, $2, $3];
         } else {
            push @scalar_member, [$1, $2];
         }
      }
      while (/ACC_CLASS\s*\((\S+)\)/g) {
         $curclass = $1;
      }
   }
}

if (@scalar_member) {
   print "SV *$scalar_member[0][1] ($class *self, SV *newval = 0)\n";
   print "\tPROTOTYPE: \$;\$\n";

   if (@scalar_member > 1) {
      print "\tALIAS:\n";
      for (1 .. $#scalar_member) {
         print "\t\t$scalar_member[$_][1]\t= $_\n";
      }
   }

   print "\tCODE:\n";

# read
   print "\tif (GIMME_V == G_VOID)\n",
         "\t  RETVAL = &PL_sv_undef;\n",
         "\telse\n",
         "\t  switch (ix)\n",
         "\t    {\n",
         (map "\t      case $_: RETVAL = to_sv (self->$scalar_member[$_][1]); break;\n",
             0 .. $#scalar_member),
         "\t      default: croak (\"scalar_member is write-only\");\n",
         "\t    };\n";

# write
   print "\tif (newval)\n",
         "\t  switch (ix)\n",
         "\t    {\n",
         (map "\t      case $_: sv_to (newval, self->$scalar_member[$_][1]); break;\n",
             grep $scalar_member[$_][0] eq "W",
                0 .. $#scalar_member),
         "\t      default: croak (\"scalar_member is read-only\");\n",
         "\t    };\n";

   print "\tOUTPUT: RETVAL\n\n";
}

if (@array_member) {
   print "SV *$array_member[0][1] ($class *self, int idx, SV *newval = 0)\n";
   print "\tPROTOTYPE: \$;\$\n";

   if (@array_member > 1) {
      print "\tALIAS:\n";
      for (1 .. $#array_member) {
         print "\t\t$array_member[$_][1]\t= $_\n";
      }
   }

   print "\tCODE:\n";

   print "\tif (idx < 0) croak (\"negative array index\");\n";

# range
   print "\t  switch (ix)\n",
         "\t    {\n",
         (map "\t      case $_: if (idx >= $array_member[$_][2]) croak (\"array index out of bounds\"); break;\n",
             0 .. $#array_member),
         "\t    };\n";

# read
   print "\tif (GIMME_V == G_VOID)\n",
         "\t  RETVAL = &PL_sv_undef;\n",
         "\telse\n",
         "\t  switch (ix)\n",
         "\t    {\n",
         (map "\t      case $_: RETVAL = to_sv (self->$array_member[$_][1] [idx]); break;\n",
             0 .. $#array_member),
         "\t      default: croak (\"array_member is write-only\");\n",
         "\t    };\n";

# write
   print "\tif (newval)\n",
         "\t  switch (ix)\n",
         "\t    {\n",
         (map "\t      case $_: sv_to (newval, self->$array_member[$_][1] [idx]); break;\n",
             grep $array_member[$_][0] eq "W",
                0 .. $#array_member),
         "\t      default: croak (\"array_member is read-only\");\n",
         "\t    };\n";

   print "\tOUTPUT: RETVAL\n\n";
}