html.pm

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

		clean_data( \@poddata );

		scan_items( \%Items, "$dirname/$pod", @poddata);
	    }

	    # use the names of files as =item directives too.
### Don't think this should be done this way - confuses issues.(WL)
###	    foreach $pod (@files) {
###		$pod =~ /^(.*)(\.pod|\.pm)$/;
###		$Items{$1} = "$dirname/$1.html" if $1;
###	    }
	} elsif ($Pages{$libpod} =~ /([^:]*\.pod):/ ||
		 $Pages{$libpod} =~ /([^:]*\.pm):/) {
	    # scan the .pod or .pm file for =item directives
	    $pod = $1;
	    open(POD, "<$pod") ||
		die "$0: error opening $pod for input: $!\n";
	    @poddata = <POD>;
	    close(POD);
	    clean_data( \@poddata );

	    scan_items( \%Items, "$pod", @poddata);
	} else {
	    warn "$0: shouldn't be here (line ".__LINE__."\n" unless $Quiet;
	}
    }
    @poddata = ();	# clean-up a bit

    chdir($pwd)
	|| die "$0: error changing to directory $pwd: $!\n";

    # cache the item list for later use
    warn "caching items for later use\n" if $Verbose;
    open(CACHE, ">$Itemcache") ||
	die "$0: error open $Itemcache for writing: $!\n";

    print CACHE join(":", @Podpath) . "\n$podroot\n";
    foreach my $key (keys %Items) {
	print CACHE "$key $Items{$key}\n";
    }

    close(CACHE);

    # cache the directory list for later use
    warn "caching directories for later use\n" if $Verbose;
    open(CACHE, ">$Dircache") ||
	die "$0: error open $Dircache for writing: $!\n";

    print CACHE join(":", @Podpath) . "\n$podroot\n";
    foreach my $key (keys %Pages) {
	print CACHE "$key $Pages{$key}\n";
    }

    close(CACHE);
}

#
# scan_dir - scans the directory specified in $dir for subdirectories, .pod
#  files, and .pm files.  notes those that it finds.  this information will
#  be used later in order to figure out where the pages specified in L<>
#  links are on the filesystem.
#
sub scan_dir {
    my($dir, $recurse) = @_;
    my($t, @subdirs, @pods, $pod, $dirname, @dirs);
    local $_;

    @subdirs = ();
    @pods = ();

    opendir(DIR, $dir) ||
	die "$0: error opening directory $dir: $!\n";
    while (defined($_ = readdir(DIR))) {
	if (-d "$dir/$_" && $_ ne "." && $_ ne ".."
	    && ($HiddenDirs || !/^\./)
	) {         # directory
	    $Pages{$_}  = "" unless defined $Pages{$_};
	    $Pages{$_} .= "$dir/$_:";
	    push(@subdirs, $_);
	} elsif (/\.pod\z/) {	    	    	    	    # .pod
	    s/\.pod\z//;
	    $Pages{$_}  = "" unless defined $Pages{$_};
	    $Pages{$_} .= "$dir/$_.pod:";
	    push(@pods, "$dir/$_.pod");
	} elsif (/\.html\z/) { 	    	    	    	    # .html
	    s/\.html\z//;
	    $Pages{$_}  = "" unless defined $Pages{$_};
	    $Pages{$_} .= "$dir/$_.pod:";
	} elsif (/\.pm\z/) { 	    	    	    	    # .pm
	    s/\.pm\z//;
	    $Pages{$_}  = "" unless defined $Pages{$_};
	    $Pages{$_} .= "$dir/$_.pm:";
	    push(@pods, "$dir/$_.pm");
	} elsif (-T "$dir/$_") {			    # script(?)
	    local *F;
	    if (open(F, "$dir/$_")) {
		my $line;
		while (defined($line = <F>)) {
		    if ($line =~ /^=(?:pod|head1)/) {
			$Pages{$_}  = "" unless defined $Pages{$_};
			$Pages{$_} .= "$dir/$_.pod:";
			last;
		    }
		}
		close(F);
	    }
	}
    }
    closedir(DIR);

    # recurse on the subdirectories if necessary
    if ($recurse) {
	foreach my $subdir (@subdirs) {
	    scan_dir("$dir/$subdir", $recurse);
	}
    }
}

#
# scan_headings - scan a pod file for head[1-6] tags, note the tags, and
#  build an index.
#
sub scan_headings {
    my($sections, @data) = @_;
    my($tag, $which_head, $otitle, $listdepth, $index);

    local $Ignore = 0;

    $listdepth = 0;
    $index = "";

    # scan for =head directives, note their name, and build an index
    #  pointing to each of them.
    foreach my $line (@data) {
      if ($line =~ /^=(head)([1-6])\s+(.*)/) {
        ($tag, $which_head, $otitle) = ($1,$2,$3);

        my $title = depod( $otitle );
        my $name = anchorify( $title );
        $$sections{$name} = 1;
        $title = process_text( \$otitle );

	    while ($which_head != $listdepth) {
		if ($which_head > $listdepth) {
		    $index .= "\n" . ("\t" x $listdepth) . "<ul>\n";
		    $listdepth++;
		} elsif ($which_head < $listdepth) {
		    $listdepth--;
		    $index .= "\n" . ("\t" x $listdepth) . "</ul>\n";
		}
	    }

	    $index .= "\n" . ("\t" x $listdepth) . "<li>" .
	              "<a href=\"#" . $name . "\">" .
		      $title . "</a></li>";
	}
    }

    # finish off the lists
    while ($listdepth--) {
	$index .= "\n" . ("\t" x $listdepth) . "</ul>\n";
    }

    # get rid of bogus lists
    $index =~ s,\t*<ul>\s*</ul>\n,,g;

    return $index;
}

#
# scan_items - scans the pod specified by $pod for =item directives.  we
#  will use this information later on in resolving C<> links.
#
sub scan_items {
    my( $itemref, $pod, @poddata ) = @_;
    my($i, $item);
    local $_;

    $pod =~ s/\.pod\z//;
    $pod .= ".html" if $pod;

    foreach $i (0..$#poddata) {
	my $txt = depod( $poddata[$i] );

	# figure out what kind of item it is.
	# Build string for referencing this item.
	if ( $txt =~ /\A=item\s+\*\s*(.*)\Z/s ) { # bullet
	    next unless $1;
	    $item = $1;
        } elsif( $txt =~ /\A=item\s+(?>\d+\.?)\s*(.*)\Z/s ) { # numbered list
	    $item = $1;
	} elsif( $txt =~ /\A=item\s+(.*)\Z/s ) { # plain item
	    $item = $1;
	} else {
	    next;
	}
	my $fid = fragment_id( $item );
	$$itemref{$fid} = "$pod" 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 "<p>\n";
    if( $level == 1 && ! $Top ){
      print HTML "<a href=\"#__index__\"><small>$Backlink</small></a>\n"
        if $hasindex and $Backlink;
      print HTML "</p>\n<hr />\n"
    } else {
      print HTML "</p>\n";
    }

    my $name = anchorify( depod( $heading ) );
    my $convert = process_text( \$heading );
    print HTML "<h$level><a name=\"$name\">$convert</a></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 '<strong>';
    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 "</strong>\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 );
        }

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

    } 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{<p align="center"><img src="$text" alt="$text illustration" /></p>};
    }
}

#
# 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