PC Professionell 2004 December/PCpro_2004_12.ISO/files/webserver/tsw/TSW_3.4.0.exe/Apache2/perl/RunTime.pm

Perl POD Document | 2002-08-18 | 11.1 KB | 401 lines

package DocSet::RunTime;

# META: this class acts as Singleton, consider to actually use
# Class::Singleton

use strict;
use warnings;

use File::Spec::Functions qw(catdir catfile splitdir);
use File::Find;

use DocSet::Util;
use Carp;

use vars qw(@ISA @EXPORT %opts);
@ISA    = qw(Exporter);
@EXPORT = qw(get_opts find_src_doc set_render_obj get_render_obj unset_render_obj);

my %registers = ();

my @search_paths = ();
my %src_docs = ();
my %exts     = ();
my $render_obj;

sub registers_reset {
    %registers = ();
}

sub register {
    my($register, $key, $val) = @_;
    push @{$registers{$register}{$key}}, $val;
    return @{ $registers{$register}{$key} || []};
}


sub set_opt {
    my(%args) = ();
    if (@_ == 1) {
        my $arg = shift;
        my $ref = ref $arg;
        if ($ref) {
            %args = $ref eq 'HASH' ? %$arg : @$arg;
        } else {
            die "must be a ref to or an array/hash";
        }
    } else {
        %args = @_;
    }
    @opts{keys %args} = values %args;
}

sub get_opts {
    my $opt = shift;
    exists $opts{$opt} ? $opts{$opt} : '';
}

# check whether we have a Storable avalable
use constant HAS_STORABLE => eval { require Storable; };
sub has_storable_module {
    return HAS_STORABLE;
}

# check for existence of html2ps and ps2pdf

my $html2ps_exec = which('html2ps');
sub can_create_ps {
    # ps2html is bundled, so we can always create PS
    return $html2ps_exec if $html2ps_exec;

    print 'It seems that you do not have html2ps installed! You have',
        'to install it if you want to generate the PDF file';
    return 0;

    # if you unbundle it make sure you write here a code similar to
    # can_create_pdf()
}

my $ps2pdf_exec = which('ps2pdf');
sub can_create_pdf {
    # check whether ps2pdf exists
    return $ps2pdf_exec if $ps2pdf_exec;

    print 'It seems that you do not have ps2pdf installed! You have',
        'to install it if you want to generate the PDF file';
    return 0;
}

sub scan_src_docs {
    my($base, $ra_search_paths, $ra_search_exts) = @_;

    @search_paths = @{$ra_search_paths || []};

    # .cfg is for matching config.cfg to become index.html
    %exts = map {$_ => 1} @{$ra_search_exts || []}, 'cfg';

    my @ext_accept_pattern = map {quotemeta($_)."\$"} keys %exts;
    my $rsub_keep_ext =
        build_matchmany_sub(\@ext_accept_pattern);

    my %seen;
    for my $rel_path (@search_paths) {
        my $full_base_path = catdir $base, $rel_path;
        die "'search_paths' attr: $full_base_path is not a dir"
            unless -d $full_base_path;

        my @seen_pattern = map {"^".quotemeta($_)} keys %seen;
        my $rsub_skip_seen = build_matchmany_sub(\@seen_pattern);

        my $rel_uri = path2uri($rel_path);
        $src_docs{$rel_uri} = {
                                            # autogenerated index.html
            map { s/config\.cfg$/index.html/; ($_ => 1) }
                                            # full path => relative uri
            map path2uri( DocSet::Util::abs2rel($_, $full_base_path) ),
            grep $rsub_keep_ext->($_),      # get files with wanted exts
            grep !$rsub_skip_seen->($_),    # skip seen base dirs
            @{ expand_dir($full_base_path) }
        };

        note "Scanning for src files: $full_base_path";
        $seen{$full_base_path}++;
    }

#   dumper \%src_docs;
}

# this function returns a URI, so its separators are always /
sub find_src_doc {
    my($resource_rel_path) = @_;

    # push the html extension, because of autogenerated index.html,
    # which should be found automatically
    $exts{html} = 1 unless exists $exts{html};

    for my $path (keys %src_docs) {
        if (my $found_path = match_in_doc_src_subset($path,
                                                     $resource_rel_path)) {
            return path2uri($found_path);
        }
    }

    # if we didn't find anything so far, it's possible that the path was
    # specified with a longer prefix, that was needed (the above
    # searches only the end leaves), so try locate the segments of the
    # search path and search within maching sub-sets
    for my $path (@search_paths) {
        if ($resource_rel_path =~ m|^$path/(.*)|) {
            if (my $found_path = match_in_doc_src_subset($path, $1)) {
                return path2uri($found_path);
            }
        }
    }

#dumper  $src_docs{"docs/1.0"};
    return;
}

# accepts the base_path (from the @search_paths) and the rel_path as
# args, then it tries to find the match by applying known extensions.
#
# if matched, returns the whole path relative to the root, otherwise
# returns undef
sub match_in_doc_src_subset {
    my ($base_path, $rel_path) = @_;
    for my $ext (keys %exts) {
#print qq{Try:  $base_path :: $rel_path.$ext\n};
        if (exists $src_docs{$base_path}{"$rel_path.$ext"}) {
#print qq{Found $base_path/$rel_path.$ext\n};
            return catdir $base_path, "$rel_path.$ext";
        }
    }
    return;
}

