cid results from the CPAN

App-DocKnot

        $in_tree = 1;
    }

    # Add the end-of-page navbar if we have sitemap information.
    if ($self->{sitemap} && $self->{output}) {
        my $page = $out_path->relative($self->{output});
        $output .= join(q{}, $self->{sitemap}->navbar($page)) . "\n";
    }

    # Figure out the modification dates.  Use the RCS/CVS Id if available,
    # otherwise use the Git repository if available.
    my $modified;
    if (defined($id)) {
        my (undef, undef, $date) = split(q{ }, $id);
        if ($date && $date =~ m{ \A (\d+) [-/] (\d+) [-/] (\d+) }xms) {
            $modified = sprintf('%d-%02d-%02d', $1, $2, $3);
        }
    } elsif ($self->{repository} && $in_tree) {
        $modified = $self->{repository}->run(
            'log', '-1', '--format=%ct', "$source",
        );
        if ($modified) {
            $modified = strftime('%Y-%m-%d', gmtime($modified));
        }
    }
    if (!$modified) {
        $modified = strftime('%Y-%m-%d', gmtime($source->stat()->[9]));
    }
    my $now = strftime('%Y-%m-%d', gmtime());

    # Determine which template to use and substitute in the appropriate times.
    $output .= "<address>\n" . q{ } x 4;
    my $template = ($modified eq $now) ? $templates[0] : $templates[1];
    $template =~ s{ %MOD% }{$modified}xmsg;
    $template =~ s{ %NOW% }{$now}xmsg;
    $template =~ s{ %URL% }{$URL}xmsg;
    $output .= "$template\n";
    $output .= "</address>\n";

    return $output;
}

##############################################################################
# External converters
##############################################################################

# Given the output from a converter, the file to save the output in, and an
# anonymous sub that takes three arguments, the first being the captured
# blurb, the second being the document ID if found, and the third being the
# base name of the output file, and prints out a last modified line, reformat
# the output of an external converter.
sub _write_converter_output {
    my ($self, $page_ref, $output, $footer) = @_;
    my $page = $output->relative($self->{output});
    my $out_fh = $output->openw_utf8();

    # Grab the first few lines of input, looking for a blurb and Id string.
    # Give up if we encounter <body> first.  Also look for a </head> tag and
    # add the navigation link tags before it, if applicable.  Add the
    # navigation bar right at the beginning of the body.
    my ($blurb, $docid);
    while (defined(my $line = shift($page_ref->@*))) {
        if ($line =~ m{ <!-- \s* (\$Id.*?) \s* --> }xms) {
            $docid = $1;
        }
        if ($line =~ m{ <!-- \s* ( (?:Generated|Converted) .*? )\s* --> }xms) {
            $blurb = $1;

            # Only show the date of the output, not the time or time zone.
            $blurb =~ s{ [ ] \d\d:\d\d:\d\d [ ] -0000 }{}xms;

            # Strip the date from the converter version output.
            $blurb =~ s{ [ ] [(] \d{4}-\d\d-\d\d [)] }{}xms;
        }
        if ($self->{sitemap} && $line =~ m{ \A </head> }xmsi) {
            my @links = $self->{sitemap}->links($page);
            if (@links) {
                print_fh($out_fh, $output, @links);
            }
        }
        print_fh($out_fh, $output, $line);
        if ($line =~ m{ <body }xmsi) {
            if ($self->{sitemap}) {
                my @navbar = $self->{sitemap}->navbar($page);
                if (@navbar) {
                    print_fh($out_fh, $output, @navbar);
                }
            }
            last;
        }
    }
    warn "$0 spin: malformed HTML output for $output\n" unless $page_ref->@*;

    # Snarf input and write it to output until we see </body>, which is our
    # signal to start adding things.  We just got very confused if </body> was
    # on the same line as <body>, so don't do that.
    my $line;
    while (defined($line = shift($page_ref->@*))) {
        last if $line =~ m{ </body> }xmsi;
        print_fh($out_fh, $output, $line);
    }

    # Add the footer and finish with the output.
    print_fh($out_fh, $output, $footer->($blurb, $docid));
    if (defined($line)) {
        print_fh($out_fh, $output, $line, $page_ref->@*);
    }
    close($out_fh);
    return;
}

# These methods are all used, but are indirected through a table, so
# perlcritic gets confused.
#
## no critic (Subroutines::ProhibitUnusedPrivateSubroutines)

# A wrapper around the cl2xhtml script, used to handle .changelog pointers in
# a tree being spun.  Adds the navigation links and the signature to the
# cl2xhtml output.
sub _cl2xhtml {
    my ($self, $source, $output, $options, $style) = @_;
    $style ||= $self->{style_url} . 'changelog.css';
    my @page = capture("cl2xhtml $options -s $style $source");
    @page = map { decode('utf-8', $_) } @page;
    my $footer = sub {
        my ($blurb, $id) = @_;
        if ($blurb) {
            $blurb =~ s{ cl2xhtml }{\n<a href="$URL">cl2xhtml</a>}xms;
        }
        $self->_footer($source, $output, $id, $blurb, $blurb);
    };
    $self->_write_converter_output(\@page, $output, $footer);
    return;
}

