| #!perl -w |
| # |
| # Licensed to the Apache Software Foundation (ASF) under one or more |
| # contributor license agreements. See the NOTICE file distributed with |
| # this work for additional information regarding copyright ownership. |
| # The ASF licenses this file to You under the Apache License, Version 2.0 |
| # (the "License"); you may not use this file except in compliance with |
| # the License. You may obtain a copy of the License at |
| # |
| # http://www.apache.org/licenses/LICENSE-2.0 |
| # |
| # Unless required by applicable law or agreed to in writing, software |
| # distributed under the License is distributed on an "AS IS" BASIS, |
| # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. |
| # See the License for the specific language governing permissions and |
| # limitations under the License. |
| |
| package DocUtil; |
| use base 'Exporter'; |
| |
| # against fat fingers |
| use strict; |
| use vars qw($ignore_files %suffix2lang @EXPORT_OK); |
| |
| use base 'Exporter'; |
| @EXPORT_OK = qw($ignore_files %suffix2lang docpath srcinfo prefix); |
| |
| # determine ignorable files |
| my $ignore_ext = qr/\.(?:bak|rej|orig|meta|[^.]*~)$/i; |
| my $ignore_dot = qr/^\./; |
| |
| $ignore_files = qr/(?:$ignore_dot)|(?:$ignore_ext)/; |
| |
| # translation table taken from httpd.conf: |
| # (only to be used if lang != suffix) |
| %suffix2lang = ( |
| dk => 'da', |
| po => 'pl', |
| ); |
| |
| # compute the absolute path of a relative docpath |
| use Cwd; |
| use File::Spec; |
| |
| my $docroot = $ENV{DOCROOT}; |
| my ($rvol, $dir) = File::Spec->splitpath($docroot, 1); |
| my @dirs = File::Spec->splitdir($dir); |
| |
| sub docpath(;$) { |
| my $addpath = shift; |
| $addpath = '' unless defined $addpath; |
| |
| my @addpaths = grep length => split('/+' => $addpath); |
| my $file = ''; |
| $file = pop @addpaths if @addpaths; |
| |
| File::Spec->catpath( |
| $rvol, |
| File::Spec->catdir(@dirs, @addpaths), |
| $file |
| ); |
| } |
| |
| sub srcinfo(;$) { |
| my ($vol, $dir, $basename) = File::Spec->splitpath(shift or $ARGV[1]); |
| |
| die "Call error, CWD must be the doc root directory, stopped" |
| if ($rvol ne $vol); |
| |
| my $docpath = File::Spec->abs2rel( |
| File::Spec->catpath($vol, $dir, ''), |
| $docroot |
| ); |
| |
| # remove suffix from basename |
| $basename =~ s/\Q$ARGV[0]\E$//; |
| |
| # use HTTP path separators (/) |
| $docpath = join '/' => ('', File::Spec->splitdir($docpath), ''); |
| 1 while ($docpath =~ s,/\./,/,g); # something's bogus on the Mac otherwise |
| $docpath =~ y,/,/,s; # squeeze multiple slashes |
| |
| # compute relative (HTTP-)path from srcfile to docroot |
| my $relative = (join '/' => ('..') x ($docpath =~ y,/,, - 1)) || '.'; |
| |
| # address metafile |
| my $metafile = "$docpath$basename.xml.meta"; |
| |
| ($docpath, $basename, $relative, $metafile); |
| } |
| |
| sub prefix(@) { |
| my ($vol, $dir) = File::Spec->splitpath($ARGV[1], 1); |
| |
| map {File::Spec->catpath($vol, $dir, $_)} @_; |
| } |
| |
| 42; |