The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

SZABGAB / Parse-Functions-0.01 / lib / Parse / Functions.pm 

            

              
1
2
3
4
5
—
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104

              
package Parse::Functions;
use strict;
use warnings;
our $VERSION = '0.01';
=head1 NAME
Parse::Functions - list all the functions in source code
=head1 DESCRIPTION
See L<Parse::Functions::Perl>
=cut
sub new {
        my ($class) = @_;
        my $self = bless {}, $class;
        return $self;
}
sub sort_functions {
        my ($self, $functions, $order) = @_;
        return $functions if not $order;
        my @sorted;
        # Sort it appropriately
        if ( $order eq 'alphabetical' ) {
                # Alphabetical (aka 'abc')
                # Ignore case and leading non-word characters
                my @expected = ();
                my @unknown  = ();
                foreach my $function (@$functions) {
                        if ( $function =~ /^([^a-zA-Z0-9]*)(.*)$/ ) {
                                push @expected, [ $function, $1, lc($2) ];
                        } else {
                                push @unknown, $function;
                        }
                }
                @expected = map { $_->[0] } sort {
                               $a->[2] cmp $b->[2]
                                || length( $a->[1] ) <=> length( $b->[1] )
                                || $a->[1] cmp $b->[1]
                                || $a->[0] cmp $b->[0]
                } @expected;
                @unknown =
                        sort { lc($a) cmp lc($b) || $a cmp $b } @unknown;
                @sorted = ( @expected, @unknown );
        } elsif ( $order eq 'alphabetical_private_last' ) {
                # As above, but with private functions last
                my @expected = ();
                my @unknown  = ();
                foreach my $function (@$functions) {
                        if ( $function =~ /^([^a-zA-Z0-9]*)(.*)$/ ) {
                                push @expected, [ $function, $1, lc($2) ];
                        } else {
                                push @unknown, $function;
                        }
                }
                @expected = map { $_->[0] } sort {
                               length( $a->[1] ) <=> length( $b->[1] )
                                || $a->[1] cmp $b->[1]
                                || $a->[2] cmp $b->[2]
                                || $a->[0] cmp $b->[0]
                } @expected;
                @unknown =
                        sort { lc($a) cmp lc($b) || $a cmp $b } @unknown;
                @sorted = ( @expected, @unknown );
        }
        return \@sorted;
}
# recognize newline even if encoding is not the platform default (will not work for MacOS classic)
sub newline { qr{\cM?\cJ} };
sub find {
        my ($self, $text, $sort) = @_;
        # Show an empty function list by default
        return () if not $text;
        my $function_re = $self->function_re;
        my @functions = grep { defined $_ } $text =~ /$function_re/g;
        return @{ $self->sort_functions( \@functions, $sort ) };
}
1;
# Copyright 2008-2014 The Padre development team as listed in Padre.pm.
# LICENSE
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl 5 itself.