# A wrapper around the cvs2xhtml script, used to handle .log pointers in a
# tree being spun.  Adds the navigation links and the signature to the
# cvs2xhtml output.
sub _cvs2xhtml {
    my ($self, $source, $output, $options, $style) = @_;
    $style ||= $self->{style_url} . 'cvs.css';

    # Separate the source file into a directory and filename.
    my $name = $source->basename();
    my $dir = $source->parent();

    # Construct the options to cvs2xhtml.
    if ($options !~ m{ -n [ ] }xms) {
        $options .= " -n $name";
    }
    $options .= " -s $style";

    # Run the converter and write the output.
    my @page = capture("(cd $dir && cvs log $name) | cvs2xhtml $options");
    @page = map { decode('utf-8', $_) } @page;
    my $footer = sub {
        my ($blurb, $id, $file) = @_;
        if ($blurb) {
            $blurb =~ s{ cvs2xhtml }{\n<a href="$URL">cvs2xhtml</a>}xms;
        }
        $self->_footer($source, $output, $id, $blurb, $blurb);
    };
    $self->_write_converter_output(\@page, $output, $footer);
    return;

lib/App/DocKnot/Spin.pm view on Meta::CPAN

##############################################################################

# Given a pointer file, read the master file name and any options, returning
# them as a list with the newlines chomped off.
#
# $file - Path::Tiny for the file to read
#
# Returns: List of the master file, any command-line options, and the style
#          sheet to use, as strings
#  Throws: Text exception if no master file is present in the pointer
#          autodie exception if the pointer file could not be read
sub _read_pointer {
    my ($self, $file) = @_;

    # Read the pointer file.
    my ($master, $options, $style) = $file->lines_utf8();

    # Clean up the contents.
    if (!$master) {
        die "no master file specified in $file\n";
    }
    chomp($master);
    if (defined($options)) {
        chomp($options);
    } else {
        $options = q{};
    }
    if (defined($style)) {
        chomp($style);
    }

    # Return the details.
    return (path($master), $options, $style);
}

# Convert an input path to an output path.
#
# $input     - Path::Tiny input path
# $extension - If given, remove this extension and add .html in its place
sub _output_for_file {
    my ($self, $input, $extension) = @_;
    my $output = $input->relative($self->{source})->absolute($self->{output});
    if ($extension) {
        my $output_file = $input->basename($extension) . '.html';
        $output = $output->sibling($output_file);
    }
    return $output;
}

# Report an action to standard output.
#
# $action - String description of the action
# $output - Output file generated
sub _report_action {
    my ($self, $action, $output) = @_;
    my $shortout = $output->relative($self->{output});
    print_checked("$action .../$shortout\n");
    return;
}

# This routine is called for every file in the source tree.  It decides what
# to do with each file, whether spinning it or copying it.
#
# $input - Path::Tiny path to the input file
#
# Throws: Text exception on any processing error
#         autodie exception if files could not be accessed or written
sub _process_file {
    my ($self, $input) = @_;

    # Conversion rules for pointers.  The key is the extension, the first
    # value is the name of the command for the purposes of output, and the
    # second is the name of the method to run.
    #<<<
    my %rules = (
        changelog => ['cl2xhtml',   '_cl2xhtml'],
        faq       => ['faq2html',   '_faq2html'],
        log       => ['cvs2xhtml',  '_cvs2xhtml'],
        rpod      => ['pod2thread', '_pod2html'],
    );
    #>>>

    # Figure out what to do with the input.
    if ($input->is_dir()) {
        my $output = $self->_output_for_file($input);
        $self->{generated}{"$output"} = 1;
        if ($output->exists() && !$output->is_dir()) {
            die "cannot replace $output with a directory\n";
        } elsif (!$output->is_dir()) {
            $self->_report_action('Creating', $output);
            $output->mkpath();
        }
    } elsif ($input->basename() =~ m{ [.] spin \z }xms) {
        my $output = $self->_output_for_file($input, '.spin');
        $self->{generated}{"$output"} = 1;
        if ($self->{pointer}->is_out_of_date($input, $output)) {
            $self->_report_action('Converting', $output);
            $self->{pointer}->spin_pointer($input, $output);
        }
    } elsif ($input->basename() =~ m{ [.] th \z }xms) {
        my $output = $self->_output_for_file($input, '.th');
        $self->{generated}{"$output"} = 1;

        # See if we're forced to regenerate the file because it is affected by
        # a software release.
        if ($output->exists() && $self->{versions}) {
            my $relative = $input->relative($self->{source});
            my $time = $self->{versions}->latest_release($relative);
            return
              if is_newer($output, $input) && $output->stat()->[9] >= $time;
        } else {
            return if is_newer($output, $input);
        }

        # The output file is not newer.  Respin it.
        $self->_report_action('Spinning', $output);
        $self->{thread}->spin_thread_file($input, $output);
    } else {
        my ($extension) = ($input->basename =~ m{ [.] ([^.]+) \z }xms);
        if (defined($extension) && $rules{$extension}) {
            my ($name, $sub) = $rules{$extension}->@*;

( run in 1.062 second using v1.01-cache-2.11-cpan-39bf76dae61 )