dirent-win32.h « dirent « src - torxchat.git - Unnamed repository; edit this file 'description' to name the repository.

blob: cf3fe56763c266eb22faa7f320f916328963d7cc (plain) (tree)

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

d03d6e60 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

d03d6e60 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

d03d6e60 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

d03d6e60 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

d03d6e60 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

d03d6e60 ^

8a9d3e21 ^

d03d6e60 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

d03d6e60 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 ^

06226c07 ^

8a9d3e21 generated by cgit-pink 1.4.1 (git 2.36.1) at 2025-02-13 23:05:20 +0000

="w"> if $fid; } } # # process_head - convert a pod head[1-6] tag and convert it to HTML format. # sub process_head { my ( $tag, $heading, $hasindex ) = @_; # figure out the level of the =head $tag =~ /head([1-6])/; my $level = $1; if ($Listlevel) { warn "$0: $Podfile: unterminated list at =head in paragraph $Paragraph. ignoring.\n" unless $Quiet; while ($Listlevel) { process_back(); } } print HTML "\n"; if ( $level == 1 && !$Top ) { print HTML "<a href=\"#__index__\">$Backlink</a>\n" if $hasindex and $Backlink; print HTML "\n<hr />\n"; } else { print HTML "\n"; } my $name = anchorify( depod($heading) ); my $convert = process_text( \$heading ); $convert =~ s{</?a[^>]+>}{}g; print HTML "<h$level><a name=\"$name\" />$convert</h$level>\n"; } # # emit_item_tag - print an =item's text # Note: The global $EmittedItem is used for inhibiting self-references. # my $EmittedItem; sub emit_item_tag($$$) { my ( $otext, $text, $compact ) = @_; my $item = fragment_id( depod($text), -generate ); Carp::confess( "Undefined fragment '$text' (" . depod($text) . ") from fragment_id() in emit_item_tag() in $Podfile" ) if !defined $item; $EmittedItem = $item; ### print STDERR "emit_item_tag=$item ($text)\n"; print HTML ''; if ( $Items_Named{$item}++ ) { print HTML process_text( \$otext ); } else { my $name = $item; $name = anchorify($name); print HTML #qq{<a name="$name" class="item">}, process_text( \$otext ), # '</a>' ; } print HTML "\n"; undef($EmittedItem); } sub emit_li { my ($tag) = @_; if ( $Items_Seen[$Listlevel]++ == 0 ) { push( @Listend, "</$tag>" ); print HTML "<$tag>\n"; } my $emitted = $tag eq 'dl' ? 'dt' : 'li'; print HTML "<$emitted>"; return $emitted; } # # process_item - convert a pod item tag and convert it to HTML format. # sub process_item { my ($otext) = @_; my $need_dd = 0; # set to 1 if we need a <dd></dd> after an item # lots of documents start a list without doing an =over. this is # bad! but, the proper thing to do seems to be to just assume # they did do an =over. so warn them once and then continue. if ( $Listlevel == 0 ) { warn "$0: $Podfile: unexpected =item directive in paragraph $Paragraph. ignoring.\n" unless $Quiet; process_over(); } # formatting: insert a paragraph if preceding item has >1 paragraph if ($After_Lpar) { print HTML $need_dd ? "</dd>\n" : "</li>\n" if $After_Lpar; $After_Lpar = 0; } # remove formatting instructions from the text my $text = depod($otext); my $emitted; # the tag actually emitted, used for closing # all the list variants: if ( $text =~ /\A\*/ ) { # bullet $emitted = emit_li('ul'); if ( $text =~ /\A\*\s+(\S.*)\Z/s ) { # with additional text my $tag = $1; $otext =~ s/\A\*\s+//; emit_item_tag( $otext, $tag, 1 ); } print HTML "</li>" } elsif ( $text =~ /\A\d+/ ) { # numbered list $emitted = emit_li('ol'); if ( $text =~ /\A(?>\d+\.?)\s*(\S.*)\Z/s ) { # with additional text my $tag = $1; $otext =~ s/\A\d+\.?\s*//; emit_item_tag( $otext, $tag, 1 ); } print HTML "</li>"; } else { # definition list $emitted = emit_li('dl'); if ( $text =~ /\A(.+)\Z/s ) { # should have text emit_item_tag( $otext, $text, 1 ); } $need_dd = 1; } print HTML "\n"; return $need_dd; } # # process_over - process a pod over tag and start a corresponding HTML list. # sub process_over { # start a new list $Listlevel++; push( @Items_Seen, 0 ); $After_Lpar = 0; } # # process_back - process a pod back tag and convert it to HTML format. # sub process_back { my $need_dd = shift; if ( $Listlevel == 0 ) { warn "$0: $Podfile: unexpected =back directive in paragraph $Paragraph. ignoring.\n" unless $Quiet; return; } # close off the list. note, I check to see if $Listend[$Listlevel] is # defined because an =item directive may have never appeared and thus # $Listend[$Listlevel] may have never been initialized. $Listlevel--; if ( defined $Listend[$Listlevel] ) { print HTML $need_dd ? "</dd>\n" : "</li>\n" if $After_Lpar; print HTML $Listend[$Listlevel]; print HTML "\n"; pop(@Listend); } $After_Lpar = 0; # clean up item count pop(@Items_Seen); } # # process_cut - process a pod cut tag, thus start ignoring pod directives. # sub process_cut { $Ignore = 1; } # # process_pod - process a pod tag, thus stop ignoring pod directives # until we see a corresponding cut. # sub process_pod { # no need to set $Ignore to 0 cause the main loop did it } # # process_for - process a =for pod tag. if it's for html, spit # it out verbatim, if illustration, center it, otherwise ignore it. # sub process_for { my ( $whom, $text ) = @_; if ( $whom =~ /^(pod2)?html$/i ) { print HTML $text; } elsif ( $whom =~ /^illustration$/i ) { 1 while chomp $text; for my $ext (qw[.png .gif .jpeg .jpg .tga .pcl .bmp]) { $text .= $ext, last if -r "$text$ext"; } print HTML qq{<img src="$text" alt="$text illustration" />}; } } # # process_begin - process a =begin pod tag. this pushes # whom we're beginning on the begin stack. if there's a # begin stack, we only print if it us. # sub process_begin { my ( $whom, $text ) = @_; $whom = lc($whom); push( @Begin_Stack, $whom ); if ( $whom =~ /^(pod2)?html$/ ) { print HTML $text if $text; } } # # process_end - process a =end pod tag. pop the # begin stack. die if we're mismatched. # sub process_end { my ( $whom, $text ) = @_; $whom = lc($whom); if ( !defined $Begin_Stack[-1] or $Begin_Stack[-1] ne $whom ) { Carp::confess( "Unmatched begin/end at chunk $Paragraph in pod $Podfile\n"); } pop(@Begin_Stack); } # # process_pre - indented paragraph, made into <pre></pre> # sub process_pre { my ($text) = @_; my ($rest); return if $Ignore; $rest = $$text; # insert spaces in place of tabs $rest =~ s#(.+)# my $line = $1; 1 while $line =~ s/(\t+)/' ' x ((length($1) * 8) - $-[0] % 8)/e; $line; #eg; # convert some special chars to HTML escapes $rest = html_escape($rest); # try and create links for all occurrences of perl.* within # the preformatted text. $rest =~ s{ (\s*)(perl\w+) }{ if ( defined $Pages{$2} ){ # is a link qq($1<a href="$Htmlroot/$Pages{$2}">$2</a>); } elsif (defined $Pages{dosify($2)}) { # is a link qq($1<a href="$Htmlroot/$Pages{dosify($2)}">$2</a>); } else { "$1$2"; } }xeg; $rest =~ s{ (<a\ href="?) ([^>:]*:)? ([^>:]*) \.pod: ([^>:]*:)? }{ my $url ; if ( $Htmlfileurl ne '' ){ # Here, we take advantage of the knowledge # that $Htmlfileurl ne '' implies $Htmlroot eq ''. # Since $Htmlroot eq '', we need to prepend $Htmldir # on the fron of the link to get the absolute path # of the link's target. We check for a leading '/' # to avoid corrupting links that are #, file:, etc. my $old_url = $3 ; $old_url = "$Htmldir$old_url" if $old_url =~ m{^\/}; $url = relativize_url( "$old_url.html", $Htmlfileurl ); } else { $url = "$3.html" ; } "$1$url" ; }xeg; # Look for embedded URLs and make them into links. We don't # relativize them since they are best left as the author intended. my $urls = '(' . join( '|', qw{ http telnet mailto news gopher file wais ftp } ) . ')'; my $ltrs = '\w'; my $gunk = '/#~:.?+=&%@!\-'; my $punc = '.:!?\-;'; my $any = "${ltrs}${gunk}${punc}"; $rest =~ s{ \b # start at word boundary ( # begin $1 { $urls : # need resource and a colon (?!:) # Ignore File::, among others. [$any] +? # followed by one or more of any valid # character, but be conservative and # take only what you need to.... ) # end $1 } (?= " > # maybe pre-quoted '<a href="...">' | # or: [$punc]* # 0 or more punctuation (?: # followed [^$any] # by a non-url char | # or $ # end of the string ) # | # or else $ # then end of the string ) }{<a href="$1">$1</a>}igox; # text should be as it is (verbatim) $$text = $rest; } # # pure text processing # # pure_text/inIS_text: differ with respect to automatic C<> recognition. # we don't want this to happen within IS # sub pure_text($) { my $text = shift(); process_puretext( $text, 1 ); } sub inIS_text($) { my $text = shift(); process_puretext( $text, 0 ); } # # process_puretext - process pure text (without pod-escapes) converting # double-quotes and handling implicit C<> links. # sub process_puretext { my ( $text, $notinIS ) = @_; ## Guessing at func() or [\$\@%&]*var references in plain text is destined ## to produce some strange looking ref's. uncomment to disable: ## $notinIS = 0; my ( @words, $lead, $trail ); # keep track of leading and trailing white-space $lead = ( $text =~ s/\A(\s+)//s ? $1 : "" ); $trail = ( $text =~ s/(\s+)\Z//s ? $1 : "" ); # split at space/non-space boundaries @words = split( /(?<=\s)(?=\S)|(?<=\S)(?=\s)/, $text ); # process each word individually foreach my $word (@words) { # skip space runs next if $word =~ /^\s*$/; # see if we can infer a link or a function call # # NOTE: This is a word based search, it won't automatically # mark "substr($var, 1, 2)" because the 1st word would be "substr($var" # User has to enclose those with proper C<> if ( $notinIS && $word =~ m/ ^([a-z_]{2,}) # The function name $ ([0-9][a-z]* # Manual page(1) or page(1M) |[^)]*[\$\@\%][^)]+ # ($foo), (1, @foo), (%hash) | # () ) $ ([.,;]?)$ # a possible punctuation follows /xi ) { # has parenthesis so should have been a C<> ref ## try for a pagename (perlXXX(1))? my ( $func, $args, $rest ) = ( $1, $2, $3 || '' ); if ( $args =~ /^\d+$/ ) { my $url = page_sect( $word, '' ); if ( defined $url ) { $word = qq(<a href="$url" class="man">the $word manpage</a>$rest); next; } } ## try function name for a link, append tt'ed argument list $word = emit_C( $func, '', "($args)" ) . $rest; #### disabled. either all (including $\W, $\w+{.*} etc.) or nothing. ## } elsif( $notinIS && $word =~ /^[\$\@%&*]+\w+$/) { ## # perl variables, should be a C<> ref ## $word = emit_C( $word ); } elsif ( $word =~ m,^\w+://\w, ) { # looks like a URL # Don't relativize it: leave it as the author intended $word = qq(<a href="$word">$word</a>); } elsif ( $word =~ /[\w.-]+\@[\w-]+\.\w/ ) { # looks like an e-mail address my ( $w1, $w2, $w3 ) = ( "", $word, "" ); ( $w1, $w2, $w3 ) = ( "(", $1, ")$2" ) if $word =~ /^$(.*?)$(,?)/; ( $w1, $w2, $w3 ) = ( "<", $1, ">$2" ) if $word =~ /^<(.*?)>(,?)/; $word = qq($w1<a href="mailto:$w2">$w2</a>$w3); } else { $word = html_escape($word) if $word =~ /["&<>]/; } } # put everything back together return $lead . join( '', @words ) . $trail; } # # process_text - handles plaintext that appears in the input pod file. # there may be pod commands embedded within the text so those must be # converted to html commands. # sub process_text1($$;$$); sub pattern ($) { $_[0] ? '\s+' . ( '>' x ( $_[0] + 1 ) ) : '>' } sub closing ($) { local ($_) = shift; ( defined && s/\s+\z// ) ? length : 0 } sub process_text { return if $Ignore; my ($tref) = @_; my $res = process_text1( 0, $tref ); $res =~ s/\s+$//s; $$tref = $res; } sub process_text_rfc_links { my $text = shift; # For every "RFCnnnn" or "RFC nnn", link it to the authoritative # ource. Do not use the /i modifier here. Require "RFC" to be written in # in capital letters. $text =~ s{ (?<=[^<>[:alpha:]]) # Make sure this is not an URL already (RFC\s*([0-9]{1,5}))(?![0-9]) # max 5 digits } {<a href="http://www.ietf.org/rfc/rfc$2.txt" class="rfc">$1</a>}gx; $text; } sub process_text1($$;$$) { my ( $lev, $rstr, $func, $closing ) = @_; my $res = ''; unless ( defined $func ) { $func = ''; $lev++; } if ( $func eq 'B' ) { # B<text> - boldface $res = '' . process_text1( $lev, $rstr ) . ''; } elsif ( $func eq 'C' ) { # C<code> - can be a ref or <code></code> # need to extract text my $par = go_ahead( $rstr, 'C', $closing ); ## clean-up of the link target my $text = depod($par); ### my $x = $par =~ /[BI]</ ? 'yes' : 'no' ; ### print STDERR "-->call emit_C($par) lev=$lev, par with BI=$x\n"; $res = emit_C( $text, $lev > 1 || ( $par =~ /[BI]</ ) ); } elsif ( $func eq 'E' ) { # E<x> - convert to character $$rstr =~ s/^([^>]*)>//; my $escape = $1; $escape =~ s/^(\d+|X[\dA-F]+)$/#$1/i; $res = "&$escape;"; } elsif ( $func eq 'F' ) { # F<filename> - italicize $res = '' . process_text1( $lev, $rstr ) . ''; } elsif ( $func eq 'I' ) { # I<text> - italicize $res = '' . process_text1( $lev, $rstr ) . ''; } elsif ( $func eq 'L' ) { # L<link> - link ## L<text|cross-ref> => produce text, use cross-ref for linking ## L<cross-ref> => make text from cross-ref ## need to extract text my $par = go_ahead( $rstr, 'L', $closing ); # some L<>'s that shouldn't be: # a) full-blown URL's are emitted as-is if ( $par =~ m{^\w+://}s ) { return make_URL_href($par); } # b) C<...> is stripped and treated as C<> if ( $par =~ /^C<(.*)>$/ ) { my $text = depod($1); return emit_C( $text, $lev > 1 || ( $par =~ /[BI]</ ) ); } # analyze the contents $par =~ s/\n/ /g; # undo word-wrapped tags my $opar = $par; my $linktext; if ( $par =~ s{^([^|]+)\|}{} ) { $linktext = $1; } if( $par =~ m{^\w+://}s ) { return make_URL_href( $par, $linktext ); } # make sure sections start with a / $par =~ s{^"}{/"}; my ( $page, $section, $ident ); # check for link patterns if ( $par =~ m{^([^/]+?)/(?!")(.*?)$} ) { # name/ident # we've got a name/ident (no quotes) if ( length $2 ) { ( $page, $ident ) = ( $1, $2 ); } else { ( $page, $section ) = ( $1, $2 ); } ### print STDERR "--> L<$par> to page $page, ident $ident\n"; } elsif ( $par =~ m{^(.*?)/"?(.*?)"?$} ) { # [name]/"section" # even though this should be a "section", we go for ident first ( $page, $ident ) = ( $1, $2 ); ### print STDERR "--> L<$par> to page $page, section $section\n"; } elsif ( $par =~ /\s/ ) { # this must be a section with missing quotes ( $page, $section ) = ( '', $par ); ### print STDERR "--> L<$par> to void page, section $section\n"; } else { ( $page, $section ) = ( $par, '' ); ### print STDERR "--> L<$par> to page $par, void section\n"; } # now, either $section or $ident is defined. the convoluted logic # below tries to resolve L<> according to what the user specified. # failing this, we try to find the next best thing... my ( $url, $ltext, $fid ); RESOLVE: { if ( defined $ident ) { ## try to resolve $ident as an item ( $url, $fid ) = coderef( $page, $ident ); if ($url) { if ( !defined($linktext) ) { $linktext = $ident; $linktext .= " in " if $ident && $page; $linktext .= "the $page manpage" if $page; } ### print STDERR "got coderef url=$url\n"; last RESOLVE; } ## no luck: go for a section (auto-quoting!) $section = $ident; } ## now go for a section my $htmlsection = htmlify($section); $url = page_sect( $page, $htmlsection ); if ($url) { if ( !defined($linktext) ) { $linktext = $section; $linktext .= " in " if $section && $page; $linktext .= "the $page manpage" if $page; } ### print STDERR "got page/section url=$url\n"; last RESOLVE; } ## no luck: go for an ident if ($section) { $ident = $section; } else { $ident = $page; $page = undef(); } ( $url, $fid ) = coderef( $page, $ident ); if ($url) { if ( !defined($linktext) ) { $linktext = $ident; $linktext .= " in " if $ident && $page; $linktext .= "the $page manpage" if $page; } ### print STDERR "got section=>coderef url=$url\n"; last RESOLVE; } # warning; show some text. $linktext = $opar unless defined $linktext; warn "$0: $Podfile: cannot resolve L<$opar> in paragraph $Paragraph.\n" unless $Quiet; } # now we have a URL or just plain code $$rstr = $linktext . '>' . $$rstr; if ( defined($url) ) { $res = "<a href=\"$url\">" . process_text1( $lev, $rstr ) . '</a>'; } else { $res = '' . process_text1( $lev, $rstr ) . ''; } } elsif ( $func eq 'S' ) { # S<text> - non-breaking spaces $res = process_text1( $lev, $rstr ); $res =~ s/ / /g; } elsif ( $func eq 'X' ) { # X<> - ignore warn "$0: $Podfile: invalid X<> in paragraph $Paragraph.\n" unless $$rstr =~ s/^[^>]*>// or $Quiet; } elsif ( $func eq 'Z' ) { # Z<> - empty warn "$0: $Podfile: invalid Z<> in paragraph $Paragraph.\n" unless $$rstr =~ s/^>// or $Quiet; } else { my $term = pattern $closing; while ( $$rstr =~ s/\A(.*?)(([BCEFILSXZ])<(<+[^\S\n]+)?|$term)//s ) { # all others: either recurse into new function or # terminate at closing angle bracket(s) my $pt = $1; $pt .= $2 if !$3 && $lev == 1; $res .= $lev == 1 ? pure_text($pt) : inIS_text($pt); return $res if !$3 && $lev > 1; if ($3) { $res .= process_text1( $lev, $rstr, $3, closing $4 ); } } if ( $lev == 1 ) { $res .= pure_text($$rstr); } elsif ( !$Quiet ) { my $snippet = substr( $$rstr, 0, 60 ); warn "$0: $Podfile: undelimited $func<> in paragraph $Paragraph: '$snippet'.\n" } $res = process_text_rfc_links($res); } return $res; } # # go_ahead: extract text of an IS (can be nested) # sub go_ahead($$$) { my ( $rstr, $func, $closing ) = @_; my $res = ''; my @closing = ($closing); while ( $$rstr =~ s/\A(.*?)(([BCEFILSXZ])<(<+\s+)?|@{[pattern $closing[0]]})//s ) { $res .= $1; unless ($3) { shift @closing; return $res unless @closing; } else { unshift @closing, closing $4; } $res .= $2; } unless ($Quiet) { my $snippet = substr( $$rstr, 0, 60 ); warn "$0: $Podfile: undelimited $func<> in paragraph $Paragraph (go_ahead): '$snippet'.\n"; } return $res; } # # emit_C - output result of C<text> # $text is the depod-ed text # sub emit_C($;$$) { my ( $text, $nocode, $args ) = @_; $args = '' unless defined $args; my $res; my ( $url, $fid ) = coderef( undef(), $text ); # need HTML-safe text my $linktext = html_escape("$text$args"); if ( $text !~ /^[\$@%]/ && defined($url) && ( !defined($EmittedItem) || $EmittedItem ne $fid ) ) { $res = "<a href=\"$url\"><code>$linktext</code></a>"; } elsif ( 0 && $nocode ) { $res = $linktext; } else { $res = "<code>$linktext</code>"; } return $res; } # # html_escape: make text safe for HTML # sub html_escape { my $rest = $_[0]; $rest =~ s/&/&/g; $rest =~ s/</</g; $rest =~ s/>/>/g; $rest =~ s/"/"/g; # ' is only in XHTML, not HTML4. Be conservative #$rest =~ s/'/'/g; return $rest; } # # dosify - convert filenames to 8.3 # sub dosify { my ($str) = @_; return lc($str) if $^O eq 'VMS'; # VMS just needs casing if ($Is83) { $str = lc $str; $str =~ s/(\.\w+)/substr ($1,0,4)/ge; $str =~ s/(\w+)/substr ($1,0,8)/ge; } return $str; } # # page_sect - make a URL from the text of a L<> # sub page_sect($$) { my ( $page, $section ) = @_; my ( $linktext, $page83, $link ); # work strings # check if we know that this is a section in this page if ( !defined $Pages{$page} && defined $Sections{$page} ) { $section = $page; $page = ""; ### print STDERR "reset page='', section=$section\n"; } $page83 = dosify($page); $page = $page83 if ( defined $Pages{$page83} ); if ( $page eq "" ) { $link = "#" . anchorify($section); } elsif ( $page =~ /::/ ) { $page =~ s,::,/,g; # Search page cache for an entry keyed under the html page name, # then look to see what directory that page might be in. NOTE: # this will only find one page. A better solution might be to produce # an intermediate page that is an index to all such pages. my $page_name = $page; $page_name =~ s,^.*/,,s; if ( defined( $Pages{$page_name} ) && $Pages{$page_name} =~ /([^:]*$page)\.(?:pod|pm):/ ) { $page = $1; } else { # NOTE: This branch assumes that all A::B pages are located in # $Htmlroot/A/B.html . This is often incorrect, since they are # often in $Htmlroot/lib/A/B.html or such like. Perhaps we could # analyze the contents of %Pages and figure out where any # cousins of A::B are, then assume that. So, if A::B isn't found, # but A::C is found in lib/A/C.pm, then A::B is assumed to be in # lib/A/B.pm. This is also limited, but it's an improvement. # Maybe a hints file so that the links point to the correct places # nonetheless? } $link = "$Htmlroot/$page.html"; $link .= "#" . anchorify($section) if ($section); } elsif ( !defined $Pages{$page} ) { $link = ""; } else { $section = anchorify($section) if $section ne ""; ### print STDERR "...section=$section\n"; # if there is a directory by the name of the page, then assume that an # appropriate section will exist in the subdirectory # if ($section ne "" && $Pages{$page} =~ /([^:]*[^(\.pod|\.pm)]):/) { if ( $section ne "" && $Pages{$page} =~ /([^:]*(?<!\.pod)(?<!\.pm)):/ ) { $link = "$Htmlroot/$1/$section.html"; ### print STDERR "...link=$link\n"; # since there is no directory by the name of the page, the section will # have to exist within a .html of the same name. thus, make sure there # is a .pod or .pm that might become that .html } else { $section = "#$section" if $section; ### print STDERR "...section=$section\n"; # check if there is a .pod with the page name. # for L<Foo>, Foo.(pod|pm) is preferred to A/Foo.(pod|pm) if ( $Pages{$page} =~ /([^:]*)\.(?:pod|pm):/ ) { $link = "$Htmlroot/$1.html$section"; } else { $link = ""; } } } if ($link) { # Here, we take advantage of the knowledge that $Htmlfileurl ne '' # implies $Htmlroot eq ''. This means that the link in question # needs a prefix of $Htmldir if it begins with '/'. The test for # the initial '/' is done to avoid '#'-only links, and to allow # for other kinds of links, like file:, ftp:, etc. my $url; if ( $Htmlfileurl ne '' ) { $link = "$Htmldir$link" if $link =~ m{^/}s; $url = relativize_url( $link, $Htmlfileurl ); # print( " b: [$link,$Htmlfileurl,$url]\n" ); } else { $url = $link; } return $url; } else { return undef(); } } # # relativize_url - convert an absolute URL to one relative to a base URL. # Assumes both end in a filename. # sub relativize_url { my ( $dest, $source ) = @_; my ( $dest_volume, $dest_directory, $dest_file ) = File::Spec::Unix->splitpath($dest); $dest = File::Spec::Unix->catpath( $dest_volume, $dest_directory, '' ); my ( $source_volume, $source_directory, $source_file ) = File::Spec::Unix->splitpath($source); $source = File::Spec::Unix->catpath( $source_volume, $source_directory, '' ); my $rel_path = ''; if ( $dest ne '' ) { $rel_path = File::Spec::Unix->abs2rel( $dest, $source ); } if ( $rel_path ne '' && substr( $rel_path, -1 ) ne '/' && substr( $dest_file, 0, 1 ) ne '#' ) { $rel_path .= "/$dest_file"; } else { $rel_path .= "$dest_file"; } return $rel_path; } # # coderef - make URL from the text of a C<> # sub coderef($$) { my ( $page, $item ) = @_; my ($url); my $fid = fragment_id($item); if ( defined($page) && $page ne "" ) { # we have been given a $page... $page =~ s{::}{/}g; Carp::confess( "Undefined fragment '$item' from fragment_id() in coderef() in $Podfile" ) if !defined $fid; # Do we take it? Item could be a section! my $base = $Items{$fid} || ""; $base =~ s{[^/]*/}{}; if ( $base ne "$page.html" ) { ### print STDERR "coderef( $page, $item ): items{$fid} = $Items{$fid} = $base => discard page!\n"; $page = undef(); } } else { # no page - local items precede cached items if ( defined($fid) ) { if ( exists $Local_Items{$fid} ) { $page = $Local_Items{$fid}; } else { $page = $Items{$fid}; } } } # if there was a pod file that we found earlier with an appropriate # =item directive, then create a link to that page. if ( defined $page ) { if ($page) { if ( exists $Pages{$page} and $Pages{$page} =~ /([^:.]*)\.[^:]*:/ ) { $page = $1 . '.html'; } my $link = "$Htmlroot/$page#" . anchorify($fid); # Here, we take advantage of the knowledge that $Htmlfileurl # ne '' implies $Htmlroot eq ''. if ( $Htmlfileurl ne '' ) { $link = "$Htmldir$link"; $url = relativize_url( $link, $Htmlfileurl ); } else { $url = $link; } } else { $url = "#" . anchorify($fid); } confess "url has space: $url" if $url =~ /"[^"]*\s[^"]*"/; } return ( $url, $fid ); } # # Adapted from Nick Ing-Simmons' PodToHtml package. sub relative_url { my $source_file = shift; my $destination_file = shift; my $source = URI::file->new_abs($source_file); my $uo = URI::file->new( $destination_file, $source )->abs; return $uo->rel->as_string; } # # finish_list - finish off any pending HTML lists. this should be called # after the entire pod file has been read and converted. # sub finish_list { while ( $Listlevel > 0 ) { print HTML "</dl>\n"; $Listlevel--; } } # # htmlify - converts a pod section specification to a suitable section # specification for HTML. Note that we keep spaces and special characters # except ", ? (Netscape problem) and the hyphen (writer's problem...). # sub htmlify { my ($heading) = @_; $heading =~ s/(\s+)/ /g; $heading =~ s/\s+\Z//; $heading =~ s/\A\s+//; # The hyphen is a disgrace to the English language. # $heading =~ s/[-"?]//g; $heading =~ s/["?]//g; $heading = lc($heading); return $heading; } # # similar to htmlify, but turns non-alphanumerics into underscores # sub anchorify { my ($anchor) = @_; $anchor =~ s/$[^)]*$//; $anchor = htmlify($anchor); $anchor =~ s/\W/_/g; $anchor =~ tr/_/_/s; return $anchor; } # # depod - convert text by eliminating all interior sequences # Note: can be called with copy or modify semantics # my %E2c; $E2c{lt} = '<'; $E2c{gt} = '>'; $E2c{sol} = '/'; $E2c{verbar} = '|'; $E2c{amp} = '&'; # in Tk's pods sub depod1($;$$); sub depod($) { my $string; if ( ref( $_[0] ) ) { $string = ${ $_[0] }; ${ $_[0] } = depod1( \$string ); } else { $string = $_[0]; depod1( \$string ); } } sub depod1($;$$) { my ( $rstr, $func, $closing ) = @_; my $res = ''; return $res unless defined $$rstr; if ( !defined($func) ) { # skip to next begin of an interior sequence while ( $$rstr =~ s/\A(.*?)([BCEFILSXZ])<(<+[^\S\n]+)?//s ) { # recurse into its text $res .= $1 . depod1( $rstr, $2, closing $3); } $res .= $$rstr; } elsif ( $func eq 'E' ) { # E<x> - convert to character $$rstr =~ s/^([^>]*)>//; $res .= $E2c{$1} || ""; } elsif ( $func eq 'X' ) { # X<> - ignore $$rstr =~ s/^[^>]*>//; } elsif ( $func eq 'Z' ) { # Z<> - empty $$rstr =~ s/^>//; } else { # all others: either recurse into new function or # terminate at closing angle bracket my $term = pattern $closing; while ( $$rstr =~ s/\A(.*?)(([BCEFILSXZ])<(<+[^\S\n]+)?|$term)//s ) { $res .= $1; last unless $3; $res .= depod1( $rstr, $3, closing $4 ); } ## If we're here and $2 ne '>': undelimited interior sequence. ## Ignored, as this is called without proper indication of where we are. ## Rely on process_text to produce diagnostics. } return $res; } { my %seen; # static fragment record hash sub fragment_id_readable { my $text = shift; my $generate = shift; # optional flag my $orig = $text; # leave the words for the fragment identifier, # change everything else to underbars. $text =~ s/[^A-Za-z0-9_]+/_/g; # do not use \W to avoid locale dependency. $text =~ s/_{2,}/_/g; $text =~ s/\A_//; $text =~ s/_\Z//; unless ($text) { # Nothing left after removing punctuation, so leave it as is # E.g. if option is named: "=item -#" $text = $orig; } if ($generate) { if ( exists $seen{$text} ) { # This already exists, make it unique $seen{$text}++; $text = $text . $seen{$text}; } else { $seen{$text} = 1; # first time seen this fragment } } $text; } } my @HC; sub fragment_id_obfuscated { # This was the old "_2d_2d__" my $text = shift; my $generate = shift; # optional flag # text? Normalize by obfuscating the fragment id to make it unique $text =~ s/\s+/_/sg; $text =~ s{(\W)}{ defined( $HC[ord($1)] ) ? $HC[ord($1)] : ( $HC[ord($1)] = sprintf( "%%%02X", ord($1) ) ) }gxe; $text = substr( $text, 0, 50 ); $text; } # # fragment_id - construct a fragment identifier from: # a) =item text # b) contents of C<...> # sub fragment_id { my $text = shift; my $generate = shift; # optional flag $text =~ s/\s+\Z//s; if ($text) { # a method or function? return $1 if $text =~ /(\w+)\s*\(/; return $1 if $text =~ /->\s*(\w+)\s*\(?/; # a variable name? return $1 if $text =~ /^([\$\@%*]\S+)/; # some pattern matching operator? return $1 if $text =~ m|^(\w+/).*/\w*$|; # fancy stuff... like "do { }" return $1 if $text =~ m|^(\w+)\s*{.*}$|; # honour the perlfunc manpage: func [PAR[,[ ]PAR]...] # and some funnies with ... Module ... return $1 if $text =~ m{^([a-z\d_]+)(\s+[A-Z,/& ][A-Z\d,/& ]*)?$}; return $1 if $text =~ m{^([a-z\d]+)\s+Module(\s+[A-Z\d,/& ]+)?$}; return fragment_id_readable( $text, $generate ); } else { return; } } # # make_URL_href - generate HTML href from URL # Special treatment for CGI queries. # sub make_URL_href($;$) { my ($url) = shift; my $linktext = shift || $url; if ( $url !~ s{^(http:[-\w/#~:.+=&%@!]+)(\?.*)$}{<a href="$1$2">$1</a>}i ) { $url = "<a href=\"$url\">$linktext</a>"; } return $url; } 1;