view release on metacpan or  search on metacpan

lib/Apache2/PodBrowser.pm  view on Meta::CPAN

    sub _update_cache {
        my ($r, $fn, $force)=@_;
        my $db;
        eval {
            require MMapDB;
            if( !$force and exists $cachedb{$fn} ) {
                $db=$cachedb{$fn};
                $db->start;
            } else {
                if( exists $cachedb{$fn} ) {
                    $db=$cachedb{$fn};
                } else {
                    $cachedb{$fn}=$db=MMapDB->new(filename=>$fn);
                }
                if( !$db->start or $force ) {
                    $db->begin;
                    $db->clear;
                    my $i=0;
                    for my $m (__pod_idx $r) {
                        $db->insert([['idx'], pack("N",$i++), $m]);
                    }
                    $db->commit;
                }
            }
        };
        die ref $@ ? ${$@} : $@ if $@;
        $db->datamode=MMapDB::DATAMODE_SIMPLE();
        return wantarray ? @{$db->main_index->{idx}} : undef;
    }

    sub _index {
        my ($r, $force)=@_;

        my @links;
        my $dbfile;
        my $idxkind;

        _reset_link_generator;
        if( defined ($dbfile=$r->dir_config->get('CACHE')) ) {
            @links=map {_link($_, '')} _update_cache $r, $dbfile, $force;
            $idxkind=INDEX_PODCACHED;
        } else {
            @links=map {_link($_, '')} __pod_idx $r;
            $idxkind=INDEX_PODINDEX;
        }

        return (_header($idxkind, _stylesheet($r)).
                _gen_index.
                join("\n", @links)."\n".
                _footer);
    }
}

sub _scanit {
    my ($r, $fun, $where) = @_;
    local $_;

    $fun=~s/%([0-9A-Fa-f]{2})/pack('H2', $1)/eg;
    my $search_re = ($fun=~/^-[rwxoRWXOeszfdlpSbctugkTBMAC]$/
                     ? qr/^=item\s+(?:I<)?-X\b/
                     : $fun=~/^\$[1-9]/
                     ? qr/^=item\s+\$<I<digits>>/
                     : $fun=~/^\$</
                     ? qr/^=item\s+\$<(?!I<digits>>)/
                     : $fun=~/\w$/
                     ? qr/^=item\s+\Q$fun\E\b/
                     : qr/^=item\s+\Q$fun\E/);

    #warn "fun=$fun -- re=$search_re\n";

    my $document='';

    open my $f, '<', _findpod($r, $where, 1) or
        die \Apache2::Const::NOT_FOUND;
    # Skip introduction
    my $anchor=($where eq 'perlvar'
                ? qr/^=over 8/
                : qr/^=head2 Alphabetical Listing of Perl Functions/);
    while( <$f> ) {$_=~$anchor and last}

    # Look for our function
    my $found=0;
    my $inlist=0;
    my $prefix='';

    while( <$f> ) {
        if ( /$search_re/ )  {
            $found = 1;
        } elsif (/^=item/) {
            if ($found > 1 and !$inlist) {
                close $f;
                return "=over 4\n\n$prefix$document\n\n=back\n\n";
            } elsif (!$found and !$inlist) {
                $prefix.=$_."\n";
            }
        } elsif ($found > 1 and !$inlist and /^=back/) {
            close $f;
            return "=over 4\n\n$prefix$document\n\n=back\n\n";
        } elsif (!$found and /\S/) {
            $prefix='';
        }
        next unless $found;
        if (/^=over/) {
            ++$inlist;
        } elsif (/^=back/) {
            --$inlist;
        }
        $document .= "$_";
        ++$found if /^\w/;        # found descriptive text
    }

    die \Apache2::Const::NOT_FOUND;
}

sub _getpodfuncdoc {
    my ($r, $fun) = @_;

    foreach my $name (qw/perlfunc perlvar/) {
        my $doc=eval {_scanit $r, $fun, $name};
        return $doc unless $@;
    }