view release on metacpan or  search on metacpan

maint/ref-update.pl  view on Meta::CPAN

  foreach my $item ($href->{inner}->@*)
  {
    $id{$item->{id}} = $item if exists $item->{id} && defined $item->{id};
  }

  my %functions;

  foreach my $f (grep { $_->{_class} eq 'Function' && $_->{name} =~ /^archive_/ } $href->{inner}->@*)
  {
    $functions{$f->{name}} = $f;
  }

  {
    my @prune;

    foreach my $name (keys %functions)
    {
      # if there is a _utf8 variant we don't really want
      # to muck with the wchar_t variant since Perl uses UTF-8 internally.
      if($name =~ /^(.*)_utf8$/)
      {
        push @prune, "${1}_w";
      }

      # Some methods need to be implemented manually with
      # wrappers or if they have unusual name changes,
      # so we remove them here.
      push @prune, $name if $manual{$name};

      # From the header file:
      # Return an opaque ACL object.
      # There's not yet anything clients can actually do with this...
      push @prune, $name if $name eq 'archive_entry_acl';

      # we use the newer next_header2 method
      push @prune, $name if $name eq 'archive_read_next_header';

      # This ... doesn't really work or make sense for Perl the
      # way it is implemented.
      push @prune, $name if $name eq 'archive_write_open_memory';

      # From the header file:
      # A more involved version that is only used for internal testing.
      push @prune, $name if $name eq 'archive_read_open_memory2';

      # We don't call this version, since it wasn't in 3.0.2 and
      # it is a shortcut for archive_*_free functions.
      push @prune, $name if $name eq 'archive_free';

      # these are aliases that are being renamed in 3.x and removed in 4.x
      push @prune, $name if $name =~ /^archive_(write_set_compression.*|read_support_compression.*|position_(compressed|uncompressed)|compression(_name|)|(read|write)_open_file|entry_acl_text(|_w))$/;

      # The _finish forms were renamed to _Free in 3.x and will be
      # removed in 4.x
      push @prune, $name if $name =~ /^archive_(read|write)_finish$/;

      # utility function to sort strings.  Don't really need this
      # in perl
      push @prune, $name if $name eq 'archive_utility_string_sort';

      # Since callbacks are closures we don't really need to worry about
      # client data.  Not 100% sure this is what I think it is so
      # we maybe should revisit later.
      push @prune, $name if $name =~ /^archive_read_(add_callback_data|append_callback_data|prepend_callback_data|set_callback_data2)$/;

      # The open and open2 archive read methods are permutations of setting callbacks and calling open1
      # that we don't really need.
      push @prune, $name if $name =~ /^archive_read_open2?$/l
    }

    foreach my $name (@prune)
    {
      if(delete $functions{$name})
      {
        $count{removed}++;
        $removed{$name}++ unless $manual{$name};
      }
    }
  }

  foreach my $name (sort keys %functions)
  {
    my $f = $functions{$name};
    my $ret_type = type_fixup($get_type->($name, $f->{returns}));
    my @arg_types = map { type_fixup($get_type->($name, $_->{type} )) } $f->{inner}->@*;

    my $class;
    my $orig = $name;
    my $opt = $optional{$orig} ? 1 : undef;
    my $perl_name;

    if(defined $arg_types[0])
    {
      if($arg_types[0] eq 'archive_entry' && $name =~ /^archive_entry_(.*)$/)
      {
        $class = 'Entry';
        $name = $1;
        $ret_type = 'void' if $name eq 'clear';
      }

      if($arg_types[0] eq 'archive_entry_linkresolver' && $name =~ /^archive_entry_linkresolver_(.*)$/)
      {
        $class = 'EntryLinkResolver';
        $name = $1;
      }

      if($arg_types[0] eq 'archive')
      {
        if($name =~ /^archive_write_(disk_.*)$/)
        {
          $arg_types[0] = 'archive_write_disk';
          $class = 'DiskWrite';
          $name = $1;
        }

        elsif($name =~ /^archive_read_(disk_.*)$/)
        {
          $arg_types[0] = 'archive_read_disk';
          $class = 'DiskRead';
          $name = $1;
        }

        elsif($name =~ /^archive_read_(.*)$/)
        {
          $arg_types[0] = 'archive_read';
          $class = 'ArchiveRead';