/gm;
$text =
'';
}
}
}
## end of experimental
if ($after_item) {
$After_Lpar = 1;
}
print HTML " $text \n";
}
print HTML "\n" if $need_dd;
$after_item = 0;
}
}
# finish off any pending directives
finish_list();
# link to page index
print HTML "$Backlink \n"
if $Doindex
and $index
and $Backlink;
print HTML <
END_OF_TAIL
# close the html file
close(HTML);
warn "Finished\n" if $Verbose;
}
##############################################################################
sub usage {
my $podfile = shift;
warn "$0: $podfile: @_\n" if @_;
die < --infile= --outfile=
--podpath=:...: --podroot=
--libpods=:...: --recurse --verbose --index
--netscape --norecurse --noindex --cachedir=
--backlink - set text for "back to top" links (default: none).
--cachedir - directory for the item and directory cache files.
--css - stylesheet URL
--flush - flushes the item and directory caches.
--[no]header - produce block header/footer (default is no headers).
--help - prints this message.
--hiddendirs - search hidden directories in podpath
--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 stdin
by default).
--libpods - colon-separated list of pages to search for =item pod
directives in as targets of C<> and implicit links (empty
by default). note, these are not filenames, but rather
page names like those that appear in L<> links.
--outfile - filename for the resulting html file (output sent to
stdout by default).
--podpath - colon-separated list of directories containing library
pods (empty by default).
--podroot - filesystem base directory from which all relative paths
in podpath stem (default is .).
--[no]quiet - suppress some benign warning messages (default is off).
--[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).
--[no]netscape - deprecated, has no effect. for backwards compatibility only.
END_OF_USAGE
}
sub parse_command_line {
my (
$opt_backlink, $opt_cachedir, $opt_css, $opt_flush,
$opt_header, $opt_help, $opt_htmldir, $opt_htmlroot,
$opt_index, $opt_infile, $opt_libpods, $opt_netscape,
$opt_outfile, $opt_podpath, $opt_podroot, $opt_quiet,
$opt_recurse, $opt_title, $opt_verbose, $opt_hiddendirs
);
unshift @ARGV, split ' ', $Config{pod2html} if $Config{pod2html};
my $result = GetOptions(
'backlink=s' => \$opt_backlink,
'cachedir=s' => \$opt_cachedir,
'css=s' => \$opt_css,
'flush' => \$opt_flush,
'header!' => \$opt_header,
'help' => \$opt_help,
'hiddendirs!' => \$opt_hiddendirs,
'htmldir=s' => \$opt_htmldir,
'htmlroot=s' => \$opt_htmlroot,
'index!' => \$opt_index,
'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_recurse,
'title=s' => \$opt_title,
'verbose!' => \$opt_verbose,
);
usage( "-", "invalid parameters" ) if not $result;
usage("-") if defined $opt_help; # see if the user asked for help
$opt_help = ""; # just to make -w shut-up.
@Podpath = split( ":", $opt_podpath ) if defined $opt_podpath;
@Libpods = split( ":", $opt_libpods ) if defined $opt_libpods;
$Backlink = $opt_backlink if defined $opt_backlink;
$Cachedir = $opt_cachedir if defined $opt_cachedir;
$Css = $opt_css if defined $opt_css;
$Header = $opt_header if defined $opt_header;
$Htmldir = $opt_htmldir if defined $opt_htmldir;
$Htmlroot = $opt_htmlroot if defined $opt_htmlroot;
$Doindex = $opt_index if defined $opt_index;
$Podfile = $opt_infile if defined $opt_infile;
$HiddenDirs = $opt_hiddendirs if defined $opt_hiddendirs;
$Htmlfile = $opt_outfile if defined $opt_outfile;
$Podroot = $opt_podroot if defined $opt_podroot;
$Quiet = $opt_quiet if defined $opt_quiet;
$Recurse = $opt_recurse if defined $opt_recurse;
$Title = $opt_title if defined $opt_title;
$Verbose = $opt_verbose if defined $opt_verbose;
warn "Flushing item and directory caches\n"
if $opt_verbose && defined $opt_flush;
$Dircache = "$Cachedir/pod2htmd.tmp";
$Itemcache = "$Cachedir/pod2htmi.tmp";
if ( defined $opt_flush ) {
1 while unlink( $Dircache, $Itemcache );
}
}
my $Saved_Cache_Key;
sub get_cache {
my ( $dircache, $itemcache, $podpath, $podroot, $recurse ) = @_;
my @cache_key_args = @_;
# A first-level cache:
# Don't bother reading the cache files if they still apply
# and haven't changed since we last read them.
my $this_cache_key = cache_key(@cache_key_args);
return if $Saved_Cache_Key and $this_cache_key eq $Saved_Cache_Key;
# load the cache of %Pages and %Items if possible. $tests will be
# non-zero if successful.
my $tests = 0;
if ( -f $dircache && -f $itemcache ) {
warn "scanning for item cache\n" if $Verbose;
$tests = load_cache( $dircache, $itemcache, $podpath, $podroot );
}
# if we didn't succeed in loading the cache then we must (re)build
# %Pages and %Items.
if ( !$tests ) {
warn "scanning directories in pod-path\n" if $Verbose;
scan_podpath( $podroot, $recurse, 0 );
}
$Saved_Cache_Key = cache_key(@cache_key_args);
}
sub cache_key {
my ( $dircache, $itemcache, $podpath, $podroot, $recurse ) = @_;
return join( '!',
$dircache, $itemcache, $recurse, @$podpath, $podroot, stat($dircache),
stat($itemcache) );
}
#
# load_cache - tries to find if the caches stored in $dircache and $itemcache
# are valid caches of %Pages and %Items. if they are valid then it loads
# them and returns a non-zero value.
#
sub load_cache {
my ( $dircache, $itemcache, $podpath, $podroot ) = @_;
my ($tests);
local $_;
$tests = 0;
open( CACHE, "<$itemcache" )
|| die "$0: error opening $itemcache for reading: $!\n";
$/ = "\n";
# is it the same podpath?
$_ = ;
chomp($_);
$tests++ if ( join( ":", @$podpath ) eq $_ );
# is it the same podroot?
$_ = ;
chomp($_);
$tests++ if ( $podroot eq $_ );
# load the cache if its good
if ( $tests != 2 ) {
close(CACHE);
return 0;
}
warn "loading item cache\n" if $Verbose;
while () {
/(.*?) (.*)$/;
$Items{$1} = $2;
}
close(CACHE);
warn "scanning for directory cache\n" if $Verbose;
open( CACHE, "<$dircache" )
|| die "$0: error opening $dircache for reading: $!\n";
$/ = "\n";
$tests = 0;
# is it the same podpath?
$_ = ;
chomp($_);
$tests++ if ( join( ":", @$podpath ) eq $_ );
# is it the same podroot?
$_ = ;
chomp($_);
$tests++ if ( $podroot eq $_ );
# load the cache if its good
if ( $tests != 2 ) {
close(CACHE);
return 0;
}
warn "loading directory cache\n" if $Verbose;
while () {
/(.*?) (.*)$/;
$Pages{$1} = $2;
}
close(CACHE);
return 1;
}
#
# scan_podpath - scans the directories specified in @podpath for directories,
# .pod files, and .pm files. it also scans the pod files specified in
# @Libpods for =item directives.
#
sub scan_podpath {
my ( $podroot, $recurse, $append ) = @_;
my ( $pwd, $dir );
my ( $libpod, $dirname, $pod, @files, @poddata );
unless ($append) {
%Items = ();
%Pages = ();
}
# scan each directory listed in @Podpath
$pwd = getcwd();
chdir($podroot)
|| die "$0: error changing to directory $podroot: $!\n";
foreach $dir (@Podpath) {
scan_dir( $dir, $recurse );
}
# scan the pods listed in @Libpods for =item directives
foreach $libpod (@Libpods) {
# if the page isn't defined then we won't know where to find it
# on the system.
next unless defined $Pages{$libpod} && $Pages{$libpod};
# if there is a directory then use the .pod and .pm files within it.
# NOTE: Only finds the first so-named directory in the tree.
# if ($Pages{$libpod} =~ /([^:]*[^(\.pod|\.pm)]):/) {
if ( $Pages{$libpod} =~ /([^:]*(?;
close(POD);
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 = ;
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 = ) ) {
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) )
. ( $listdepth > 0 ? qq{\n}
. "\t"x($listdepth + 1): "" )
. "";
$listdepth++;
} elsif ( $which_head < $listdepth ) {
$listdepth--;
$index .= "\n"
. ( "\t" x $listdepth )
. ( $listdepth > 0 ? "\t" : "" )
. " "
. ( $listdepth >= 0 ? "\n" . ("\t"x$listdepth)
. "" : "" )
. "\n";
}
}
$index .= "\n"
. ( "\t" x $listdepth ) . ""
. ""
. $title
. "";
}
}
# finish off the lists
while ( $listdepth-- ) {
$index .= "\n" . ( "\t" x $listdepth )
. ($listdepth > 0 ? "\t" : "")
."\n"
. ($listdepth > 0 ? ("\t" x $listdepth) . "" : "" );
}
# get rid of bogus lists
$index =~ s,\t*\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 "\n";
if ( $level == 1 && !$Top ) {
print HTML "$Backlink\n"
if $hasindex and $Backlink;
print HTML " \n \n";
} else {
print HTML "\n";
}
my $name = anchorify( depod($heading) );
my $convert = process_text( \$heading );
$convert =~ s{?a[^>]+>}{}g;
print HTML "$convert\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{},
process_text( \$otext ),
# ''
;
}
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 after an item
# lots of documents start a#include <string.h>
#include <stdlib.h>
#include "custom-list.h"
/* indent -i3 -ci3 -ut -ts3 -bli0 -c0 custom-list.c */
/* boring declarations of local functions */
static void custom_list_init (CustomList * pkg_tree);
static void custom_list_class_init (CustomListClass * klass);
static void custom_list_tree_model_init (GtkTreeModelIface * iface);
static void custom_list_finalize (GObject * object);
static GtkTreeModelFlags custom_list_get_flags (GtkTreeModel * tree_model);
static gint custom_list_get_n_columns (GtkTreeModel * tree_model);
static GType custom_list_get_column_type (GtkTreeModel * tree_model,
gint index);
static gboolean custom_list_get_iter (GtkTreeModel * tree_model,
GtkTreeIter * iter, GtkTreePath * path);
static GtkTreePath *custom_list_get_path (GtkTreeModel * tree_model,
GtkTreeIter * iter);
static void custom_list_get_value (GtkTreeModel * tree_model,
GtkTreeIter * iter,
gint column, GValue * value);
static gboolean custom_list_iter_next (GtkTreeModel * tree_model,
GtkTreeIter * iter);
static gboolean custom_list_iter_children (GtkTreeModel * tree_model,
GtkTreeIter * iter,
GtkTreeIter * parent);
static gboolean custom_list_iter_has_child (GtkTreeModel * tree_model,
GtkTreeIter * iter);
static gint custom_list_iter_n_children (GtkTreeModel * tree_model,
GtkTreeIter * iter);
static gboolean custom_list_iter_nth_child (GtkTreeModel * tree_model,
GtkTreeIter * iter,
GtkTreeIter * parent, gint n);
static gboolean custom_list_iter_parent (GtkTreeModel * tree_model,
GtkTreeIter * iter,
GtkTreeIter * child);
/* -- GtkTreeSortable interface functions -- */
static gboolean custom_list_sortable_get_sort_column_id (GtkTreeSortable *
sortable,
gint * sort_col_id,
GtkSortType * order);
static void custom_list_sortable_set_sort_column_id (GtkTreeSortable *
sortable,
gint sort_col_id,
GtkSortType order);
static void custom_list_sortable_set_sort_func (GtkTreeSortable * sortable,
gint sort_col_id,
GtkTreeIterCompareFunc
sort_func, gpointer user_data,
GtkDestroyNotify
destroy_func);
static void custom_list_sortable_set_default_sort_func (GtkTreeSortable *
sortable,
GtkTreeIterCompareFunc
sort_func,
gpointer user_data,
GtkDestroyNotify
destroy_func);
static gboolean custom_list_sortable_has_default_sort_func (GtkTreeSortable *
sortable);
static GObjectClass *parent_class = NULL; /* GObject stuff - nothing to worry about */
static void
custom_list_sortable_init (GtkTreeSortableIface * iface)
{
iface->get_sort_column_id = custom_list_sortable_get_sort_column_id;
iface->set_sort_column_id = custom_list_sortable_set_sort_column_id;
iface->set_sort_func = custom_list_sortable_set_sort_func; /* NOT SUPPORTED */
iface->set_default_sort_func = custom_list_sortable_set_default_sort_func; /* NOT SUPPORTED */
iface->has_default_sort_func = custom_list_sortable_has_default_sort_func; /* NOT SUPPORTED */
}
/*****************************************************************************
*
* custom_list_get_type: here we register our new type and its interfaces
* with the type system. If you want to implement
* additional interfaces like GtkTreeSortable, you
* will need to do it here.
*
*****************************************************************************/
GType
custom_list_get_type (void)
{
static GType custom_list_type = 0;
if (custom_list_type)
return custom_list_type;
/* Some boilerplate type registration stuff */
if (1)
{
static const GTypeInfo custom_list_info = {
sizeof (CustomListClass),
NULL, /* base_init */
NULL, /* base_finalize */
(GClassInitFunc) custom_list_class_init,
NULL, /* class finalize */
NULL, /* class_data */
sizeof (CustomList),
0, /* n_preallocs */
(GInstanceInitFunc) custom_list_init
};
custom_list_type =
g_type_register_static (G_TYPE_OBJECT, "CustomList",
&custom_list_info, (GTypeFlags) 0);
}
/* Here we register our GtkTreeModel interface with the type system */
if (1)
{
static const GInterfaceInfo tree_model_info = {
(GInterfaceInitFunc) custom_list_tree_model_init,
NULL,
NULL
};
g_type_add_interface_static (custom_list_type, GTK_TYPE_TREE_MODEL,
&tree_model_info);
}
/* Add GtkTreeSortable interface */
if (1)
{
static const GInterfaceInfo tree_sortable_info = {
(GInterfaceInitFunc) custom_list_sortable_init,
NULL,
NULL
};
g_type_add_interface_static (custom_list_type,
GTK_TYPE_TREE_SORTABLE,
|