/usr/share/perl5/Debian/Dwww/DocBase.pm is in dwww 1.13.4.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 | # vim:ft=perl:cindent
#
# $Id: DocBase.pm,v 1.5 2003-05-16 17:22:33 robert Exp $
#
package Debian::Dwww::DocBase;
use Exporter();
use Debian::Dwww::Version;
use strict;
use vars qw(@ISA @EXPORT $ErrorProc);
@ISA = qw(Exporter);
@EXPORT = qw(ParseDocBaseFile DwwwSection2Section $ErrorProc);
sub ParseDocBaseFile {
my $file = shift;
my $format = undef;
my $entry = {};
my ($fld, $val, $lastfld) = ('', '', '');
my $line = 0;
local $_;
if (not open DOCFILE, $file) {
&$ErrorProc($file, "Can't be opened: $!");
return undef;
}
while (<DOCFILE>) {
chomp;
s/\s+$//;
$line++;
if (/^\s*$/) {
# empty lines separate sections
$format = ''; # here we define $format
$lastfld = '';
} elsif (/^(\S+)\s*:\s*(.*)\s*$/) {
($fld, $val) = (lc $1, $2);
if (not defined $format) {
$entry->{$fld} = $val;
} elsif ($format eq '' and $fld eq 'format') {
$format = lc $val;
} elsif ($format ne '' and $fld eq 'index') {
$entry->{'formats'}->{$format}->{'index'} = $val;
} elsif ($format ne '' and $fld eq 'files') {
$entry->{'formats'}->{$format}->{'files'} = $val;
} else {
goto PARSE_ERROR;
}
$lastfld = $fld;
} elsif (/^\s+/ and $lastfld ne '') {
$entry->{$lastfld} .= "\n$_";
} else {
goto PARSE_ERROR;
}
}
close DOCFILE;
return $entry;
PARSE_ERROR:
&$ErrorProc($file, "Parse error at line $line");
close DOCFILE;
return undef;
}
sub DwwwSection2Section {
my $entry = shift;
my $sec = $entry->{'dwww-section'} if defined $entry->{'dwww-section'};
my $title = defined $entry->{'dwww-title'} ? $entry->{'dwww-title'} :
defined $entry->{'title'} ? $entry->{'title'} : undef;
return unless defined $sec and defined $title;
if (length($sec) > length($title) &&
substr ($sec, -length($title)) eq $title) {
$sec = substr ($sec, 0, -length($title));
} else {
return;
}
$sec =~ s|^/+||;
$sec =~ s|/+$||;
$entry->{'section'} = $sec;
}
1;
|