package votorola::b::AutoEditor; # Copyright 2000-2002, 2009, Michael Allan.  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Votorola Software"), to deal in the Votorola Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicence, and/or sell copies of the Votorola Software, and to permit persons to whom the Votorola Software is furnished to do so, subject to the following conditions: The preceding copyright notice and this permission notice shall be included in all copies or substantial portions of the Votorola Software. THE VOTOROLA SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE VOTOROLA SOFTWARE OR THE USE OR OTHER DEALINGS IN THE VOTOROLA SOFTWARE.

use strict; use warnings;
=pod

=head1 DESCRIPTION

Evaluates scripts that are embedded in source files.  The scripts are identified by
bracketing lines that contain the text C<begin votorola::b::AutoEditor_Script> and C<end
votorola::b::AutoEditor_Script>.  Any other text within the bracketing lines is ignored.

The default package for script execution is votorola::b::AutoEditor_Script.  The script
may explicitly assign a different package using the Perl keyword C<package>.

I<To auto-edit an HTML file:>

 <!-- begin votorola::b::AutoEditor_Script
  push( @buffer, "this line was generated by my script\n" );
  end votorola::b::AutoEditor_Script -->

I<To auto-edit a Perl script:>

 =pod

 =begin votorola::b::AutoEditor_Script

 my $i = $begin - 3; # back up, above the pod line
 $buffer[$i] .= "this line was generated by my script\n";

 =end votorola::b::AutoEditor_Script

 =cut

=head1 EXPORTS

=over 4

=cut

BEGIN
{
    use Exporter ();
    our @ISA; @ISA = qw( Exporter );
    our @EXPORT_OK; @EXPORT_OK = qw( auto_edit auto_edit_custom auto_edit_found $auto_edit_top
      auto_edit_voter_command_doc $begin @buffer $ddash $is_buffer_changed );
}
our @EXPORT_OK;

{
    use votorola::b::Config qw( do_fail config_basepath_from_package );
    my $config_path = config_basepath_from_package(__PACKAGE__) . '.pl';
    do $config_path or do_fail $config_path;
}



=pod

=item B<auto_edit>( $I<file> [, $I<to_mark>] )

Auto-edits the specified file by executing any embedded scripts.  If $I<to_mark> is set
true, the bracketing lines of each executed script are marked, so that repeated calls will
have no effect.  Returns 1 if the file was modified, 0 otherwise.

=cut

sub auto_edit( $;$ )
{
    my $file = shift;
    my $to_mark = shift; my $mark = defined $to_mark? 'processed ': '';

    our @buffer; undef @buffer;
    our $begin; undef $begin;
    our $is_buffer_changed; undef $is_buffer_changed;

    my $script_text;
    my $evaluation_count = 0; # thus far
    open FILE, "<$file" or die $!;
    {
        while( <FILE> )
        {
            my $line = $_;
            if( $line =~ s!begin( +)votorola::b::AutoEditor_Script!begin$1${mark}votorola::b::AutoEditor_Script! )
            {
                $begin = @buffer;
            }
            elsif( $line =~ s!end( +)votorola::b::AutoEditor_Script!end$1${mark}votorola::b::AutoEditor_Script! )
            {
                defined $begin or die "end votorola::b::AutoEditor_Script without begin: $file (" . scalar @buffer + 1 . ") \n"; # +1 from zero-based

                $script_text = join '', @buffer[$begin+1..@buffer-1];
            }
            push( @buffer, $line );
            if( defined $script_text )
            {
                $is_buffer_changed = 1; # till proven otherwise
                {
                    package votorola::b::AutoEditor_Script;
                    eval $script_text;
                    die "(file=$file) $@" if $@;
                }
                ++$evaluation_count if $is_buffer_changed;
                $begin = undef; $script_text = undef;
            }
        }
        close FILE;
    }
    !defined $begin or die "begin votorola::b::AutoEditor_Script without end: $file (" . ($begin + 1) . ") \n"; # +1 from zero-based
    $evaluation_count or return;

    open FILE, ">$file" or die "$file: $!";
    {
        for my $line( @buffer )
        {
            print FILE $line;
        }
        close FILE;
    }
    return 1;
}



=pod

=item B<auto_edit_found>

File::Find "wanted" sub that attempts to auto-edit every file it sees.

=cut

sub auto_edit_found()
{
    use votorola::b::FileSync qw( editor_locked $editor_locked_message );

    my $file = $File::Find::name;
    if( editor_locked( $file )) { print "\n$editor_locked_message\n"; return; }

    -f $file && -T $file && -w $file or return; # unless text file, writeable

    if( auto_edit( $file ))
    {
        print( $file . "\n" );
    }
}



=pod

=item $B<auto_edit_top>

Index of top line in buffer, marked for the use of a subsequent embedded script.

=cut

our $auto_edit_top;



=pod

=item B<auto_edit_voter_command_doc>( $I<service_class>, $I<command_name> )

For embedded AutoEditor scripts, updates the immediately preceding command doc that
commences at line $C<auto_edit_top>.  Dies if $C<auto_edit_top> was not defined, e.g. by a
previous embedded script; otherwise automatically undefines it, in preparation for the
next use.

The response text is that generated by sumbitting "$I<command_name> --help" to an instance
of the given $I<service_class>, and doing some generic formatting on it.

=cut

sub auto_edit_voter_command_doc( $$ )
{
    use votorola::b::Function qw( chomped );
    my $service_class = shift;
    my $command_name = shift;

    our $auto_edit_top;
    defined $auto_edit_top or die;
    my $top = $auto_edit_top; undef $auto_edit_top;

    our $is_buffer_changed;
    my $response = chomped( response_for_voter_command( $service_class, "$command_name --help" ));
    $is_buffer_changed = length( $response ) > 0;
    $is_buffer_changed or return;

    $response =~ s!([A-Z]{2,}(?:-[A-Z]{2,})*)!<var>$1</var>!g; # VOTER-EMAIL -> <var>VOTER-EMAIL</var> # var-ifying all-caps variables

    my $text = "\n            <!-- DO NOT EDIT.  This command doc is automatically generated by "
      . __FILE__ . " -->\n";
    $text .= qq|            <pre>$response</pre>\n|;
    $text .= qq|\n|;

    our $begin; our @buffer;
    $is_buffer_changed = $text ne join( '', @buffer[$top..$begin-1] );
    $is_buffer_changed or return;

    splice( @buffer, $top, $begin - $top, $text );
}



=pod

=item $B<begin>

Index of the initial bracketing line in the @buffer.

=cut

our $begin;



=pod

=item @B<buffer>

Buffer of lines up to and including the final bracketing line of the script.
Once all scripts have executed, the file is re-written from this buffer.
Most scripts will append additional lines, for example:

  push( @buffer, "this line was generated by my script\n" );

=cut

our @buffer;



=pod

=item $B<ddash>

A double dash string '--'.  This is a convenience for use in scripts that are embedded in
HTML comments, where double dashes are disallowed.

=cut

our $ddash = '--';



=pod

=item $B<is_buffer_changed>

Flag indicating whther or not the script has modified the buffer.  Initially this is set
to 1.  If the script makes no modifications, then it may clear this flag.  If the flag
remains set for at least one script, then the file will be overwritten by the buffer;
otherwise the file will be left untouched.

=cut

our $is_buffer_changed;



1;