html.pm

视频监控网络部分的协议ddns,的模块的实现代码,请大家大胆指正.

		     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  }
	(?=
	    &quot; &gt;		# 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) = ("&lt;", $1, "&gt;$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 = '<strong>' . process_text1( $lev, $rstr ) . '</strong>';

    } 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 = '<em class="file">' . process_text1( $lev, $rstr ) . '</em>';

    } elsif( $func eq 'I' ){
	# I<text> - italicize
	$res = '<em>' . process_text1( $lev, $rstr ) . '</em>';

    } 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;
	}

	# 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 = '<em>' . process_text1( $lev, $rstr ) . '</em>';
        }

    } elsif( $func eq 'S' ){
	# S<text> - non-breaking spaces
	$res = process_text1( $lev, $rstr );
	$res =~ s/ /&nbsp;/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( defined( $url ) &&
        (!defined( $EmittedItem ) || $EmittedItem ne $fid ) ){
	$res = "<a href=\"$url\"><code>$linktext</code></a>";