package Pod::XHtml; use strict; use vars qw($VERSION); $VERSION = 0.01; use Carp; use Config; use Cwd; use File::Spec::Unix; use Getopt::Long; use Pod::Functions; use POSIX 'strftime'; use diagnostics; use locale; {my$singleton; sub new{return$singleton if$singleton; my$class=shift; my$self=bless{},$class; $self->init_globals(1); $singleton=$self; return$self;}sub class_obj{Carp::confess"$_[0]" unless ref($_[0])eq 'P +od::XHtml'||$_[0]eq 'Pod::XHtml'; return$_[0]if ref$_[0]; return$_[0]->new();}}sub init_globals{my$self=shift->class_obj; my$new=shift; $self->{cache_ext}=$^O eq 'VMS'?".tmp":".x~~"; my$init={dircache=>"pod2xhtmd$self->{cache_ext}",itemcache=>"pod2xhtmi +$self->{cache_ext}",begin_stack=>[],libpods=>[],htmlroot=>"/",htmldir +=>"",htmlfile=>"",htmlfileurl=>"",podfile=>"",podpath=>[],podroot=>". +",css=>'',recurse=>1,quiet=>0,verbose=>0,doindex=>1,backlink=>'',list +level=>0,listend=>[],after_lpar=>0,ignore=>1,items_named=>{},items_se +en=>[],stack=>[],netscape=>0,title=>undef,header=>0,top=>1,paragraph= +>undef,ptQuote=>0,ldq=>'``',rdq=>"''",sections=>{},*items=>{},local_i +tems=>{},printed_items=>{},Is83=>undef,usage=>undef,saved_cache_key=> +undef,EmittedItem=>undef,HTML=>[],E2c=>{lt=>'<',gt=>'>',sol=>'/',verb +ar=>'|',amp=>'&',},}; $self->{$_}=$init->{$_}foreach keys%$init; if($new){$self->{pages}={}; $self->{items}={}; $self->{hc}=[]; $self->{c_index}={};}$self->{usage}= <<END_OF_USAGE; Usage: $0 --help --htmlroot=<name> --infile=<name> --outfile=<name> --podpath=<name>:...:<name> --podroot=<name> --libpods=<name>:...:<name> --recurse --verbose --index --netscape --norecurse --noindex --backlink - set text for "back to top" links (default: none). --css - stylesheet URL --flush - flushes the item and directory caches. --[no]header - produce block header/footer (default is no headers) +. --help - prints this message. --htmldir - directory for resulting HTML files. --htmlroot - http-server base directory from which all relative +paths in podpath stem (default is /). --[no]index - generate an index at the top of the resulting html (default behaviour). --infile - filename for the pod to convert (input taken from s +tdin by default). --libpods - colon-separated list of pages to search for =item p +od directives in as targets of C<> and implicit links +(empty by default). note, these are not filenames, but ra +ther page names like those that appear in L<> links. --[no]netscape - will use netscape html directives when applicable. (default is not to use them). --outfile - filename for the resulting html file (output sent t +o stdout by default). --podpath - colon-separated list of directories containing libr +ary pods (empty by default). --podroot - filesystem base directory from which all relative p +aths in podpath stem (default is .). --[no]quiet - supress some benign warning messages (default is of +f). --[no]recurse - recurse on those subdirectories listed in podpath (default behaviour). --title - title that will appear in resulting html file. --[no]verbose - self-explanatory (off by default). END_OF_USAGE return$self;}sub clean_data{my$self=shift->class_obj; my$dataref=shift; for my $i(0..$#$dataref){$dataref->[$i]=~s/\s+\Z//; if($dataref->[$i]=~/^\s+$/m){my@chunks=split(/^\s+$/m,$dataref->[$i]); splice(@$dataref,$i,1,@chunks);}}}sub find_title{my$self=shift->class_ +obj; my$poddata=shift; unless($self->{title}){TITLE_SEARCH:{for my $i(0..$#$poddata){if($podd +ata->[$i]=~/^=head1\s*NAME\b/m){for my $para(@$poddata[$i,$i+1]){last + TITLE_SEARCH if($self->{title})=$para=~/(\S+\s+-+.*\S)/s;}}}}warn"us +ing '$self->{title}' as title" if$self->{title}&&$self->{verbose};}if +(!$self->{title}and$self->{podfile}=~/\.pod\z/){for my $i(0..$#$podda +ta){last if($self->{title})=$poddata->[$i]=~/^=head[12]\s*(.*)/;}warn +"adopted '$self->{title}' as title for $self->{podfile}\n" if$self->{ +verbose}and$self->{title};}if($self->{title}){$self->{title}=~s/\s*\( +.*\)//;}else{warn ref($self).": no title for $self->{podfile}" unless +$self->{quiet}; $self->{podfile}=~/^(.*)(\.[^.\/]+)?\z/s; $self->{title}=($self->{podfile}eq"-"?'No Title':$1); warn"using $self->{title}" if$self->{verbose};}}sub print_headers{my$s +elf=shift->class_obj; my$csslink=$self->{css}?qq(\n<link rel="stylesheet" href="$self->{css} +" type="text/css">):''; $csslink=~s,\\,/,g; $csslink=~s,(/.):,$1|,; my($creator)=$0=~/[\/\\]([^\/\\.]+)\..*$/; my$create_time=strftime("%Y/%m/%d %H:%M:%S %Z",localtime); my$block=$self->{header}? <<END_OF_BLOCK :''; <h1 class="title"> $self->{title}</h1> END_OF_BLOCK push@{$self->{HTML}}, <<END_OF_HEAD; <?xml version="1.0" encoding="UTF-8"?> <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 TRANSITIONAL//EN" " HTTP://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en"> <head> <title>$self->{title}</title> $csslink <link rev="made" href="mailto:$Config{perladmin}" /> <meta name="generator_name" contents="$creator" /> <meta name="generator_ver" contents="$VERSION" /> <meta name="date_generated" contents="$create_time" /> </head> <body> $block END_OF_HEAD return$block;}sub print_index{my$self=shift->class_obj; my$index=shift; return unless$index; $index=~s/--+/-/g; push@{$self->{HTML}}," <a class=\"idxstart\" id=\"__index__\">< +/a>\n"; push@{$self->{HTML}}," <!-- INDEX BEGIN -->\n"; push@{$self->{HTML}}," <!--\n" unless$self->{doindex}; push@{$self->{HTML}},$index; push@{$self->{HTML}}," -->\n" unless$self->{doindex}; push@{$self->{HTML}}," <!-- INDEX END -->\n\n"; push@{$self->{HTML}}," <hr />\n" if$self->{doindex}and$index;}s +ub open_filehandles_get_pod{my$self=shift->class_obj; local*POD; unless(@ARGV&&$ARGV[0]){$self->{podfile}="-" unless$self->{podfile}; open(POD,"<$self->{podfile}")||die ref($self)." cannot open $self->{po +dfile} file for input: $!\n";}else{$self->{podfile}=$ARGV[0]; *POD=*ARGV;}$self->{htmlfile}="-" unless$self->{htmlfile}; $self->{htmlroot}="" if$self->{htmlroot}eq"/"; $self->{htmldir}=~s#/\z##; if($self->{htmlroot}eq ''&&defined($self->{htmldir})&&$self->{htmldir} +ne ''&&substr($self->{htmlfile},0,length($self->{htmldir}))eq$self->{ +htmldir}){$self->{htmlfileurl}="$self->{htmldir}/".substr($self->{htm +lfile},length($self->{htmldir})+1);}warn"Scanning for sections in inp +ut file(s)\n" if$self->{verbose}; $/=""; my@return=<POD>; close(POD); open(HTML,">$self->{htmlfile}")||die ref($self)." cannot open $self->{ +htmlfile} file for output: $!\n"; return@return;}sub text_to_table{my$self=shift->class_obj; my$text=shift; if($text=~/\t/){my@lines=split("\n",$text); my@split; my$width; if(@lines>1){my$all=2; foreach my $line(@lines){if($line=~/\S/&&$line!~/\t/){$all--; last if$all==0;}my@row=split/\t/,$line; $width=$#row unless$width&&$width>$#row; push@split,\@row;}if($all>0){my$tablename=$split[0][0]; $tablename=~tr[- +."<>] [__]d; my$hasheader=0; if($lines[1]!~/[^-\t\s]/&&(@{$split[1]}==@{$split[0]})){$split[1]=$spl +it[0]; shift@split; my$row='<tr class="expr_tabs_hdr">'; {no warnings; $row.=qq'<th class="expr_tabs">$split[$row][$_]</th>' foreach 0..$widt +h;}$row.="</tr>\n"; $split[0]=$row; $hasheader=1;}else{$tablename="no_header";}foreach my $row(0..$#split) +{next unless ref$split[$row]; my$txt='<tr class="expr_tabs">'; foreach(0..$width){no warnings; if($hasheader){my$data=$split[$row][$_]; my$wl=$data=~s/^\s+//; my$wr=$data=~s/\s+$//; my$dir=($wl&&$wr)?"center":$wl?"right":"left"; $txt.=qq'<td class="expr_tabs" nowrap="nowrap" align="$dir">$data</td> +';}else{$txt.=qq'<td class="expr_tabs" nowrap="nowrap">$split[$row][$ +_]</td>';}}$txt.="</tr>\n"; $split[$row]=$txt;}$text=qq'<table class="expr_tabs">\n'.join('',@spli +t)."</table>\n"; $text=qq'\n<div class="$tablename">\n$text</div>\n'; ;}}}return$text;}sub print_footer{my$self=shift->class_obj; my$index=shift; my$block=shift; push@{$self->{HTML}},q'<p class="backlink"><a class="backlink" href="# +__index__">$self->{backlink}</a></p>\n' if$self->{doindex}and$index a +nd$self->{backlink}; push@{$self->{HTML}},"<!-- itm_index -->\n"; foreach my $itype(sort keys%{$self->{printed_items}}){push@{$self->{HT +ML}},"<hr class=\"itm_index\" />\n"; my@out; my$ltr=""; foreach my $iname(sort keys%{$self->{printed_items}->{$itype}}){if($it +ype eq"Functions"){if($ltr ne substr($iname,0,1)){$ltr=substr($iname, +0,1); push@{$self->{HTML}},qq' <b class="itm_index">$ltr)</b>&nbs +p; ';}}if($itype eq"Sections"){push@out,qq'<td class="itm_index" +>'.qq'<a class="itm_index" href="$self->{printed_items}->{$itype}{$in +ame}">$iname</a> '.qq'</td>';}else{(my$nbsp=$iname)=~s/\s+ +/ /g; push@{$self->{HTML}},qq'<a class="itm_index" href="$self->{printed_ite +ms}->{$itype}{$iname}">$nbsp</a>\n';}}if($itype eq"Sections"){push@{$ +self->{HTML}},qq'<table class="itm_index" rows="2">\n'; foreach(0..$#out){push@{$self->{HTML}},qq'<tr class="itm_index">\n' un +less$_%3; push@{$self->{HTML}},($out[$_]||"<td />"); push@{$self->{HTML}},qq'</tr>\n' if$_%3==2;}push@{$self->{HTML}},qq'</ +tr>\n' unless$#out%3==2; push@{$self->{HTML}},qq'</table>\n' if($itype eq"Sections");}}push@{$s +elf->{HTML}},"\n<hr />\n"; push@{$self->{HTML}}, <<END_OF_TAIL; $block </body> </html> END_OF_TAIL }sub pod2html{my$self=shift->class_obj; local(@ARGV)=@_; local($/); local$_; $self->init_globals(); $self->{Is83}=0 if(defined(&Dos::UseLFN)&&Dos::UseLFN()); $self->parse_command_line(); my@poddata=$self->open_filehandles_get_pod(); $self->clean_data(\@poddata); my$index=$self->scan_headings(\%{$self->{sections}},@poddata); unless($index){warn"No headings in $self->{podfile}\n" if$self->{verbo +se};}$self->find_title(\@poddata); my$block=$self->print_headers(); $self->get_cache($self->{dircache},$self->{itemcache},\@{$self->{podpa +th}},$self->{podroot},$self->{recurse}); $self->scan_items(\%{$self->{local_items}},"",@poddata); $self->print_index($index); my$after_item; warn"Converting input file $self->{podfile}\n" if$self->{verbose}; my$last_head; foreach my $i(0..$#poddata){$self->{ptQuote}=0; $_=$poddata[$i]; $self->{paragraph}=$i+1; if(/^(=.*)/s){$self->{ignore}=0; $after_item=0; $_=$1; if(/^=begin\s+(\S+)\s*(.*)/si){$self->process_begin($1,$2);}elsif(/^=e +nd\s+(\S+)\s*(.*)/si){$self->process_end($1,$2);}elsif(/^=cut/){$self +->process_cut();}elsif(/^=pod/){$self->process_pod();}else{next if@{$ +self->{begin_stack}}&&$self->{begin_stack}->[-1]ne 'html'; if(/^=(head[1-6])\s+(.*\S)/s){$last_head=$1; $self->process_head($1,$2,$self->{doindex}&&$index);}elsif(/^=item\s*( +.*\S)?/sm){warn ref($self)." $self->{podfile}: =item without bullet, +number or text"." in paragraph $self->{paragraph}.\n" if!$self->{quie +t}and(!defined($1)or$1 eq ''); $self->process_item($1); $after_item=1;}elsif(/^=over\s*(.*)/){$self->process_over();}elsif(/^= +back/){$self->process_back();}elsif(/^=for\s+(\S+)\s*(.*)/si){$self-> +process_for($1,$2);}else{/^=(\S*)\s*/; warn ref($self)." $self->{podfile}: unknown pod directive '$1' in "."p +aragraph $self->{paragraph}. ignoring.\n" unless$self->{quiet};}}$se +lf->{top}=0;}else{next if$self->{ignore}; next if@{$self->{begin_stack}}&&$self->{begin_stack}->[-1]ne 'html'; my$text=$_; if($text=~/\A\s+/){$self->process_pre(\$text); push@{$self->{HTML}},qq'<pre class="verbatim">$text</pre>';}else{$self +->process_text(\$text); $text=$self->text_to_table($text); if($after_item||$text=~/^<table/){push@{$self->{HTML}},"$text\n"; $self->{after_lpar}=1;}else{push@{$self->{HTML}},"<p class=\"text_$las +t_head\">$text</p>\n";}}$after_item=0;}}$self->finish_list(); $self->print_footer($index,$block); my@out; my@pre; my$last; while(@{$self->{HTML}}){my$html=shift@{$self->{HTML}}; chomp$html; $html=~s/\A\n+//; $html=~s/\n+\z//; next unless$html; if($html=~/\A<pre/&&$html=~/<\/pre>\Z/){push@pre,$html;}else{if(@pre){ +if(@pre>1){$pre[0]=~s/<\/pre>\Z//; $pre[$#pre]=~s/\A<pre[^>]+>//; for my $i(1..($#pre-1)){$pre[$i]=~s/\A<pre[^>]+>|\n?<\/pre>\Z//g;}push +@out,join("\n",@pre);}else{push@out,@pre;}@pre=();}push@out,$html;}}p +rint HTML join"\n",@out; close(HTML); warn"Finished\n" if$self->{verbose};}{no strict 'refs'; *pod2xhtml=\*pod2html;}sub usage{my$self=shift->class_obj; $self->{podfile}=shift; warn ref($self)." $self->{podfile}: @_\n" if@_; confess$self->{usage};}sub parse_command_line{my$self=shift->class_obj +; my($opt_backlink,$opt_css,$opt_flush,$opt_header,$opt_help,$opt_htmldi +r,$opt_htmlroot,$opt_index,$opt_infile,$opt_libpods,$opt_netscape,$op +t_outfile,$opt_podpath,$opt_podroot,$opt_quiet,$opt_recurse,$opt_titl +e,$opt_verbose); unshift@ARGV,split ' ',$Config{pod2html}if$Config{pod2html}; my$result=GetOptions('backlink=s'=>\$opt_backlink,'css=s'=>\$opt_css,' +flush'=>\$opt_flush,'header!'=>\$opt_header,'help'=>\$opt_help,'htmld +ir=s'=>\$opt_htmldir,'htmlroot=s'=>\$opt_htmlroot,'index!'=>\$opt_ind +ex,'infile=s'=>\$opt_infile,'libpods=s'=>\$opt_libpods,'netscape!'=>\ +$opt_netscape,'outfile=s'=>\$opt_outfile,'podpath=s'=>\$opt_podpath,' +podroot=s'=>\$opt_podroot,'quiet!'=>\$opt_quiet,'recurse!'=>\$opt_rec +urse,'title=s'=>\$opt_title,'verbose!'=>\$opt_verbose,); $self->usage("-","invalid parameters")if not$result; $self->usage("-")if defined$opt_help; $opt_help=""; @{$self->{podpath}}=split(":",$opt_podpath)if defined$opt_podpath; @{$self->{libpods}}=split(":",$opt_libpods)if defined$opt_libpods; $self->{backlink}=$opt_backlink if defined$opt_backlink; $self->{css}=$opt_css if defined$opt_css; $self->{header}=$opt_header if defined$opt_header; $self->{htmldir}=$opt_htmldir if defined$opt_htmldir; $self->{htmlroot}=$opt_htmlroot if defined$opt_htmlroot; $self->{doindex}=$opt_index if defined$opt_index; $self->{podfile}=$opt_infile if defined$opt_infile; $self->{netscape}=$opt_netscape if defined$opt_netscape; $self->{htmlfile}=$opt_outfile if defined$opt_outfile; $self->{podroot}=$opt_podroot if defined$opt_podroot; $self->{quiet}=$opt_quiet if defined$opt_quiet; $self->{recurse}=$opt_recurse if defined$opt_recurse; $self->{title}=$opt_title if defined$opt_title; $self->{verbose}=$opt_verbose if defined$opt_verbose; warn"Flushing item and directory caches\n" if$opt_verbose&&defined$opt +_flush; unlink($self->{dircache},$self->{itemcache})if defined$opt_flush;}sub +get_cache{my$self=shift->class_obj; my$podpath; ($self->{dircache},$self->{itemcache},$podpath,$self->{podroot},$self- +>{recurse})=@_; my@cache_key_args=@_; my$this_cache_key=$self->cache_key(@cache_key_args); return if$self->{saved_cache_key}and$this_cache_key eq$self->{saved_ca +che_key}; my$tests=0; if(-f$self->{dircache}&&-f$self->{itemcache}){warn"scanning for item c +ache\n" if$self->{verbose}; $tests=$self->load_cache($self->{dircache},$self->{itemcache},$podpath +,$self->{podroot});}if(!$tests){warn"scanning directories in pod-path +\n" if$self->{verbose}; $self->scan_podpath($self->{podroot},$self->{recurse},0);}$self->{save +d_cache_key}=$self->cache_key(@cache_key_args);}sub cache_key{my$self +=shift->class_obj; my$podpath; ($self->{dircache},$self->{itemcache},$podpath,$self->{podroot},$self- +>{recurse})=@_; return join('!',$self->{dircache},$self->{itemcache},$self->{recurse}, +@$podpath,$self->{podroot},stat($self->{dircache}),stat($self->{itemc +ache}));}sub load_cache{my$self=shift->class_obj; my$podpath; ($self->{dircache},$self->{itemcache},$podpath,$self->{podroot})=@_; my($tests); local$_; $tests=0; open(CACHE,"<$self->{itemcache}")||die ref($self)." error opening $sel +f->{itemcache} for reading: $!\n"; $/="\n"; $_=<CACHE>; chomp($_); $tests++ if(join(":",@$podpath)eq$_); $_=<CACHE>; chomp($_); $tests++ if($self->{podroot}eq$_); if($tests!=2){close(CACHE); return 0;}warn"loading item cache\n" if$self->{verbose}; while(<CACHE>){/(.*?) (.*)$/; $self->{items}->{$1}=$2;}close(CACHE); warn"scanning for directory cache\n" if$self->{verbose}; open(CACHE,"<$self->{dircache}")||die ref($self)." error opening $self +->{dircache} for reading: $!\n"; $/="\n"; $tests=0; $_=<CACHE>; chomp($_); $tests++ if(join(":",@$podpath)eq$_); $_=<CACHE>; chomp($_); $tests++ if($self->{podroot}eq$_); if($tests!=2){close(CACHE); return 0;}warn"loading directory cache\n" if$self->{verbose}; while(<CACHE>){/(.*?) (.*)$/; $self->{pages}->{$1}=$2;}close(CACHE); return 1;}sub scan_podpath{my$self=shift->class_obj; my$append; ($self->{podroot},$self->{recurse},$append)=@_; my($pwd,$dir); my($libpod,$dirname,$pod,@files,@poddata); unless($append){%{$self->{items}}=(); %{$self->{pages}}=();}$pwd=getcwd(); chdir($self->{podroot})||die ref($self)." error changing to directory +$self->{podroot}: $!\n"; foreach$dir(@{$self->{podpath}}){$self->scan_dir($dir,$self->{recurse} +);}foreach$libpod(@{$self->{libpods}}){next unless defined$self->{pag +es}->{$libpod}&&$self->{pages}->{$libpod}; if($self->{pages}->{$libpod}=~/([^:]*(?<!\.pod)(?<!\.pm)):/){$dirname= +$1; opendir(DIR,$dirname)||die ref($self)." error opening directory $dirna +me: $!\n"; @files=grep(/(\.pod|\.pm)\z/&&!-d$_,readdir(DIR)); closedir(DIR); foreach$pod(@files){open(POD,"<$dirname/$pod")||die ref($self)." error + opening $dirname/$pod for input: $!\n"; @poddata=<POD>; close(POD); $self->clean_data(\@poddata); $self->scan_items(\%{$self->{items}},"$dirname/$pod",@poddata);}}elsif +($self->{pages}->{$libpod}=~/([^:]*\.pod):/||$self->{pages}->{$libpod +}=~/([^:]*\.pm):/){$pod=$1; open(POD,"<$pod")||die ref($self)." error opening $pod for input: $!\n +"; @poddata=<POD>; close(POD); $self->clean_data(\@poddata); $self->scan_items(\%{$self->{items}},"$pod",@poddata);}else{warn ref($ +self)." shouldn't be here (line ".__LINE__."\n" unless$self->{quiet}; +}}@poddata=(); chdir($pwd)||die ref($self)." error changing to directory $pwd: $!\n"; warn"caching items for later use\n" if$self->{verbose}; open(CACHE,">$self->{itemcache}")||die ref($self)." error open $self-> +{itemcache} for writing: $!\n"; print CACHE join(":",@{$self->{podpath}})."\n$self->{podroot}\n"; foreach my $key(keys%{$self->{items}}){print CACHE"$key $self->{items} +->{$key}\n";}close(CACHE); warn"caching directories for later use\n" if$self->{verbose}; open(CACHE,">$self->{dircache}")||die ref($self)." error open $self->{ +dircache} for writing: $!\n"; print CACHE join(":",@{$self->{podpath}})."\n$self->{podroot}\n"; foreach my $key(keys%{$self->{pages}}){print CACHE"$key $self->{pages} +->{$key}\n";}close(CACHE);}sub scan_dir{my$self=shift->class_obj; my$dir; ($dir,$self->{recurse})=@_; my($t,@subdirs,@pods,$pod,$dirname,@dirs); local$_; @subdirs=(); @pods=(); opendir(DIR,$dir)||die ref($self)." error opening directory $dir: $!\n +"; while(defined($_=readdir(DIR))){if(-d"$dir/$_"&&$_ ne"."&&$_ ne".."){$ +self->{pages}->{$_}="" unless defined$self->{pages}->{$_}; $self->{pages}->{$_}.="$dir/$_:"; push(@subdirs,$_);}elsif(/\.pod\z/){s/\.pod\z//; $self->{pages}->{$_}="" unless defined$self->{pages}->{$_}; $self->{pages}->{$_}.="$dir/$_.pod:"; push(@pods,"$dir/$_.pod");}elsif(/\.html\z/){s/\.html\z//; $self->{pages}->{$_}="" unless defined$self->{pages}->{$_}; $self->{pages}->{$_}.="$dir/$_.pod:";}elsif(/\.pm\z/){s/\.pm\z//; $self->{pages}->{$_}="" unless defined$self->{pages}->{$_}; $self->{pages}->{$_}.="$dir/$_.pm:"; push(@pods,"$dir/$_.pm");}}closedir(DIR); if($self->{recurse}){foreach my $subdir(@subdirs){$self->scan_dir("$di +r/$subdir",$self->{recurse});}}}sub scan_headings{my$self=shift->clas +s_obj; my($sections,@data)=@_; my($tag,$which_head,$otitle,$listdepth,$index); $self->{ignore}=0; $listdepth=0; $index=""; foreach my $line(@data){if($line=~/^=(head)([1-6])\s+(.*)/){($tag,$whi +ch_head,$otitle)=($1,$2,$3); my$title=$self->depod($otitle); my$name=$self->htmlify($title); $sections->{$name}=1; $title=$self->process_text(\$otitle); while($which_head!=$listdepth){if($which_head>$listdepth){$index.="\n" +.("\t" x$listdepth).qq'<ul class="index">\n'; $listdepth++;}elsif($which_head<$listdepth){$listdepth--; $index.="\n".("\t" x$listdepth)."</ul>\n";}}$index.="\n".("\t" x$listd +epth).qq'<li class="index">'.qq'<a class="index" href="\#$name">'."$t +itle</a></li>";}}while($listdepth--){$index.="\n".("\t" x$listdepth). +"</ul>\n";}$index=~s!\t*<ul class="index">\s*</ul>!!g; $self->{ignore}=1; return$index;}sub scan_items{my$self=shift->class_obj; my($itemref,$pod,@poddata)=@_; my($i,$item); local$_; $pod=~s/\.pod\z//; $pod.=".html" if$pod; foreach$i(0..$#poddata){my$txt=$self->depod($poddata[$i]); if($txt=~/\A=item\s+[*+-]\s*(.*)\Z/s){next unless$1; $item=$1;}elsif($txt=~/\A=item\s+(?>\d+\.?)\s*(.*)\Z/s){$item=$1;}elsi +f($txt=~/\A=item\s+(.*)\Z/s){$item=$1;}else{next;}my$fid=$self->fragm +ent_id($item); $itemref->{$fid}="$pod" if$fid;}}sub process_head{my$self=shift->class +_obj; my($tag,$heading,$hasindex)=@_; $tag=~/head([1-6])/; my$level=$1; push@{$self->{HTML}},"\n<!-- Head=".($self->{listlevel}||0)." -->\n"; if($self->{listlevel}){warn ref($self)." $self->{podfile}: unterminate +d list at =head in paragraph $self->{paragraph}. ignoring.\n" unless +$self->{quiet}; while($self->{listlevel}){$self->process_back();}}push@{$self->{HTML}} +,qq'<p class="sec_break"/>\n'; if($level==1&&!$self->{top}){push@{$self->{HTML}},q'<a class="backlink +" href="#__index__">$self->{backlink}</a>\n' if$hasindex and$self->{b +acklink}; push@{$self->{HTML}},qq'<hr />\n';}my$name=$self->htmlify($self->depod +($heading)); my$convert=$self->process_text(\$heading); push@{$self->{HTML}},qq'<h$level class="pod"><a class="head" id="$name +">$convert</a></h$level>\n';}sub emit_item_tag{my$self=shift->class_o +bj; my($otext,$text,$index)=@_; my$item=$self->fragment_id($text); $self->{EmittedItem}=$item; if($self->{items_named}->{$item}++){push@{$self->{HTML}},$self->proces +s_text(\$otext);}else{my$name='item_'.$item; my$ptxt=$self->process_text(\$otext); push@{$self->{HTML}},qq'<!-- ITEM -->\n<a class="item" id="$name">$ptx +t</a>\n'; if($index){my$index=$self->_fragment_id($text,1); my($str,$str_type)=@$index; if($str_type ne"Sections"){($str)=$str=~m/\A\s*(\S+<.*>\S+|\S+)/;}$sel +f->process_text(\$str); $self->{printed_items}->{$str_type}{$str}="\#$name" unless$self->{prin +ted_items}->{$str_type}{$str}; $self->{printed_items}->{$str_type}{$str}="\#$name" if$str eq$text;}}p +ush@{$self->{HTML}},"<br />\n"; undef($self->{EmittedItem});}sub emit_li{my$self=shift->class_obj; my$tag=lc(shift@_); if($self->{items_seen}->[$self->{listlevel}]++ ==0){push(@{$self->{lis +tend}},($tag eq 'dl'?'</dd>':'</li>')."</$tag>"); push@{$self->{HTML}},qq'<$tag class="item">\n';}else{push@{$self->{HTM +L}},$tag eq 'dl'?'</dd>':'</li>';}push@{$self->{HTML}},$tag eq 'dl'?' +<dt class="item">':'<li class="item">';}sub process_item{my$self=shif +t->class_obj; my($otext)=@_; if($self->{listlevel}==0){warn ref($self)." $self->{podfile}: unexpect +ed =item directive in paragraph $self->{paragraph}. ignoring.\n" unl +ess$self->{quiet}; $self->process_over();}if($self->{after_lpar}){push@{$self->{HTML}},"< +p />\n"; $self->{after_lpar}=0;}my$text=$self->depod($otext); if($text=~/\A\*/){$self->emit_li('ul'); if($text=~/\A\s*[+*-]\s+(.+)\Z/s){my$tag=$1; $otext=~s/\A\s*[+*-]\s+//; $self->emit_item_tag($otext,$tag,0);}}elsif($text=~/\A\s*\d+/){$self-> +emit_li('ol'); if($text=~/\A\s*(?>\d+\.?)\s*(.+)\Z/s){my$tag=$1; $otext=~s/\A\s*\d+\.?\s*//; $self->emit_item_tag($otext,$tag,0);}}else{$self->emit_li('dl'); if($text=~/\A\s*(.+)\s*\Z/s){$self->emit_item_tag($otext,$1,1);}push@{ +$self->{HTML}},'</dt><dd class="item">';}push@{$self->{HTML}},"\n";}s +ub process_over{my$self=shift->class_obj; push@{$self->{HTML}},"\n<!-- Over=".($self->{listlevel}||0)." -->\n"; $self->{listlevel}++; push(@{$self->{items_seen}},0); $self->{after_lpar}=0;}sub process_back{my$self=shift->class_obj; if($self->{listlevel}==0){warn ref($self)." $self->{podfile}: unexpect +ed =back directive in paragraph $self->{paragraph}. ignoring.\n" unl +ess$self->{quiet}; return;}push@{$self->{HTML}},"\n<!-- Back=$self->{listlevel}-->\n"; $self->{listlevel}--; if(defined$self->{listend}->[$self->{listlevel}]){push@{$self->{HTML}} +,qq'<p class="after_lpar"/>\n' if$self->{after_lpar}; push@{$self->{HTML}},$self->{listend}->[$self->{listlevel}]; push@{$self->{HTML}},"\n"; pop(@{$self->{listend}});}$self->{after_lpar}=0; pop(@{$self->{items_seen}});}sub process_cut{my$self=shift->class_obj; $self->{ignore}=1;}sub process_pod{my$self=shift->class_obj;}sub proce +ss_for{my$self=shift->class_obj; my($whom,$text)=@_; if($whom=~/^(pod2)?xhtml$/i){push@{$self->{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";}push@{$self->{HTML}},qq{<p align = "center"><img src + = "$text" alt = "$text illustration"></p>};}}sub process_begin{my$se +lf=shift->class_obj; my($whom,$text)=@_; $whom=lc($whom); push(@{$self->{begin_stack}},$whom); if($whom=~/^(pod2)?xhtml$/){push@{$self->{HTML}},$text if$text;}}sub p +rocess_end{my$self=shift->class_obj; my($whom,$text)=@_; $whom=lc($whom); if($self->{begin_stack}->[-1]ne$whom){die"Unmatched begin/end at chunk + $self->{paragraph}\n";}pop(@{$self->{begin_stack}});}sub process_pre +{my$self=shift->class_obj; my($text)=@_; my($rest); return if$self->{ignore}; $rest=$$text; $rest=~s#.*# my $line = $&; 1 while $line =~ s/\t+/' ' x (length($&) * 8 - length($`) % 8) +/e; $line; #eg; $rest=~s/&/&/g; $rest=~s/</</g; $rest=~s/>/>/g; $rest=~s/"/"/g; $rest=~s{ (\s*)(perl\w+) }{ if ( defined $self->{pages}->{$2} ){ # is a link qq($1<a class="perl" href="$self->{htmlroot}/$self->{page +s}->{$2}">$2</a>); } elsif (defined $self->{pages}->{$self->dosify($2)}) { # +is a link qq($1<a class="perl" href="$self->{htmlroot}/$self->{page +s}->{dosify($2)}">$2</a>); } else { "$1$2"; } }xeg; $rest=~s{ (<a\ class="[^"]*" href="?) ([^>:]*:)? ([^>:]*) \.pod: ([^>:] +*:)? }{ my $url ; if ( $self->{htmlfileurl} ne '' ){ # Here, we take advantage of the knowledge # that $self->{htmlfileurl} ne '' implies $self->{htmlroo +t} eq ''. # Since $self->{htmlroot} eq '', we need to prepend $self +->{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 = "$self->{htmldir}$old_url" if $old_url =~ m{^\ +/}; $url =$self->relativize_url( "$old_url.html", $self->{ht +mlfileurl} ); } else { $url = "$3.html" ; } "$1$url" ; }xeg; 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 } (?= # look-ahead non-consumptive asser +tion [$punc]* # either 0 or more punctuation [^$any] # followed by a non-url char | # or else $ # the end of the string ) }{<a class="embed" href="$1">$1</a>}igox; $$text=$rest;}sub pure_text{my$self=shift->class_obj; my$text=shift(); $self->process_puretext($text,\$self->{ptQuote},1);}sub inIS_text{my$s +elf=shift->class_obj; my$text=shift(); $self->process_puretext($text,\$self->{ptQuote},0);}sub process_purete +xt{my$self=shift->class_obj; my($text,$quote,$notinIS)=@_; my(@words,$lead,$trail); if($$quote&&$text=~s/"/$self->{rdq}/s){$$quote=0;}while($text=~s/"([^" +]*)"/$self->{ldq}$1$self->{rdq}/sg){}$$quote=1 if$text=~s/"/$self->{l +dq}/s; $lead=($text=~s/\A(\s+)//s?$1:""); $trail=($text=~s/(\s+)\Z//s?$1:""); @words=split(/(?<=\s)(?=\S)|(?<=\S)(?=\s)/,$text); foreach my $word(@words){next if$word=~/^\s*$/; if($notinIS&&$word=~/^(\w+)\((.*)\)$/){my($func,$args)=($1,$2); if($args=~/^\d+$/){my$url=$self->page_sect($word,''); if(defined$url){$word=qq'<a class="inferred" href="$url">the $word man +page</a>'; next;}}$word=$self->emit_C($func,'',"($args)");}elsif($word=~m,^\w+:// +\w,){$word=qq'<a class="embed" href="$word">$word</a>';}elsif($word=~ +/[\w.-]+\@[\w-]+\.\w/){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=$self->html_e +scape($word)if$word=~/["&<>]/;}}return$lead.join('',@words).$trail;}s +ub pattern{my$self=shift->class_obj; $_[0]?'[^\S\n]+'.('>' x($_[0]+1)):'>';}sub closing{my$self=shift->clas +s_obj; local($_)=shift; (defined&&s/\s+$//)?length:0;}sub process_text{my$self=shift->class_ob +j; return if$self->{ignore}; my($tref)=@_; my$res=$self->process_text1(0,$tref); $$tref=$res;}sub process_text1{my$self=shift->class_obj; my($lev,$rstr,$func,$closing)=@_; my$res=''; unless(defined$func){$func=''; $lev++;}if($func eq 'B'){$res='<b>'.$self->process_text1($lev,$rstr).' +</b>';}elsif($func eq 'C'){my$par=$self->go_ahead($rstr,'C',$closing) +; my$text=$self->depod($par); $res=$self->emit_C($text,$lev>1||($par=~/[BI]</));}elsif($func eq 'E') +{$$rstr=~s/^([^>]*)>//; my$escape=$1; $escape=~s/^(\d+|X[\dA-F]+)$/#$1/i; $res="&$escape;";}elsif($func eq 'F'){$res='<i class="filename">'.$sel +f->process_text1($lev,$rstr).'</i>';}elsif($func eq 'I'){$res='<i>'.$ +self->process_text1($lev,$rstr).'</i>';}elsif($func eq 'L'){my$par=$s +elf->go_ahead($rstr,'L',$closing); if($par=~m{^\w+://}s){return$self->make_URL_href($par);}if($par=~/^C<( +.*)>$/){my$text=$self->depod($1); return$self->emit_C($text,$lev>1||($par=~/[BI]</));}$par=~s/\n/ /g; my$opar=$par; my$linktext; if($par=~s{^([^|]+)\|}{}){$linktext=$1;}$par=~s{^"}{/"}; my($page,$section,$ident); if($par=~m{^([^/]+?)/(?!")(.*?)$}){($page,$ident)=($1,$2);}elsif($par= +~m{^(.*?)/"?(.*?)"?$}){($page,$ident)=($1,$2);}elsif($par=~/\s/){($pa +ge,$section)=('',$par);}else{($page,$section)=($par,'');}defined and +s/\(\s*\d+\s*\)//g foreach$page,$section,$ident; my($url,$ltext,$fid); RESOLVE:{if(defined$ident){($url,$fid)=$self->coderef($page,$ident); if($url){if(!defined($linktext)){$linktext=$ident; $linktext.=" in " if$ident&&$page; $linktext.="the $page manpage" if$page;}last RESOLVE;}$section=$ident; +}my$htmlsection=$self->htmlify($section); $url=$self->page_sect($page,$htmlsection); if($url){if(!defined($linktext)){$linktext=$section; $linktext.=" in " if$section&&$page; $linktext.="the $page manpage" if$page;}last RESOLVE;}if($section){$id +ent=$section;}else{$ident=$page; $page=undef();}($url,$fid)=$self->coderef($page,$ident); if($url){if(!defined($linktext)){$linktext=$ident; $linktext.=" in " if$ident&&$page; $linktext.="the $page manpage" if$page;}last RESOLVE;}$linktext=$opar +unless defined$linktext; warn ref($self).": $self->{podfile}: cannot resolve L<$opar> $page $se +ction $ident in paragraph $self->{paragraph}." unless$self->{quiet};} +$$rstr=$linktext.'>'.$$rstr; if(defined($url)){$res=qq'<a class="link" href="$url">'.$self->process +_text1($lev,$rstr).'</a>';}else{$res='<em class="link">'.$self->proce +ss_text1($lev,$rstr).'</em>';}}elsif($func eq 'S'){$res=$self->proces +s_text1($lev,$rstr); $res=~s/ / /g;}elsif($func eq 'X'){$$rstr=~s/^[^>]*>//;}elsif($fu +nc eq 'Z'){warn ref($self)." $self->{podfile}: invalid X<> in paragra +ph $self->{paragraph}." unless$$rstr=~s/^>// or$self->{quiet};}else{m +y$term=$self->pattern($closing); while($$rstr=~s/\A(.*?)(([BCEFILSXZ])<(<+[^\S\n]+)?|$term)//s){my$pt=$ +1; $pt.=$2 if!$3&&$lev==1; $res.=$lev==1?$self->pure_text($pt):$self->inIS_text($pt); return$res if!$3&&$lev>1; if($3){$res.=$self->process_text1($lev,$rstr,$3,$self->closing($4));}} +if($lev==1){$res.=$self->pure_text($$rstr);}else{warn ref($self)." $s +elf->{podfile}: undelimited $func<> in paragraph $self->{paragraph}." + unless$self->{quiet};}}return$res;}sub go_ahead{my$self=shift->class +_obj; my($rstr,$func,$closing)=@_; my$res=''; my@closing=($closing); while($$rstr=~s/\A(.*?)(([BCEFILSXZ])<(<+[^\S\n]+)?|@{[$self->pattern( +$closing[0])]})//s){$res.=$1; unless($3){shift@closing; return$res unless@closing;}else{unshift@closing,$self->closing($4);}$r +es.=$2;}warn ref($self)." $self->{podfile}: undelimited $func<> in pa +ragraph $self->{paragraph}." unless$self->{quiet}; return$res;}sub emit_C{my$self=shift->class_obj; my($text,$nocode,$args)=@_; $args='' unless defined$args; my$res; my($url,$fid)=$self->coderef(undef(),$text); my$linktext=$self->html_escape("$text$args"); if(defined($url)&&(!defined($self->{EmittedItem})||$self->{EmittedItem +}ne$fid)){$res=qq'<a class="code" href="$url"><co'.qq'de class="link" +>$linktext</co'.'de></a>';}elsif(0&&$nocode){$res=$linktext;}else{$re +s="<co"."de>$linktext</co"."de>";}return$res;}sub html_escape{my$self +=shift->class_obj; my$rest=$_[0]; $rest=~s/&/&/g; $rest=~s/</</g; $rest=~s/>/>/g; $rest=~s/"/"/g; return$rest;}sub dosify{my$self=shift->class_obj; my($str)=@_; return lc($str)if$^O eq 'VMS'; if($self->{Is83}){$str=lc$str; $str=~s/(\.\w+)/substr ($1,0,4)/ge; $str=~s/(\w+)/substr ($1,0,8)/ge;}return$str;}sub page_sect{my$self=sh +ift->class_obj; my($page,$section)=@_; my($linktext,$page83,$link); if(!defined$self->{pages}->{$page}&&defined$self->{sections}->{$page}) +{$section=$page; $page="";}$page83=$self->dosify($page); $page=$page83 if(defined$self->{pages}->{$page83}); if($page eq""){$link="#".$self->htmlify($section);}elsif($page=~/::/){ +$page=~s,::,/,g; my$page_name=$page; $page_name=~s,^.*/,,s; if(defined($self->{pages}->{$page_name})&&$self->{pages}->{$page_name} +=~/([^:]*$page)\.(?:pod|pm):/){$page=$1;}else{}$link="$self->{htmlroo +t}/$page.html"; $link.="#".$self->htmlify($section)if($section);}elsif(!defined$self-> +{pages}->{$page}){$link="";}else{$section=$self->htmlify($section)if$ +section ne""; if($section ne""&&$self->{pages}->{$page}=~/([^:]*(?<!\.pod)(?<!\.pm)) +:/){$link="$self->{htmlroot}/$1/$section.html";}else{$section="#$sect +ion" if$section; if($self->{pages}->{$page}=~/([^:]*)\.pod:/){$link="$self->{htmlroot}/ +$1.html$section";}elsif($self->{pages}->{$page}=~/([^:]*)\.pm:/){$lin +k="$self->{htmlroot}/$1.html$section";}else{$link="";}}}if($link){my$ +url; if($self->{htmlfileurl}ne ''){$link="$self->{htmldir}$link" if$link=~m +{^/}s; $url=$self->relativize_url($link,$self->{htmlfileurl});}else{$url=$lin +k;}return$url;}else{return undef();}}sub relativize_url{my$self=shift +->class_obj; my($dest,$source)=@_; my($dest_volume,$dest_directory,$dest_file)=File::Spec::Unix->splitpat +h($dest); $dest=File::Spec::Unix->catpath($dest_volume,$dest_directory,''); my($source_volume,$source_directory,$source_file)=File::Spec::Unix->sp +litpath($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)n +e '#'){$rel_path.="/$dest_file";}else{$rel_path.="$dest_file";}return +$rel_path;}sub coderef{my$self=shift->class_obj; my($page,$item)=@_; my($url); my$fid=$self->fragment_id($item); if(defined($page)){$page=~s{::}{/}g; my$base=$self->{items}->{$fid}||""; $base=~s{[^/]*/}{}; if($base ne"$page.html"){$page=undef();}}else{if(defined($fid)){if(exi +sts$self->{local_items}->{$fid}){$page=$self->{local_items}->{$fid};} +else{$page=$self->{items}->{$fid};}}}if(defined$page){if($page){if(ex +ists$self->{pages}->{$page}and$self->{pages}->{$page}=~/([^:.]*)\.[^: +]*:/){$page=$1.'.html';}my$link="$self->{htmlroot}/$page#item_$fid"; if($self->{htmlfileurl}ne ''){$link="$self->{htmldir}$link"; $url=$self->relativize_url($link,$self->{htmlfileurl});}else{$url=$lin +k;}}else{$url="#item_".$fid;}confess"url has space: $url" if$url=~/"[ +^"]*\s[^"]*"/;}return($url,$fid);}sub relative_url{my$self=shift->cla +ss_obj; 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;}sub finish_list{my$self=shift->class_obj; while($self->{listlevel}>0){push@{$self->{HTML}},"</dl>\n"; $self->{listlevel}--;}}sub htmlify{my$self=shift->class_obj; my($heading)=@_; $heading=~s/(\s+)/ /g; $heading=~s/\s+\Z//; $heading=~s/\A\s+//; $heading=~s/[-"?]//g; $heading=lc($heading); return$heading;}sub depod{my$self=shift->class_obj; my$string; if(ref($_[0])){$string=${$_[0]}; ${$_[0]}=$self->depod1(\$string);}else{$string=$_[0]; $self->depod1(\$string);}}sub depod1{my$self=shift->class_obj; my($rstr,$func,$closing)=@_; my$res=''; return$res unless defined$$rstr; if(!defined($func)){while($$rstr=~s/\A(.*?)([BCEFILSXZ])<(<+[^\S\n]+)? +//){$res.=$1.$self->depod1($rstr,$2,$self->closing($3));}$res.=$$rstr +;}elsif($func eq 'E'){$$rstr=~s/^([^>]*)>//; $res.=$self->{E2c}->{$1}||"";}elsif($func eq 'X'){$$rstr=~s/^[^>]*>//; +}elsif($func eq 'Z'){$$rstr=~s/^>//;}else{my$term=$self->pattern($clo +sing); while($$rstr=~s/\A(.*?)(([BCEFILSXZ])<(<+[^\S\n]+)?|$term)//){$res.=$1 +; last unless$3; $res.=$self->depod1($rstr,$3,$self->closing($4));}}return$res;}sub fra +gment_id{my$self=shift->class_obj; my$text=$self->_fragment_id(shift); return$text unless defined($text); $text=~s/\s+/_/sg; $text=~s{(\W)}{ defined( $self->{hc}->[ord($1)] ) ? $self->{hc}->[ord($1)] : ( $self->{hc}->[ord($1)] = sprintf( "%%%02X", ord($ +1) ) ) }gxe; $text=substr($text,0,50); $text;}sub _fragment_id{my$self=shift->class_obj; my$text=shift@_; $text=~s/\s+\Z//s; $text=~s/\A\s+//s; local$_=$text; my$ret; if($text){if(m{^ (\s*-[rwxoRWXOezsfdlpSbctugkTBMAC]|[a-z\d]+) (\s+[:A-Z\d,\(\)/& ]+)? $ }x ){$ret=[$1,"Functions"];}elsif(m{^([a-z\d]+)\s+Module(\s+[A-Z\d,/& + ]+)?$}){$ret=[$1,"Functions"];}elsif(/(\w+)\s*\(/){$ret=[$1,"Functio +ns"];}elsif(/->\s*(\w+)\s*\(?/){$ret=[$1,"Functions"];}elsif(/^\s*([\ +$\@\%\*]\S+)/){$ret=[$1,"Variables"];}elsif(m|^(\w+/).*/\w*$|){my$rop +=$1."/"; $rop.="/" if$rop=~/^([sy]|tr)/; $ret=[$rop,"Functions"];}elsif(m|^(\w+)\s*{.*}$|){$ret=[$1,"Functions" +];}else{$ret=[$text,"Sections"];}return@_?$ret:$ret->[0];}else{return +;}}sub make_URL_href{my$self=shift->class_obj; my($url)=@_; if($url!~s{^(http:[-\w/#~:.+=&%@!]+)(\?.*)$}{<a href="$1$2">$1</a>}i){ +$url=qq'<a class="url_href" href="$url">$url</a>';}return$url;}1;
In reply to Pod::XHtml by demerphq
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |