« back to all changes in this revision
Viewing changes to Local.pm
- browse files at revision 3
- compare with another revision
- download diff
- download tarball
- view history from revision 3
- Committer: Bazaar Package Importer
- Author(s): Giacomo Catenazzi
- Date: 2006-02-24 07:52:13 UTC
- mfrom: (1.1.1 upstream)
- Revision ID: james.westby@ubuntu.com-20060224075213-2fn6kna2y9p3l65m
Tags: 0.9.4-1
* WARNING: see /usr/share/doc/lxr-cvs/README.Debian if you upgrade
from an old verion (0.9.2 and previous), because of some changes
in configuration and structure
* New upstream release (Closes: #310729)
* Moved configuration files in /etc/lxr and binary files in /usr/bin
(Closes: #326467).
* Some small updates (policy, debhelper, ...)
* Support for mysql 5.0
from an old verion (0.9.2 and previous), because of some changes
in configuration and structure
* New upstream release (Closes: #310729)
* Moved configuration files in /etc/lxr and binary files in /usr/bin
(Closes: #326467).
* Some small updates (policy, debhelper, ...)
* Support for mysql 5.0
- files added:
- .htaccess_cgi
- files removed:
- debian/conffiles
- files modified:
- .htaccess
added
removed
Local.pm
1
1
# -*- tab-width: 4 -*- ###############################################
2
2
#
3
# $Id: Local.pm,v 1.11 2002/03/18 14:55:43 mbox Exp $
3
# $Id: Local.pm,v 1.20 2004/07/21 20:44:30 brondsem Exp $
4
4
#
5
5
# Local.pm -- Subroutines that need to be customized for each installation
6
6
#
15
15
# but WITHOUT ANY WARRANTY; without even the implied warranty of
16
16
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17
17
# GNU General Public License for more details.
18
#
18
#
19
19
# You should have received a copy of the GNU General Public License
20
20
# along with this program; if not, write to the Free Software
21
21
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
28
28
29
29
package Local;
30
30
31
$CVSID = '$Id: Local.pm,v 1.11 2002/03/18 14:55:43 mbox Exp $ ';
31
$CVSID = '$Id: Local.pm,v 1.20 2004/07/21 20:44:30 brondsem Exp $ ';
32
32
33
33
require Exporter;
34
@ISA = qw(Exporter);
34
@ISA = qw(Exporter);
35
35
@EXPORT = qw(&fdescexpand &descexpand &dirdesc &convertwhitespace);
36
36
37
use LXR::Common;
37
use LXR::Common qw(:html);
38
38
39
39
# dme: Create descriptions for a file in a directory listing
40
40
# If no description, return the string "\ \;" to keep the
41
41
# table looking pretty.
42
42
#
43
# In mozilla search the beginning of a source file for a short
44
# description. Not all files have them and the ones that do use
43
# In mozilla search the beginning of a source file for a short
44
# description. Not all files have them and the ones that do use
45
45
# many different formats. Try to find as many of these without
46
46
# printing gobbeldygook or something silly like a file name or a date.
47
47
#
48
# Read in the beginning of the file into a string. I chose 60 because the
49
# Berkeley copyright notice is around 40 lines long so we need a bit more
48
# Read in the beginning of the file into a string. I chose 60 because the
49
# Berkeley copyright notice is around 40 lines long so we need a bit more
50
50
# than this.
51
51
#
52
52
# Its common for file descriptions to be delimited by the file name or
53
53
# the word "Description" which preceeds the description. Search the entire
54
54
# string for these. Sometimes they're put in odd places such as inside
55
55
# the copyright notice or after the code begins. The file name should be
56
# followed by a colon or some pattern of dashes.
56
# followed by a colon or some pattern of dashes.
57
57
#
58
58
# If no such description is found then use the contents of the "first"
59
59
# comment as the description. First, strip off the copyright notice plus
60
60
# anything before it. Remove rcs comments. Search for the first bit of
61
61
# code (usually #include) and remove it plus anything after it. In what's
62
62
# left, find the contents of the first comment, and get the first paragraph.
63
# If that's too long, use only the first sentence up to a period. If that's
64
# still too long then we probably have a list or something that will look
63
# If that's too long, use only the first sentence up to a period. If that's
64
# still too long then we probably have a list or something that will look
65
65
# strange if we print it out so give up and return null.
66
66
#
67
67
# Yes, this is a lot of trouble to go through but its easier than getting
72
72
# Yea, though I walk through the valley of the shadow of pattern
73
73
# matching, I shall fear no regex.
74
74
sub fdescexpand {
75
# use global vars here because the expandtemplate subroutine makes
76
# passing parameters impossible. Use $filename from source and
77
# $Path from Common.pm
78
my $filename = $main::filename;
79
my $linecount=0;
80
my $copy= "";
81
local $desc= "";
82
my $maxlines = 40; #only look at the beginning of the file
83
84
#ignore files that aren't source code
85
if (!(
86
($filename =~ /\.c$/) |
87
($filename =~ /\.h$/) |
88
($filename =~ /\.cc$/) |
89
($filename =~ /\.cp$/) |
90
($filename =~ /\.cpp$/) |
91
($filename =~ /\.java$/)
92
)){
93
return("\ \;");
94
}
95
96
if (open(FILE, $Path->{'real'}."/".$filename)) {
97
while(<FILE>){
98
$desc = $desc . $_ ;
99
if($linecount++ > 60) {
100
last;
101
}
102
}
103
close(FILE);
104
}
105
106
# sanity check: if there's no description then stop
107
if (!($desc =~ /\w/)){
108
return("\ \;");;
109
}
110
111
# save a copy for later
112
$copy = $desc;
113
114
# Look for well behaved <filename><seperator> formatted
115
# descriptions before we go to the trouble of looking for
116
# one in the first comment. The whitespace between the
117
# delimeter and the description may include a newline.
118
if (($desc =~ s/(?:.*?$filename\s*?- ?-*\s*)([^\n]*)(?:.*)/$1/sgi) ||
119
($desc =~ s/(?:.*?$filename\s*?:\s*)([^\n]*)(?:.*)/$1/sgi) ||
120
($desc =~ s/(?:.*?Description:\s*)([^\n]*)(?:.*)/$1/sgi)
121
){
122
# if the description is non-empty then clean it up and return it
123
if ($desc =~ /\w/) {
124
#strip trailing asterisks and "*/"
125
$desc =~ s#\*/?\s*$##;
126
$desc =~ s#^[^\S]*\**[^\S]*#\n#gs;
127
128
# Strip beginning and trailing whitespace
129
$desc =~ s/^\s+//;
130
$desc =~ s/\s+$//;
131
132
# Strip junk from the beginning
133
$desc =~ s#[^\w]*##ms;
134
135
#htmlify the comments making links to symbols and files
136
$desc = markupstring($desc, $Path->{'virt'});
137
return($desc);
138
}
139
}
140
141
# we didn't find any well behaved descriptions above so start over
142
# and look for one in the first comment
143
$desc = $copy;
144
145
# Strip off code from the end, starting at the first cpp directive
146
$desc =~ s/\n#.*//s;
147
148
# Strip off code from the end, starting at typedef
149
$desc =~ s/\ntypedef.*//s;
150
151
# Strip off license
152
$desc =~ s#(?:/\*.*license.*?\*/)(.*)#$1#is;
153
154
# Strip off copyright notice
155
$desc =~ s#(?:/\*.*copyright.*?\*/)(.*)#$1#is;
156
157
# Strip off emacs line
158
$desc =~ s#(/\*.*tab-width.*?\*/)(.*)#$2#isg;
159
160
# excise rcs crud
161
$desc =~ s#Id: $filename.*?Exp \$##g;
162
163
# Yuck, nuke these silly comments in js/jsj /* ** */
164
$desc =~ s#\n\s*/\*+[\s\*]+\*/\n#\n#sg;
165
166
# Don't bother to continue if there aren't any comments here
167
if(!($desc =~ m#/\*#)) {
168
return(" ");
169
}
170
171
# Remove lines generated by jmc
172
$desc =~ s#\n.*?Source date:.*\n#\n#;
173
$desc =~ s#\n.*?Generated by jmc.*\n#\n#;
174
175
# Extract the first comment
176
$desc =~ s#(?:.*?/\*+)(.*?)(?:(?:\*+/.*)|(?:$))#$1#s;
177
178
# Strip silly borders
179
$desc =~ s#\n\s*[\*\=\-\s]+#\n#sg;
180
181
# Strip beginning and trailing whitespace
182
$desc =~ s/^\s+//;
183
$desc =~ s/\s+$//;
184
185
# Strip out file name
186
$desc =~ s#$filename##i;
187
188
# Strip By line
189
$desc =~ s#By [^\n]*##;
190
191
# Strip out dates
192
$desc =~ s#\d{1,2}/\d{1,2}/\d\d\d\d##;
193
$desc =~ s#\d{1,2}/\d{1,2}/\d\d##;
194
$desc =~ s#\d{1,2} \w\w\w \d\d\d\d##;
195
196
# Strip junk from the beginning
197
$desc =~ s#[^\w]*##;
198
199
# Extract the first paragraph
200
$desc =~ s#(\n\s*?\n.*)##s;
201
202
# If the description is too long then just use the first sentence
203
# this will fail if no period was used.
204
if (length($desc) > 200 ) {
205
$desc =~ s#([^\.]+\.)\s.*#$1#s;
206
}
207
208
# If the description is still too long then assume it will look
209
# like gobbeldygook and give up
210
if (length($desc) > 200 ) {
211
return(" ");
212
}
213
214
# htmlify the comments, making links to symbols and files
215
$desc = markupstring($desc, $Path->{'virt'});
216
217
if ($desc) {
218
return($desc);
219
}
220
else {
221
return("\ \;");
222
}
75
my $filename = shift;
76
my $dir = shift;
77
my $release = shift;
78
my $linecount = 0;
79
my $copy = "";
80
local $desc = "";
81
my $maxlines = 40; #only look at the beginning of the file
82
83
#ignore files that aren't source code
84
if (
85
!(
86
($filename =~ /\.c$/) | ($filename =~ /\.h$/) | ($filename =~ /\.cc$/) |
87
($filename =~ /\.cp$/) | ($filename =~ /\.cpp$/) | ($filename =~ /\.java$/)
88
)
89
)
90
{
91
return ("\ \;");
92
}
93
94
if ($fh = $files->getfilehandle($dir . $filename, $release)) {
95
while (<$fh>) {
96
$desc = $desc . $_;
97
if ($linecount++ > 60) {
98
last;
99
}
100
}
101
close($file);
102
}
103
104
# sanity check: if there's no description then stop
105
if (!($desc =~ /\w/)) {
106
return ("\ \;");
107
}
108
109
# if a java file, only consider class-level javadoc comments
110
if ($filename =~ /\.java$/) {
111
112
# last /** ... */ before 'public class' or 'public interface'
113
114
# find declaration
115
$desc =~ m/public\s((abstract|static|final|strictfp)\s)*(class|interface)/g;
116
$declPos = pos $desc;
117
return "\ \;" if !$declPos;
118
119
# last comment start before declaration
120
pos $desc = 0;
121
$commentStart = -1;
122
while ($desc =~ m#/\*\*#g) {
123
last if $declPos < pos $desc;
124
$commentStart = pos $desc;
125
}
126
return "\ \;" if $commentStart == -1;
127
128
# find comment end, and extract
129
pos $desc = $commentStart;
130
$desc =~ m#\*/#g;
131
$commentEnd = pos $desc;
132
$desc = substr($desc, $commentStart + 3, $commentEnd - $commentStart - 5);
133
134
return "\ \;" if !$desc;
135
136
# strip off any leading * s
137
$desc =~ s/^\s*\*\s?//mg;
138
139
# Strip off @parameter lines
140
$desc =~ s/^\s*@\w+.*$//mg;
141
142
# strip html tags (probably a way to do this all in one, but it's beyond my skill)
143
$desc =~ s#<[/\w]+(\s*\w+="[\w\s]*"\s*)*>##g; # double quoted attributes
144
$desc =~ s#<[/\w]+(\s*\w+='[\w\s]*'\s*)*>##g; # single quoted attributes
145
$desc =~ s#<[/\w]+(\s*\w+=[\w]*\s*)*>##g; # no quotes on attributes
146
147
# strip off some CVS keyword lines
148
foreach $keyword ('Workfile', 'Revision', 'Modtime', 'Author', 'Id', 'Date', 'Source',
149
'RCSfile')
150
{
151
$desc =~ s/^\s*\$$keyword[\$:].*$//mg;
152
}
153
154
}
155
156
# save a copy for later
157
$copy = $desc;
158
159
# Look for well behaved <filename><seperator> formatted
160
# descriptions before we go to the trouble of looking for
161
# one in the first comment. The whitespace between the
162
# delimeter and the description may include a newline.
163
if ( ($desc =~ s/(?:.*?$filename\s*?- ?-*\s*)([^\n]*)(?:.*)/$1/sgi)
164
|| ($desc =~ s/(?:.*?$filename\s*?:\s*)([^\n]*)(?:.*)/$1/sgi)
165
|| ($desc =~ s/(?:.*?Description:\s*)([^\n]*)(?:.*)/$1/sgi))
166
{
167
168
# if the description is non-empty then clean it up and return it
169
if ($desc =~ /\w/) {
170
171
#strip trailing asterisks and "*/"
172
$desc =~ s#\*/?\s*$##;
173
$desc =~ s#^[^\S]*\**[^\S]*#\n#gs;
174
175
# Strip beginning and trailing whitespace
176
$desc =~ s/^\s+//;
177
$desc =~ s/\s+$//;
178
179
# Strip junk from the beginning
180
$desc =~ s#[^\w]*##ms;
181
182
#htmlify the comments making links to symbols and files
183
$desc = markupstring($desc, $Path->{'virt'});
184
return ($desc);
185
}
186
}
187
188
# if java and the <filename><seperator> check above didn't work, just dump the whole javadoc
189
if ($filename =~ /\.java$/) {
190
return $desc;
191
}
192
193
# we didn't find any well behaved descriptions above so start over
194
# and look for one in the first comment
195
$desc = $copy;
196
197
# Strip off code from the end, starting at the first cpp directive
198
$desc =~ s/\n#.*//s;
199
200
# Strip off code from the end, starting at typedef
201
$desc =~ s/\ntypedef.*//s;
202
203
# Strip off license
204
$desc =~ s#(?:/\*.*license.*?\*/)(.*)#$1#is;
205
206
# Strip off copyright notice
207
$desc =~ s#(?:/\*.*copyright.*?\*/)(.*)#$1#is;
208
209
# Strip off emacs line
210
$desc =~ s#(/\*.*tab-width.*?\*/)(.*)#$2#isg;
211
212
# excise rcs crud
213
$desc =~ s#Id: $filename.*?Exp \$##g;
214
215
# Yuck, nuke these silly comments in js/jsj /* ** */
216
$desc =~ s#\n\s*/\*+[\s\*]+\*/\n#\n#sg;
217
218
# Don't bother to continue if there aren't any comments here
219
if (!($desc =~ m#/\*#)) {
220
return (" ");
221
}
222
223
# Remove lines generated by jmc
224
$desc =~ s#\n.*?Source date:.*\n#\n#;
225
$desc =~ s#\n.*?Generated by jmc.*\n#\n#;
226
227
# Extract the first comment
228
$desc =~ s#(?:.*?/\*+)(.*?)(?:(?:\*+/.*)|(?:$))#$1#s;
229
230
# Strip silly borders
231
$desc =~ s#\n\s*[\*\=\-\s]+#\n#sg;
232
233
# Strip beginning and trailing whitespace
234
$desc =~ s/^\s+//;
235
$desc =~ s/\s+$//;
236
237
# Strip out file name
238
$desc =~ s#$filename##i;
239
240
# Strip By line
241
$desc =~ s#By [^\n]*##;
242
243
# Strip out dates
244
$desc =~ s#\d{1,2}/\d{1,2}/\d\d\d\d##;
245
$desc =~ s#\d{1,2}/\d{1,2}/\d\d##;
246
$desc =~ s#\d{1,2} \w\w\w \d\d\d\d##;
247
248
# Strip junk from the beginning
249
$desc =~ s#[^\w]*##;
250
251
# Extract the first paragraph
252
$desc =~ s#(\n\s*?\n.*)##s;
253
254
# If the description is too long then just use the first sentence
255
# this will fail if no period was used.
256
if (length($desc) > 200) {
257
$desc =~ s#([^\.]+\.)\s.*#$1#s;
258
}
259
260
# If the description is still too long then assume it will look
261
# like gobbeldygook and give up
262
if (length($desc) > 200) {
263
return (" ");
264
}
265
266
# htmlify the comments, making links to symbols and files
267
$desc = markupstring($desc, $Path->{'virt'});
268
269
if ($desc) {
270
return ($desc);
271
} else {
272
return ("\ \;");
273
}
223
274
}
224
275
225
226
227
276
# dme: create a short description for a subdirectory in a directory listing
228
277
# If no description, return the string "\ \;" to keep the
229
278
# table looking pretty.
230
279
#
231
# In Mozilla, if the directory has a README file look in it for lines
280
# In Mozilla, if the directory has a README file look in it for lines
232
281
# like the ones used in source code: "directoryname --- A short description"
233
282
sub descexpand {
234
my ($templ, $node, $dir, $index) = @_;
235
236
if ($$index{$node}) {
237
return LXR::Common::expandtemplate($templ,
238
('desctext',
239
sub { return $$index{$node} }));
240
}
241
else {
242
return "\ \;";
243
}
283
my ($templ, $node, $dir, $release) = @_;
284
if ($files->isdir($dir . $node, $release)) {
285
return LXR::Common::expandtemplate($templ,
286
('desctext' => sub { return dirdesc($dir . $node, $release); }));
287
} else {
288
return LXR::Common::expandtemplate($templ,
289
('desctext' => sub { return fdescexpand($node, $dir, $release); }));
290
}
244
291
}
245
292
246
# dme: Print a descriptive blurb in directory listings between
293
# dme: Print a descriptive blurb in directory listings between
247
294
# the document heading and the table containing the actual listing.
248
295
#
249
296
# For Mozilla, we extract this information from the README file if
250
297
# it exists. If the file is short then just print the whole thing.
251
# For longer files print the first paragraph or so. As much as
252
# possible make this work for randomly formatted files rather than
298
# For longer files print the first paragraph or so. As much as
299
# possible make this work for randomly formatted files rather than
253
300
# inventing strict rules which create gobbeldygook when they're broken.
254
301
sub dirdesc {
255
my ($path) = @_;
256
257
if (-f $Path->{'real'}."/README") {
258
descreadme($path);
259
} elsif (-f $Path->{'real'}."/README.html") {
260
descreadmehtml($path);
261
}
302
my ($path, $release) = @_;
303
if ($files->isfile($path . "README.txt", $release)) {
304
descreadme($path . "README.txt", $release);
305
} elsif ($files->isfile($path . "README", $release)) {
306
descreadme($path . "README", $release);
307
} elsif ($files->isfile($path . "README.html", $release)) {
308
descreadmehtml($path . "README.html", $release);
309
}
262
310
}
263
311
264
265
312
sub descreadmehtml {
266
my ($path) = @_;
267
268
my $string = "";
269
270
if (!(open(DESC, $Path->{'real'}."/README.html"))) {
271
return;
272
}
273
# undef $/;
274
$string = <DESC>;
275
# $/ = "\n";
276
close(DESC);
277
278
# if the README is 0 length then give up
279
if (!$string) {
280
return;
281
}
282
283
# check if there's a short desc nested inside the long desc. If not, do
284
# a non-greedy search for a long desc. assume there are no other stray
285
# spans within the description.
286
if ($string =~ /<span class=["']?lxrlongdesc['"]?>(.*?<span class=["']?lxrshortdesc['"]?>.*?<\/span>.*?)<\/span>/is) {
287
$long = $1;
288
if (!($long =~ /<span.*?\<span/is)) {
289
print($long . "<p>\nSEE ALSO: <a href=\"README.html\">README</a></p>\n");
290
}
291
} elsif ($string =~ /<span class=["']?lxrlongdesc['"]?>(.*?)<\/span>/is) {
292
$long = $1;
293
if (!($long =~ /\<span/is)) {
294
print($long . "<p>\nSEE ALSO: <a href=\"README.html\">README</a></p>\n");
295
}
296
}
313
my ($file, $release) = @_;
314
315
my $string = "";
316
return if !($desc = $files->getfilehandle($file, $release));
317
318
# undef $/;
319
$string = <$desc>;
320
321
# $/ = "\n";
322
close($desc);
323
324
# if the README is 0 length then give up
325
if (!$string) {
326
return;
327
}
328
329
# check if there's a short desc nested inside the long desc. If not, do
330
# a non-greedy search for a long desc. assume there are no other stray
331
# spans within the description.
332
if ($string =~
333
/<span class=["']?lxrlongdesc['"]?>(.*?<span class=["']?lxrshortdesc['"]?>.*?<\/span>.*?)<\/span>/is
334
)
335
{
336
$long = $1;
337
if (!($long =~ /<span.*?\<span/is)) {
338
return ($long . "<p>\nSEE ALSO: <a href=\"README.html\">README</a></p>\n");
339
}
340
} elsif ($string =~ /<span class=["']?lxrlongdesc['"]?>(.*?)<\/span>/is) {
341
$long = $1;
342
if (!($long =~ /\<span/is)) {
343
return ($long . "<p>\nSEE ALSO: <a href=\"README.html\">README</a></p>\n");
344
}
345
}
297
346
}
298
347
299
348
sub descreadme {
300
my ($path) = @_;
301
302
my $string = "";
303
# $string =~ s#(</?([^>^\s]+[^>]*)>.*$)#($2~/B|A|IMG|FONT|BR|EM|I|TT/i)?$1:""#sg;
304
my $n;
305
my $count;
306
my $temp;
307
308
my $maxlines = 20; # If file is less than this then just print it all
309
my $minlines = 5; # Too small. Go back and add another paragraph.
310
my $chopto = 10; # Truncate long READMEs to this length
311
312
if (!(open(DESC, $Path->{'real'}."/README"))) {
313
return;
314
}
315
316
# undef $/;
317
$string = <DESC>;
318
# $/ = "\n";
319
close(DESC);
320
321
# if the README is 0 length then give up
322
if (!$string){
323
return;
324
}
325
# strip the emacs tab line
326
$string =~ s/.*tab-width:[ \t]*([0-9]+).*\n//;
327
328
# strip the npl
329
$string =~ s/.*The contents of this .* All Rights.*Reserved\.//s;
330
331
# strip the short description from the beginning
332
$path =~ s#/(.+)/#$1#;
333
$string =~ s/.*$path\/*\s+--- .*//;
334
335
# strip away junk
336
$string =~ s/#+\s*\n/\n/;
337
$string =~ s/---+\s*\n/\n/g;
338
$string =~ s/===+\s*\n/\n/g;
339
340
# strip blank lines at beginning and end of file.
341
$string =~ s/^\s*\n//gs;
342
$string =~ s/\s*\n$//gs;
343
chomp($string);
344
$_ = $string;
345
$count = tr/\n//;
346
347
# If the file is small there's not much use splitting it up.
348
# Just print it all
349
if ($count <= $maxlines) {
350
$string = markupstring($string, $Path->{'virt'});
351
$string = convertwhitespace($string);
352
print($string);
353
} else {
354
# grab the first n paragraphs, with n decreasing until the
355
# string is 10 lines or shorter or until we're down to
356
# one paragraph.
357
$n = 6;
358
$temp = $string;
359
while ( ($count > $chopto) && ($n-- > 1) ) {
360
$string =~ s/^((?:(?:[\S\t ]*?\n)+?[\t ]*\n){$n}?)(.*)/$1/s;
361
$_ = $string;
362
$string =~ s/\s*\n$//gs;
363
$count = tr/\n//;
349
my ($file, $release) = @_;
350
351
my $string = "";
352
353
# $string =~ s#(</?([^>^\s]+[^>]*)>.*$)#($2~/B|A|IMG|FONT|BR|EM|I|TT/i)?$1:""#sg;
354
my $n;
355
my $count;
356
my $temp;
357
358
my $maxlines = 20; # If file is less than this then just print it all
359
my $minlines = 5; # Too small. Go back and add another paragraph.
360
my $chopto = 10; # Truncate long READMEs to this length
361
362
return if !($desc = $files->getfilehandle($file, $release));
363
364
# undef $/;
365
$string = <$desc>;
366
367
# $/ = "\n";
368
close($desc);
369
370
# if the README is 0 length then give up
371
if (!$string) {
372
return;
364
373
}
365
374
366
# if we have too few lines then back up and grab another paragraph
367
$_ = $string;
375
# strip the emacs tab line
376
$string =~ s/.*tab-width:[ \t]*([0-9]+).*\n//;
377
378
# strip the npl
379
$string =~ s/.*The contents of this .* All Rights.*Reserved\.//s;
380
381
# strip the short description from the beginning
382
$path =~ s#/(.+)/#$1#;
383
$string =~ s/.*$path\/*\s+--- .*//;
384
385
# strip away junk
386
$string =~ s/#+\s*\n/\n/;
387
$string =~ s/---+\s*\n/\n/g;
388
$string =~ s/===+\s*\n/\n/g;
389
390
# strip blank lines at beginning and end of file.
391
$string =~ s/^\s*\n//gs;
392
$string =~ s/\s*\n$//gs;
393
chomp($string);
394
$_ = $string;
368
395
$count = tr/\n//;
369
if ($count < $minlines) {
370
$n = $n+1;
371
$temp =~ s/^((?:(?:[\S\t ]*?\n)+?[\t ]*\n){$n}?)(.*)/$1/s;
372
$string = $temp;
396
397
# If the file is small there's not much use splitting it up.
398
# Just print it all
399
if ($count <= $maxlines) {
400
$string = markupstring($string, $Path->{'virt'});
401
$string = convertwhitespace($string);
402
return ($string);
403
} else {
404
405
# grab the first n paragraphs, with n decreasing until the
406
# string is 10 lines or shorter or until we're down to
407
# one paragraph.
408
$n = 6;
409
$temp = $string;
410
while (($count > $chopto) && ($n-- > 1)) {
411
$string =~ s/^((?:(?:[\S\t ]*?\n)+?[\t ]*\n){$n}?)(.*)/$1/s;
412
$_ = $string;
413
$string =~ s/\s*\n$//gs;
414
$count = tr/\n//;
415
}
416
417
# if we have too few lines then back up and grab another paragraph
418
$_ = $string;
419
$count = tr/\n//;
420
if ($count < $minlines) {
421
$n = $n + 1;
422
$temp =~ s/^((?:(?:[\S\t ]*?\n)+?[\t ]*\n){$n}?)(.*)/$1/s;
423
$string = $temp;
424
}
425
426
# if we have more than $maxlines then truncate to $chopto
427
# and add an elipsis.
428
if ($count > $maxlines) {
429
$string =~ s/^((?:[\S \t]*\n){$chopto}?)(.*)/$1/s;
430
chomp($string);
431
$string = $string . "\n...";
432
}
433
434
# since not all of the README is displayed here,
435
# add a link to it.
436
chomp($string);
437
if ($string =~ /SEE ALSO/) {
438
$string = $string . ", README";
439
} else {
440
$string = $string . "\n\nSEE ALSO: README";
441
}
442
443
$string = markupstring($string, $Path->{'virt'});
444
$string = convertwhitespace($string);
445
446
# strip blank lines at beginning and end of file again
447
$string =~ s/^\s*\n//gs;
448
$string =~ s/\s*\n$//gs;
449
chomp($string);
450
451
return ($string);
373
452
}
374
375
# if we have more than $maxlines then truncate to $chopto
376
# and add an elipsis.
377
if ($count > $maxlines) {
378
$string =~ s/^((?:[\S \t]*\n){$chopto}?)(.*)/$1/s;
379
chomp($string);
380
$string = $string . "\n...";
381
}
382
383
# since not all of the README is displayed here,
384
# add a link to it.
385
chomp($string);
386
if ($string =~ /SEE ALSO/) {
387
$string = $string . ", README";
388
} else {
389
$string = $string . "\n\nSEE ALSO: README";
390
}
391
392
$string = markupstring($string, $Path->{'virt'});
393
$string = convertwhitespace($string);
394
395
# strip blank lines at beginning and end of file again
396
$string =~ s/^\s*\n//gs;
397
$string =~ s/\s*\n$//gs;
398
chomp($string);
399
400
print($string . "<p>\n");
401
}
402
453
}
403
454
404
455
# dme: substitute carraige returns and spaces in original text
405
456
# for html equivalent so we don't need to use <pre> and can
406
457
# use variable width fonts but preserve the formatting
407
458
sub convertwhitespace {
408
my ($string) = @_;
409
410
# handle ascii bulleted lists
411
$string =~ s/<p>\n\s+o\s/<p>\n\ \;\ \;o /sg;
412
$string =~ s/\n\s+o\s/ \;\n<br>\ \;\ \;o /sg;
413
414
#find paragraph breaks and replace with <p>
415
$string =~ s/\n\s*\n/<p>\n/sg;
416
417
return($string);
459
my ($string) = @_;
460
461
# handle ascii bulleted lists
462
$string =~ s/<p>\n\s+o\s/<p>\n\ \;\ \;o /sg;
463
$string =~ s/\n\s+o\s/ \;\n<br>\ \;\ \;o /sg;
464
465
#find paragraph breaks and replace with <p>
466
$string =~ s/\n\s*\n/<p>\n/sg;
467
468
return ($string);
418
469
}
419
470
420
421
471
1;
Loggerhead is a web-based interface for Breezy
Version: 2.0.1