Skip to content
This repository
Newer
Older
100644 193 lines (165 sloc) 5.904 kb
4242da41 » monken
2011-02-12 document classes which describe indexes and tests
1 package MetaCPAN::Document::File;
2 use Moose;
6bc44ebb » monken
2011-03-16 fixed new naming
3 use ElasticSearchX::Model::Document;
4242da41 » monken
2011-02-12 document classes which describe indexes and tests
4
5 use URI::Escape ();
a277d5c3 » monken
2011-04-22 removed Pod::POM dep and rewrote abstract and module extraction
6 use Pod::Tree;
4242da41 » monken
2011-02-12 document classes which describe indexes and tests
7 use MetaCPAN::Pod::XHTML;
8 use Pod::Text;
9 use Plack::MIME;
10 use List::MoreUtils qw(uniq);
c2925926 » monken
2011-04-23 removed Lines.pm class, moved it in Util.pm
11 use MetaCPAN::Util;
9cbbc834 » monken
2011-03-09 improved types
12 use MetaCPAN::Types qw(:all);
19fa7566 » monken
2011-03-17 D::File includes now a list of modules, D::Module not indexed anymore
13 use MooseX::Types::Moose qw(ArrayRef);
4242da41 » monken
2011-02-12 document classes which describe indexes and tests
14
db49446e » monken
2011-02-13 update to document classes and tests
15 Plack::MIME->add_type( ".t" => "text/x-script.perl" );
16 Plack::MIME->add_type( ".pod" => "text/x-script.perl" );
17 Plack::MIME->add_type( ".xs" => "text/x-c" );
4242da41 » monken
2011-02-12 document classes which describe indexes and tests
18
19 has id => ( id => [qw(author release path)] );
20
9f9d48cc » monken
2011-03-02 got rid of pod_html and toc, renamed pod_txt to pod
21 has [qw(path author name distribution)] => ();
ca79817a » monken
2011-04-25 remove module property for pod files
22 has module => ( required => 0, is => 'rw', isa => Module, coerce => 1, clearer => 'clear_module' );
23 has documentation => ( required => 1, is => 'rw', lazy_build => 1, index => 'analyzed', analyzer => [qw(standard camelcase)] );
9f9d48cc » monken
2011-03-02 got rid of pod_html and toc, renamed pod_txt to pod
24 has release => ( parent => 1 );
19fa7566 » monken
2011-03-17 D::File includes now a list of modules, D::Module not indexed anymore
25 has date => ( isa => 'DateTime' );
9cbbc834 » monken
2011-03-09 improved types
26 has stat => ( isa => Stat, required => 0 );
db49446e » monken
2011-02-13 update to document classes and tests
27 has sloc => ( isa => 'Int', lazy_build => 1 );
08e6739c » monken
2011-02-21 dropped Modern::Perl as prereq
28 has slop => ( isa => 'Int', is => 'rw', default => 0 );
db49446e » monken
2011-02-13 update to document classes and tests
29 has pod_lines => ( isa => 'ArrayRef', type => 'integer', lazy_build => 1, index => 'no' );
db1a7bf5 » monken
2011-03-12 term_vector on pod property
30 has pod => ( isa => 'ScalarRef', lazy_build => 1, index => 'analyzed', store => 'no', term_vector => 'with_positions_offsets' );
255776e3 » monken
2011-03-04 fix indexing tag on modules
31 has [qw(mime)] => ( lazy_build => 1 );
da2c7f78 » monken
2011-02-21 added status field
32 has abstract => ( lazy_build => 1, index => 'analyzed' );
33 has status => ( default => 'cpan' );
9f9d48cc » monken
2011-03-02 got rid of pod_html and toc, renamed pod_txt to pod
34 has maturity => ( default => 'released' );
255776e3 » monken
2011-03-04 fix indexing tag on modules
35 has directory => ( isa => 'Bool', default => 0 );
36 has level => ( isa => 'Int', lazy_build => 1 );
4242da41 » monken
2011-02-12 document classes which describe indexes and tests
37
08e6739c » monken
2011-02-21 dropped Modern::Perl as prereq
38
edf53526 » monken
2011-02-15 optimized for low memory footprint
39 has content => ( isa => 'ScalarRef', lazy_build => 1, property => 0, required => 0 );
db49446e » monken
2011-02-13 update to document classes and tests
40 has ppi => ( isa => 'PPI::Document', lazy_build => 1, property => 0 );
4242da41 » monken
2011-02-12 document classes which describe indexes and tests
41 has pom => ( lazy_build => 1, property => 0, required => 0 );
6520d00a » monken
2011-02-15 got rid of (slow) PPI
42 has content_cb => ( property => 0, required => 0 );
4242da41 » monken
2011-02-12 document classes which describe indexes and tests
43
44 sub is_perl_file {
18a86782 » monken
2011-04-16 fixes #78, implemented documentation property
45 my $self = shift;
a277d5c3 » monken
2011-04-22 removed Pod::POM dep and rewrote abstract and module extraction
46 return 1 if($self->name =~ /\.(pl|pm|pod|t)$/i);
47 if($self->name !~ /\./) {
48 my $content = ${$self->content};
49 return 1 if($content =~ /^#!.*?perl/);
18a86782 » monken
2011-04-16 fixes #78, implemented documentation property
50 }
a277d5c3 » monken
2011-04-22 removed Pod::POM dep and rewrote abstract and module extraction
51 return 0;
18a86782 » monken
2011-04-16 fixes #78, implemented documentation property
52 }
53
ca79817a » monken
2011-04-25 remove module property for pod files
54 sub is_pod_file {
55 shift->name =~ /\.pod$/i;
56 }
57
a277d5c3 » monken
2011-04-22 removed Pod::POM dep and rewrote abstract and module extraction
58 sub _build_documentation {
255776e3 » monken
2011-03-04 fix indexing tag on modules
59 my $self = shift;
a277d5c3 » monken
2011-04-22 removed Pod::POM dep and rewrote abstract and module extraction
60 $self->_build_abstract;
ca79817a » monken
2011-04-25 remove module property for pod files
61 my $documentation = $self->documentation if($self->has_documentation);
da5ea0e3 » monken
2011-04-23 no documentation for non-pod docs and camelcase
62 return undef unless(${$self->pod});
ca79817a » monken
2011-04-25 remove module property for pod files
63 my @indexed = grep { $_->indexed } @{$self->module || []};
1c3f4d71 » monken
2011-04-29 fixed processing of .pod files
64 if($documentation && $self->is_pod_file) {
65 return $documentation;
66 } elsif($documentation && grep {$_->name eq $documentation} @indexed) {
ca79817a » monken
2011-04-25 remove module property for pod files
67 return $documentation;
68 } elsif(@indexed) {
69 return $indexed[0]->name;
70 } else {
71 return undef;
72 }
255776e3 » monken
2011-03-04 fix indexing tag on modules
73 }
74
75 sub _build_level {
76 my $self = shift;
77 my @level = split(/\//, $self->path);
78 return @level - 1;
79 }
80
edf53526 » monken
2011-02-15 optimized for low memory footprint
81 sub _build_content {
82 my $self = shift;
08e6739c » monken
2011-02-21 dropped Modern::Perl as prereq
83 my @content = split("\n", ${$self->content_cb->()} || '');
7f44e2b8 » monken
2011-02-16 ignore data sections in files, end in sloccount
84 my $content = "";
85 while(@content) {
86 my $line = shift @content;
87 last if($line =~ /^\s*__DATA__$/);
88 $content .= $line . "\n";
89 }
90 return \$content;
edf53526 » monken
2011-02-15 optimized for low memory footprint
91 }
92
4242da41 » monken
2011-02-12 document classes which describe indexes and tests
93 sub _build_mime {
94 Plack::MIME->mime_type( shift->name ) || 'text/plain';
95 }
96
97 sub _build_pom {
98 my $self = shift;
a277d5c3 » monken
2011-04-22 removed Pod::POM dep and rewrote abstract and module extraction
99 my $pod = Pod::Tree->new;
100 $pod->load_string( ${ $self->content } );
101 return $pod;
4242da41 » monken
2011-02-12 document classes which describe indexes and tests
102 }
db49446e » monken
2011-02-13 update to document classes and tests
103
104 sub _build_abstract {
105 my $self = shift;
a277d5c3 » monken
2011-04-22 removed Pod::POM dep and rewrote abstract and module extraction
106 return undef unless ( $self->is_perl_file );
107 my $root = $self->pom->get_root;
108 my $in_name = 0;
109 my ( $abstract, $documentation );
110 foreach my $node ( @{ $root->get_children } ) {
111 if ($in_name) {
112 last
113 if ( $node->get_type eq 'command'
114 && $node->get_command eq 'head1' );
115
b748fe79 » monken
2011-04-23 abstract parser
116 my $text = MetaCPAN::Util::strip_pod($node->get_text);
117 # warn $text;
118 if ( $in_name == 1 && $text =~ /^\h*(\S+?)(\h+-+\h+(.*))?$/s ) {
119 chomp($abstract = $3);
120 my $name = $1;
121 $documentation = $name if($name =~ /^[\w:']+$/);
122 } elsif ( $in_name == 1 && $text =~ /^\h*([\w\:']+?)\n/s ) {
a277d5c3 » monken
2011-04-22 removed Pod::POM dep and rewrote abstract and module extraction
123 chomp($documentation = $1);
b748fe79 » monken
2011-04-23 abstract parser
124 } elsif( $in_name == 2 && !$abstract && $text) {
a277d5c3 » monken
2011-04-22 removed Pod::POM dep and rewrote abstract and module extraction
125 chomp($abstract = $text);
126 }
127
128 if ($abstract) {
129 $abstract =~ s{=head.*}{}xms;
130 $abstract =~ s{\n\n.*$}{}xms;
131 $abstract =~ s{\n}{ }gxms;
132 $abstract =~ s{\s+$}{}gxms;
133 $abstract =~ s{(\s)+}{$1}gxms;
134 }
135 $in_name++;
4242da41 » monken
2011-02-12 document classes which describe indexes and tests
136 }
a277d5c3 » monken
2011-04-22 removed Pod::POM dep and rewrote abstract and module extraction
137
138 last if ( $abstract && $documentation );
139
140 $in_name++
141 if ( $node->get_type eq 'command'
142 && $node->get_command eq 'head1'
143 && $node->get_text =~ /^NAME\s*$/ );
144
4242da41 » monken
2011-02-12 document classes which describe indexes and tests
145 }
a277d5c3 » monken
2011-04-22 removed Pod::POM dep and rewrote abstract and module extraction
146 $self->documentation($documentation) if ($documentation);
147 return $abstract;
148
4242da41 » monken
2011-02-12 document classes which describe indexes and tests
149 }
150
151 sub _build_path {
152 my $self = shift;
153 return join( '/', $self->release->name, $self->name );
154 }
155
156 sub _build_pod_lines {
157 my $self = shift;
158 return [] unless ( $self->is_perl_file );
c2925926 » monken
2011-04-23 removed Lines.pm class, moved it in Util.pm
159 my ($lines, $slop) = MetaCPAN::Util::pod_lines(${$self->content});
da2c7f78 » monken
2011-02-21 added status field
160 $self->slop($slop || 0);
08e6739c » monken
2011-02-21 dropped Modern::Perl as prereq
161 return $lines;
162
4242da41 » monken
2011-02-12 document classes which describe indexes and tests
163 }
164
165 # Copied from Perl::Metrics2::Plugin::Core
166 sub _build_sloc {
167 my $self = shift;
168 return 0 unless ( $self->is_perl_file );
6520d00a » monken
2011-02-15 got rid of (slow) PPI
169 my @content = split("\n", ${$self->content});
170 my $pods = 0;
171 map { splice(@content, $_->[0], $_->[1], map { '' } 1 .. $_->[1]) } @{$self->pod_lines};
7f44e2b8 » monken
2011-02-16 ignore data sections in files, end in sloccount
172 my $sloc = 0;
173 while(@content) {
174 my $line = shift @content;
08e6739c » monken
2011-02-21 dropped Modern::Perl as prereq
175 last if($line =~ /^\s*__END__/s);
7f44e2b8 » monken
2011-02-16 ignore data sections in files, end in sloccount
176 $sloc++ if( $line !~ /^\s*#/ && $line =~ /\S/ );
177 }
178 return $sloc;
4242da41 » monken
2011-02-12 document classes which describe indexes and tests
179 }
180
9f9d48cc » monken
2011-03-02 got rid of pod_html and toc, renamed pod_txt to pod
181 sub _build_pod {
4242da41 » monken
2011-02-12 document classes which describe indexes and tests
182 my $self = shift;
183 return \'' unless ( $self->is_perl_file );
184 my $parser = Pod::Text->new( sentence => 0, width => 78 );
185
186 my $text = "";
187 $parser->output_string( \$text );
188 $parser->parse_string_document( ${ $self->content } );
189
190 return \$text;
191 }
192
193 __PACKAGE__->meta->make_immutable;
Something went wrong with that request. Please try again.