view release on metacpan or  search on metacpan

lib/App/Followme/FormatPage.pm  view on Meta::CPAN

#----------------------------------------------------------------------
# Extract named blocks from a page

sub parse_page {
    my ($self, $page) = @_;

    my $blocks = {};
    my $block_handler = sub {
        my ($blockname, $locality, $blocktext) = @_;
        if (exists $blocks->{$blockname}) {
            die "Duplicate block name ($blockname)\n";
        }
        $blocks->{$blockname} = $blocktext;
        return;
    };

    my $prototype_handler = sub {
        return;
    };

    $self->parse_blocks($page, $block_handler, $prototype_handler);
    return $blocks;
}

#----------------------------------------------------------------------
# Initialize the extension

sub setup {
    my ($self) = @_;

    $self->{extension} = $self->{web_extension};
    return;
}

#----------------------------------------------------------------------
# Determine if page matches prototype or needs to be updated

sub unchanged_prototype {
    my ($self, $prototype, $page, $prototype_path) = @_;

    my $prototype_checksum =
        $self->checksum_prototype($prototype, $prototype_path);

    my $page_checksum =
        $self->checksum_prototype($page, $prototype_path);

    my $unchanged;
    if ($prototype_checksum eq $page_checksum) {
        $unchanged = 1;
    } else {
        $unchanged = 0;
    }

    return $unchanged;
}

#----------------------------------------------------------------------
# Update file using prototype

sub update_file {
    my ($self, $file, $prototype, $prototype_path) = @_;

    my $page = fio_read_page($file);
    return unless defined $page;

    # Check for changes before updating page
    return 0 if $self->unchanged_prototype($prototype, $page, $prototype_path);

    $page = $self->update_page($page, $prototype, $prototype_path);

    my $modtime = fio_get_date($file);
    fio_write_page($file, $page);
    fio_set_date($file, $modtime);

    return 1;
}

#----------------------------------------------------------------------
# Perform all updates on the directory

sub update_folder {
    my ($self, $folder, $prototype_file) = @_;

    my $index_file = $self->to_file($folder);
    my ($prototype_path, $prototype);
    my $modtime = fio_get_date($folder);

    my $files = $self->{data}->build('files_by_mdate_reversed', $index_file);
    my $file = shift(@$files);

    if ($file) {
        # The first update uses a file from the  directory above
        # as a prototype, if one is found

        $prototype_file ||= $self->find_prototype($folder, 1);

        if ($prototype_file) {
            $prototype_path = $self->get_prototype_path($prototype_file);
            my $prototype = fio_read_page($prototype_file);

            eval {$self->update_file($file, $prototype, $prototype_path)};
            $self->check_error($@, $file);
        }

        # Subsequent updates use the most recently modified file
        # in the directory as the prototype

        $prototype_file = $file;
        $prototype_path = $self->get_prototype_path($prototype_file);
        $prototype = fio_read_page($prototype_file);
    }

    my $changes = 0;
    foreach my $file (@$files) {
        my $change;
        eval {$change = $self->update_file($file, $prototype, $prototype_path)};
        $self->check_error($@, $file);

        last unless $change;
        $changes += 1;
    }

    fio_set_date($folder, $modtime);

    # Update files in subdirectory

    if ($changes || @$files == 0) {
        my $folders = $self->{data}->build('folders', $index_file);

        foreach my $subfolder (@$folders) {
            $self->update_folder($subfolder, $prototype_file);
        }
    }

    return;
}

#----------------------------------------------------------------------
# Parse prototype and page and combine them

sub update_page {
    my ($self, $page, $prototype, $prototype_path) = @_;
    $prototype_path = {} unless defined $prototype_path;

    my $output = [];
    my $blocks = $self->parse_page($page);

    my $block_handler = sub {
        my ($blockname, $locality, $blocktext) = @_;
        if (exists $blocks->{$blockname}) {
            if (exists $prototype_path->{$locality}) {
                push(@$output, $blocktext);
            } else {
                push(@$output, $blocks->{$blockname});
            }
            delete $blocks->{$blockname};
        } else {
            push(@$output, $blocktext);
        }
        return;
    };

    my $prototype_handler = sub {
        my ($blocktext) = @_;
        push(@$output, $blocktext);
        return;
    };

    $self->parse_blocks($prototype, $block_handler, $prototype_handler);

    if (%$blocks) {
        my $names = join(' ', sort keys %$blocks);
        die "Unused blocks ($names)\n";
    }

    return join('', @$output);
}

1;
__END__

=encoding utf-8

=head1 NAME

App::Followme::FormatPages - Modify pages in a directory to match a prototype

=head1 SYNOPSIS

    use App::Followme::FormatPages;
    my $formatter = App::Followme::FormatPages->new($configuration);
    $formatter->run($directory);

=head1 DESCRIPTION

App::Followme::FormatPages updates the web pages in a folder to match the most
recently modified page. Each web page has sections that are different from other
pages and other sections that are the same. The sections that differ are
enclosed in html comments that look like

    <!-- section name-->