view release on metacpan or  search on metacpan

share/clean.pl  view on Meta::CPAN

<title></title>
<meta name="description" content="">
<meta name="keywords" content="">
<meta name="author" content="">
EOQ

#----------------------------------------------------------------------
# Main

my %opt;
getopts('r', \%opt);

if ($opt{r}) {
    revert_files(@ARGV);
} else {
    my $patterns = read_patterns(PATTERNS);
    clean_files($patterns, @ARGV);
}

#----------------------------------------------------------------------
# Add sections to cleaned file

sub add_sections {
    my ($text, $template) = @_;

    my @hold;
    my @output;
    my @input = web_split_at_tags($text);

    foreach my $tag ($template =~ /<[^>]*>/g) {
        if ($tag =~ /^<!--\s*end/) {
            push(@hold, $tag);

        } elsif ($tag =~ /^<!--/) {
            if (@hold) {
                push(@hold, $tag);
            } else {
                push(@output, shift @input);
                push(@output, "$tag\n");
            }

        } else {
            my $extra;
            if (@hold) {
                $extra = join("\n", @hold) . "\n";
                @hold = ();
            }

            my $output = search_for_tag(\@input, $tag, $extra);
            push(@output, $output);
        }
    }

    die "No matching tag for\n" . join("\n", @hold) . "\n" if @hold;

    push(@output, @input);
    return join('', @output)
}

#----------------------------------------------------------------------
# Create a backup copy of the original file

sub backup_file {
    my ($file, $text) = @_;
    $file .= '~';

    write_file($file, $text);
}

#----------------------------------------------------------------------
# Clean each file by substuting tokens with their patterns

sub clean_files {
    my ($patterns, @files) = @_;


    foreach my $file (@files) {
        my $text = slurp_file($file);
        backup_file($file, $text);

        my @tags = web_split_at_tags($text);
        my $tokens = {next => 0, data => \@tags};
        $text = replace_tokens($patterns, $tokens);

        $text = add_sections($text, TEMPLATE);
        $text = web_substitute_sections($text, {meta => METADATA});
        write_file($file, $text);
    }

    return;
}

#----------------------------------------------------------------------
# Remove parameters from a token

sub clean_token {
    my ($token) = @_;

    if (web_is_tag($token)) {
        $in_body = 1 if $in_body == 0 and $token =~ /^<body/;
        $in_body = 0 if $in_body == 1 and $token =~ /^<\/body/;
        $token =~ s/^<\s*([\/\w]+)[^>]*>/<$1>/ if $in_body;
    } 

    return $token;
}

#----------------------------------------------------------------------
# Fill text to fit 65+ characters per line

sub fill_text {
    my ($text) = @_;

    # Convert code to space
    $text =~ s/&#8198;/ /g;
    # Convert all white space to a single space
    $text =~ s/\s+/ /g;
    # Convert first white space after 65th character to a newline
    $text =~ s/(.{65}\S*)\s/$1\n/g;

    return $text;
}

#----------------------------------------------------------------------
# Find the location ($i) of the $iast-th asterisk in a pattern

sub find_asterisk {
    my ($pattern, $iast) = @_;

    for (my $i = 0; $i < @$pattern; $i++) {
        $iast -- if $pattern->[$i] eq '*';
        return $i if $iast == 0;
    }

    die "No asterisk found for replace_match";
}

#----------------------------------------------------------------------
# Find the $j-th group in the array