# set render object: sort of Singleton, it'll complain aloud if the
# object is set over the existing object, without first unsetting it
sub set_render_obj {
    Carp::croak("usage: set_render_obj(\$obj) ") unless @_;
    Carp::croak("unset render_obj before setting a new one") if $render_obj;
    Carp::croak("undefined render_obj passed") unless defined $_[0];
    $render_obj = shift;
}

sub get_render_obj {
    Carp::croak("render_obj is not available") unless $render_obj;

    return $render_obj;
}

sub unset_render_obj {
    Carp::croak("render_obj is not set") unless $render_obj;

    undef $render_obj;
}


1;
__END__

=head1 NAME

C<DocSet::RunTime> - RunTime Configuration

=head1 SYNOPSIS

  use DocSet::RunTime;

  # run time options
  DocSet::RunTime::set_opt(\%args);
  if (get_opts('verbose') {
      print "verbose mode";
  }

  # hosting system capabilities testing
  DocSet::RunTime::has_storable_module();
  DocSet::RunTime::can_create_ps();
  DocSet::RunTime::can_create_pdf();

  # source documents lookup
  DocSet::RunTime::scan_src_docs($base_path, \@search_paths, \@search_exts);
  my $full_src_path = find_src_doc($resource_rel_path);

  # rendering object singleton
  set_render_obj($obj);
  unset_render_obj();
  $obj = get_render_obj();

=head1 DESCRIPTION

This module is a part of the docset application, and it stores the run
time arguments, caches results of expensive calls and provide
Singleton-like service to the whole system.

=head1 FUNCTIONS

META: To be completed, see SYNOPSIS

=head2 Run Time Options

Only get_opts() method is exported by default.

=over

=item * registers_reset()

This function resets various run-time registers, used for validations.

If the runtime is run more than once remember to always run first this
function and even better always run it before using the runtime. e.g.:

  DocSet::RunTime::registers_reset();
  my $docset = DocSet::DocSet::HTML->new($config_file);
  $docset->set_dir(abs_root => ".");
  $docset->scan;
  $docset->render;

=item * register

  my @entries = register($register_name, $key, $val);

Push into the register for a given key the supplied value.

Return an array of the given register's key.

For example used to track duplicated docset ids with:

    my @entries = DocSet::RunTime::register('unique_docset_id', $id,
                                           $self->{config_file});
    die if @entries > 1;

because if the register returns two value for the same key, someone
has already registered that key before. The values in C<@entries>
include the config files in this example.

=item * set_opt(\%args)


=item * get_opts()


=back

=head2 Hosting System Capabilities Testing

These methods test the capability of the system and are a part of the
runtime system to perform the checking only once.

=over

=item * has_storable_module


=item * can_create_ps


=item * can_create_pdf

=back

=head2 Source Documents Lookup

A system for mapping L<> escapes to the located of the rendered
files. This system scans once the C<@search_paths> for files with
C<@search_exts> starting from C<$base_path> using scan_src_docs(). The
C<@search_paths> and C<@search_exts> are configured in the
I<config.cfg> file. For example:

    dir => {
             # search path for pods, etc. must put more specific paths first!
             search_paths => [qw(
                 foo/bar
                 foo
                 .
             )],
             # what extensions to search for
             search_exts => [qw(pod pm html)],
         },

So for example if the base path is I<~/myproject/src>, the files with
extensions I<.pod>, I<.pm> and I<.html> will be searched in
I<~/myproject/src/foo/bar>, I<~/myproject/src/foo> and
I<~/myproject/src>.

Notice that you must specify more specific paths first, since for
optimization the seen paths are skipped. Therefore in our example the
more explicit path I<foo/bar> was listed before the more general
I<foo>.

When the POD parser finds a L<> sequence it indentifies the resource
part and passes it to the find_src_doc() which looks up for this file
in the cache and returns its original (src) location, which can be
then easily converted to the final location and optionally adjusting
the extension, e.g. when the POD file is converted to HTML.

As a special extension this function automatically assumes that
C<index.html> will be generated in each directory containing items of
an interest. Therefore in find_src_doc() it'll automatically find
things like: L<the guide|guide::index>, even though there was no
source I<index.pod> or I<index.html> in first place.

Only the find_src_doc() function is exported by default.

=over

=item * scan_src_docs($base_path, \@search_paths, \@search_exts);

=item * find_src_doc($resource_rel_path);

returns C<undef> if nothing was found. See the description above.

=back


=head2 Rendering Object Singleton

Since the rendering process may happen by a third party system, into
which we provide hooks or overload some of its methods, it's quite
possible that we won't be able to access the current document (or
better rendering) object. One solution would be to have a global
package variable, but that's very error-prone. Therefore the used
solution is to provide a hook into a RunTime environment setting the
current rendering object when the rendering of a single page starts
via C<set_render_obj($obj)> and unsetting it when it's finished via
unset_render_obj(). Between these two moments the current rendering
object can be retrieved with get_render_obj() method.

Notice that this is all possible in the program which is not threaded,
or/and only one rendering process exists at any given time from its
start to its end.

All three methods are exported by default.

=over

=item * set_render_obj($obj)

Sets the current rendering object.

You cannot set a new rendering object before the previous one is
unset. This is in order to make sure that one document won't use by
mistake a rendering object of another document. So when the rendering
is done remember to call the unset_render_obj() function.

=item * unset_render_obj()

Unsets the currently set rendering object.

=item * get_render_obj()

Retrieves the currently set rendering object or complains aloud if it
cannot find one.

=back

=head1 AUTHORS

Stas Bekman E<lt>stas (at) stason.orgE<gt>

=cut