view release on metacpan or  search on metacpan

lib/Perl/Tidy/Formatter.pm  view on Meta::CPAN

        my $call_type = $rcall_item->{call_type};
        my $package   = $rcall_item->{package};
        my $name      = $rcall_item->{name};
        my $arg_count = $rcall_item->{arg_count};
        my $key       = $package . '::' . $name;

        next unless ( defined($arg_count) );
        if ( $call_type eq '->' ) {
            $arg_count += 1;
##          $upper_bound_call_info{$key}->{method_call_count}++;
        }
        else {
##          $upper_bound_call_info{$key}->{direct_call_count}++;
        }
        my $max = $upper_bound_call_info{$key}->{max_arg_count};
        my $min = $upper_bound_call_info{$key}->{min_arg_count};
        if ( !defined($max) || $arg_count > $max ) {
            $upper_bound_call_info{$key}->{max_arg_count} = $arg_count;
        }
        if ( !defined($min) || $arg_count < $min ) {
            $upper_bound_call_info{$key}->{min_arg_count} = $arg_count;
        }
    }

    #-----------------------------------
    # Get arg counts for sub definitions
    #-----------------------------------
    my ( $rsub_info_by_seqno, $rsub_seqno_by_key ) =
      $self->sub_def_info_maker( $rpackage_lookup_list,
        \%upper_bound_call_info );

    # invert hash seqno=>key
    my $rsub_key_by_seqno = {};
    foreach my $key ( keys %{$rsub_seqno_by_key} ) {
        my $seqno = $rsub_seqno_by_key->{$key};
        $rsub_key_by_seqno->{$seqno} = $key;
    }

    # Hash to hold combined info for subs and calls
    my %common_hash;

    #---------------------------------------------
    # First split the calls into direct and method
    #---------------------------------------------
    my @method_call_seqnos;
    foreach my $seqno ( keys %{$rsub_call_paren_info_by_seqno} ) {
        my $rcall_item = $rsub_call_paren_info_by_seqno->{$seqno};
        my $package    = $rcall_item->{package};
        my $name       = $rcall_item->{name};
        my $key        = $package . '::' . $name;
        if ( $rcall_item->{call_type} eq '->' ) {
            push @method_call_seqnos, $seqno;
        }
        else {
            push @{ $common_hash{$key}->{direct_calls} }, $rcall_item;
        }
    }

    #----------------------------------------------
    # Now split method calls into self and external
    #----------------------------------------------
    my @debug_warnings;
    foreach my $seqno (@method_call_seqnos) {
        my $rcall_item       = $rsub_call_paren_info_by_seqno->{$seqno};
        my $package          = $rcall_item->{package};
        my $name             = $rcall_item->{name};
        my $caller_name      = $rcall_item->{caller_name};
        my $class_name       = $rcall_item->{class_name};
        my $key_receiver_sub = $package . '::' . $name;
        my $is_self_call;

        # Find the sub which contains this call
        my $seqno_sub_parent = $self->parent_sub_seqno($seqno);
        if ($seqno_sub_parent) {
            my $item = $rsub_info_by_seqno->{$seqno_sub_parent};
            if ($item) {

                my $key_parent_sub   = $item->{package} . '::' . $item->{name};
                my $parent_self_name = $item->{self_name};
                my $caller_is_dollar_self = $caller_name eq '$self';

                # Decide if this method call is to an internal sub:
                #  Try 1 and Try 2 are general, for any object name
                #  Try 3 and Try 4 are guesses for common uses of '$self'

                #-----------------------------------------------------------
                # Try 1: Parent sub self name matches caller name
                # and either:
                #   - the only calls to parent sub (if any) are arrow calls,
                #   - or the name is '$self'
                #-----------------------------------------------------------
                $is_self_call =
                     $parent_self_name
                  && $parent_self_name eq $caller_name
                  && (!$common_hash{$key_parent_sub}->{direct_calls}
                    || $caller_is_dollar_self );

                #---------------------------------------------------------
                # Try 2. See if the name was blessed in the containing sub
                #---------------------------------------------------------
                if ( !$is_self_call ) {
                    my $item_self = $item->{self_name};
                    $item_self = 'undef' unless ($item_self);
                    my $rK_bless_list =
                      $rK_bless_by_sub_seqno->{$seqno_sub_parent};
                    if ($rK_bless_list) {
                        my $Ko = $K_opening_container->{$seqno};
                        foreach my $blessing ( @{$rK_bless_list} ) {

                            # Index K and blessed name were stored with sub.
                            # $K_blessed may be 1 token before K of '$self'
                            my ( $K_blessed, $name_blessed ) = @{$blessing};

                            # name of blessed object must match
                            next if ( $name_blessed ne $caller_name );

                            # keyword 'bless' must be at top sub level. We have
                            # to back up 1 token in case $self is in parens.
                            my $Kp = $self->K_previous_code($K_blessed);
                            next if ( !$Kp );