package Setup::Text::Snippet::WithID; BEGIN { $Setup::Text::Snippet::WithID::VERSION = '0.04'; } # ABSTRACT: Setup text snippet (with comment containing ID) in file use 5.010; use strict; use warnings; use Log::Any '$log'; use File::Slurp; require Exporter; our @ISA = qw(Exporter); our @EXPORT_OK = qw(setup_snippet_with_id); our %SPEC; sub _label { my %args = @_; my $id = $args{id} // ""; my $label = $args{label}; my $comment_style = $args{comment_style}; my $attrs_re = qr/(?:\w+=\S+\s+)*id=\Q$id\E(?:\s+\w+=\S+)*/; my ($ts, $te); if ($comment_style eq 'shell') { $ts = "#"; $te = ""; } elsif ($comment_style eq 'c') { $ts = "/*"; $te = "*/"; } elsif ($comment_style eq 'cpp') { $ts = "//"; $te = ""; } elsif ($comment_style eq 'html') { $ts = "<!--"; $te = "-->"; } elsif ($comment_style eq 'ini') { $ts = ";"; $te = ""; } else { die "BUG: unknown comment_style $comment_style"; } my $ore = qr!^(.*?)\s* \Q$ts\E\s*\Q$label\E\s+$attrs_re\s*\Q$te\E\s*(?:\R|\z)!mx; my $mre = qr!^\Q$ts\E\s*BEGIN\s+\Q$label\E\s+$attrs_re\s*\Q$te\E\s*\R (.*?) ^\Q$ts\E\s*END \s+\Q$label\E\s+$attrs_re\s*\Q$te\E \s*(?:\R|\z)!msx; return { one_line_comment => " $ts $label id=$id" . ($te ? " $te":""), begin_comment => "$ts BEGIN $label id=$id" . ($te ? " $te":""), end_comment => "$ts END $label id=$id" . ($te ? " $te":""), one_line_pattern => $ore, multi_line_pattern => $mre, }; } $SPEC{setup_snippet_with_id} = { summary => "Setup text snippet (with comment containing ID) in file", description => <<'_', On do, will insert a snippet of text with specified ID to a file, if it doesn't already exist. Usually used for inserting tidbits of configuration into configuration files. Snippets are enclosed with comment (shell-style by default, or alternatively C++/C-style) giving them ID. Example of one-line snippet: some text # SNIPPET id=id1 Example of multi-line snippet (using C++-style comment instead of shell-style): // BEGIN SNIPPET id=id2 some lines of text // END SNIPPET On undo, will remove the snippet. _ args => { file => ['str*' => { summary => 'File name', description => <<'_', File must already exist. _ }], id => ['str*' => { summary => 'Snippet ID', match => qr/\A[\w-]+\z/, }], content => ['str*' => { summary => 'Snippet text', description => <<'_', String containing text). _ }], should_exist => ['bool' => { summary => 'Whether snippet should exist', description => <<'_', You can set this to false if you want to ensure snippet doesn't exist. _ default => 1, }], top_style => ['bool' => { summary => 'Whether to append snippet at beginning of file '. 'instead of at the end', description => <<'_', Default is false, which means to append at the end of file. Note that this only has effect if replace_pattern is not defined or replace pattern is not found in file. Otherwise, snippet will be inserted to replace the pattern. _ default => 0, }], replace_pattern => ['str' => { summary => 'Regex pattern which if found will be used for '. 'placement of snippet', description => <<'_', If snippet needs to be inserted into file, then if replace_pattern is defined then it will be searched. If found, snippet will be placed to replace the pattern. Otherwise, snippet will be inserted at the end (or beginning, see top_style) of file. _ }], good_pattern => ['str' => { summary => 'Regex pattern which if found means snippet '. 'need not be inserted', }], comment_style => ['str' => { summary => 'Comment style', in => [qw/c cpp html shell ini/], default => 'shell', description => <<'_', Snippet is inserted along with comment which contains meta information such as snippet ID (so it can be identified and updated/removed later when necessary). Example of shell-style (shell) comment: ... # SNIPPET id=... # BEGIN SNIPPET id=... ... # END SNIPPET Example of C-style (c) comment: .... /* SNIPPET id=... */ /* BEGIN SNIPPET id=... */ ... /* END SNIPPET id=... */ Example of C++-style (cpp) comment: .... // SNIPPET id=... // BEGIN SNIPPET id=... ... // END SNIPPET id=... Example of SGML-style (html) comment: .... <!-- SNIPPET id=... --> <!-- BEGIN SNIPPET id=... --> ... <!-- END SNIPPET id=... --> Example of INI-style comment: .... // SNIPPET id=... ; BEGIN SNIPPET id=... ... ; END SNIPPET id=... _ }], label => ['any' => { of => ['str*', 'code*'], default => 'SNIPPET', summary => 'Comment label', description => <<'_', If label is string (e.g. 'Foo'), then one-line snippet comment will be: # Foo id=... and multi-line snippet comment: # BEGIN Foo id=... ... # END Foo id=... If label is coderef, it will be called with named arguments: id, comment_style. It must return a hash with these keys: one_line_comment, begin_comment, end_comment, one_line_pattern (regex to match snippet content and extract it in $1), and multi_line_pattern (regex to match snippet content and extract it in $1). _ }], }, features => {undo=>1, dry_run=>1}, }; sub setup_snippet_with_id { my %args = @_; my $dry_run = $args{-dry_run}; my $undo_action = $args{-undo_action} // ""; # check args my $file = $args{file}; defined($file) or return [400, "Please specify file"]; my $id = $args{id}; defined($id) or return [400, "Please specify id"]; $id =~ /\A[\w-]+\z/ or return [400, "Invalid id, please only use alphanums/dashes"]; my $should_exist = $args{should_exist} // 1; my $replace_pattern = $args{replace_pattern}; my $good_pattern = $args{good_pattern}; my $top_style = $args{top_style} // 0; defined($args{content}) or return [400, "Please specify content"]; my ($label, $label_sub); if (ref($args{label}) eq 'CODE') { $label = "SNIPPET"; $label_sub = $args{label}; } else { $label = $args{label} // "SNIPPET"; $label_sub = \&_label; } my $comment_style = $args{comment_style} // "shell"; my $res = $label_sub->(id=>$id, label=>$label, comment_style=>$comment_style); my $one_line_comment = $res->{one_line_comment}; my $begin_comment = $res->{begin_comment}; my $end_comment = $res->{end_comment}; my $one_line_pattern = $res->{one_line_pattern}; my $multi_line_pattern = $res->{multi_line_pattern}; # collect steps my $steps; if ($undo_action eq 'undo') { $steps = $args{-undo_data} or return [400, "Please supply -undo_data"]; } else { $steps = []; if ($should_exist) { push @$steps, ["insert"] } else { push @$steps, ["remove"] } } my $save_undo = $undo_action ? 1:0; return [400, "Invalid steps, must be an array"] unless $steps && ref($steps) eq 'ARRAY'; # perform the steps my $rollback; my $undo_steps = []; my $changed; STEP: for my $i (0..@$steps-1) { my $step = $steps->[$i]; $log->tracef("step %d of 0..%d: %s", $i, @$steps-1, $step); my $err; return [400, "Invalid step (not array)"] unless ref($step) eq 'ARRAY'; if ($step->[0] eq 'insert' || $step->[0] eq 'remove') { my $content = $step->[1] // $args{content}; my $is_multi = $content =~ /\R/; if ($is_multi) { # autoappend newline $content =~ s/\R\z//; $content .= "\n"; } else { # autotrim one-line $content =~ s/\s+\z//; } if (!(-f $file)) { if ($step->[0] eq 'insert') { $err = "Must insert snippet, but file doesn't exist"; goto CHECK_ERR; } else { $log->info("File doesn't exist, skipping step"); next STEP; } } my $str = read_file($file, err_mode=>'quiet'); if (!defined($str)) { $err = "Can't read file $file: $!"; goto CHECK_ERR; } my $typ; my $ct; my $do_remove; my $do_insert; if ($str =~ /$one_line_pattern/ && ($typ = 'oneline') || $str =~ /$multi_line_pattern/ && ($typ = 'multi')) { $ct = $1; if ($step->[0] eq 'insert' && $ct ne $content) { $log->infof("nok: file %s: snippet content is >>>%s<<< ". "but needs to be >>>%s<<<", $file, $ct, $content); $do_insert++; } elsif ($step->[0] eq 'remove') { $log->info("nok: file $file: snippet exists when ". "it should be removed"); } else { next STEP; } return [200, "dry run"] if $dry_run; $do_remove++; if ($typ eq 'oneline') { $str =~ s/$one_line_pattern//; } else { $str =~ s/$multi_line_pattern//; } } else { if ($step->[0] eq 'remove') { # file already lacks snippet next STEP; } else { if ($good_pattern && $str =~ /$good_pattern/) { $log->debugf( "File contains good_pattern %s, so we don't need ". "to insert snippet", $good_pattern); } else { $log->info("nok: file $file: snippet doesn't exist"); $do_insert++; } } } if ($do_insert) { return [200, "dry run"] if $dry_run; my $snippet; if ($is_multi) { $snippet = join( "", $begin_comment, "\n", $content, $end_comment, "\n" ); } else { $snippet = $content . $one_line_comment . "\n"; } if ($replace_pattern && $str =~ /$replace_pattern/) { $str =~ s/$replace_pattern/$snippet/; } elsif ($top_style) { $str = $snippet . $str; } else { $str .= ($str =~ /\R\z/ || !length($str) ? "" : "\n") . $snippet; } } if ($do_insert || $do_remove) { $log->tracef("Updating file %s ...", $file); if (!write_file($file, {err_mode=>'quiet', atomic=>1}, $str)) { $err = "Can't write file: $!"; goto CHECK_ERR; } $changed++; if ($step->[0] eq 'remove') { unshift @$undo_steps, ['insert', $ct]; } else { unshift @$undo_steps, ['remove']; } } } else { die "BUG: Unknown step command: $step->[0]"; } CHECK_ERR: if ($err) { if ($rollback) { die "Failed rollback step $i of 0..".(@$steps-1).": $err"; } else { $log->tracef("Step failed: $err, performing rollback (%s)...", $undo_steps); $rollback = $err; $steps = $undo_steps; goto STEP; # perform steps all over again } } } return [500, "Error (rollbacked): $rollback"] if $rollback; my $data = undef; my $meta = {}; $meta->{undo_data} = $undo_steps if $save_undo; $log->tracef("meta: %s", $meta); return [$changed ? 200:304, $changed?"OK":"Nothing done", $data, $meta]; } =pod =head1 NAME Setup::Text::Snippet::WithID - Setup text snippet (with comment containing ID) in file =head1 VERSION version 0.04 =head1 SYNOPSIS use Setup::Text::Snippet::WithID 'setup_snippet_with_id'; my $res = setup_snippet_with_id file => '/etc/default/rsync', id => 'enable', content => 'RSYNC_ENABLE=1', good_pattern => qr/^RSYNC_ENABLE\s*=\s*1/m, replace_pattern => qr/^RSYNC_ENABLE\s*=.+/m; die unless $res->[0] == 200; Resulting /etc/default/rsync: RSYNC_ENABLE=1 # SNIPPET id=enable The above code's goal is to enable rsync daemon by default. If /etc/default/rsync already contains the "good pattern" (qr/^RSYNC_ENABLE\s*=\s*1/m), it will not be inserted with snippet. Snippet will replace text specified in replace_pattern (or if replace_pattern is not defined, snippet will be appended to the end of file [or beginning of file if top_style=>1]). Example of multi-line snippet, in INI-style comment instead of shell-style: ; BEGIN SNIPPET id=default register_globals=On extension=mysql.so extension=gd.so memory_limit=256M post_max_size=64M upload_max_filesize=64M browscap=/c/share/php/browscap.ini allow_url_fopen=0 ; END SNIPPET id=default =head1 DESCRIPTION This module provides one function: B<setup_snippet_with_id>. This module is part of the Setup modules family. This module uses L<Log::Any> logging framework. This module's functions have L<Sub::Spec> specs. =head1 THE SETUP MODULES FAMILY I use the C<Setup::> namespace for the Setup modules family. See C<Setup::File> for more details on the goals, characteristics, and implementation of Setup modules family. =head1 FUNCTIONS None are exported by default, but they are exportable. =head2 setup_snippet_with_id(%args) -> [STATUS_CODE, ERR_MSG, RESULT] Setup text snippet (with comment containing ID) in file. On do, will insert a snippet of text with specified ID to a file, if it doesn't already exist. Usually used for inserting tidbits of configuration into configuration files. Snippets are enclosed with comment (shell-style by default, or alternatively C++/C-style) giving them ID. Example of one-line snippet: some text # SNIPPET id=id1 Example of multi-line snippet (using C++-style comment instead of shell-style): // BEGIN SNIPPET id=id2 some lines of text // END SNIPPET On undo, will remove the snippet. Returns a 3-element arrayref. STATUS_CODE is 200 on success, or an error code between 3xx-5xx (just like in HTTP). ERR_MSG is a string containing error message, RESULT is the actual result. This function supports undo operation. See L<Sub::Spec::Clause::features> for details on how to perform do/undo/redo. This function supports dry-run (simulation) mode. To run in dry-run mode, add argument C<-dry_run> => 1. Arguments (C<*> denotes required arguments): =over 4 =item * B<comment_style> => I<str> (default C<"shell">) Value must be one of: ["c", "cpp", "html", "shell", "ini"] Comment style. Snippet is inserted along with comment which contains meta information such as snippet ID (so it can be identified and updated/removed later when necessary). Example of shell-style (shell) comment: ... # SNIPPET id=... # BEGIN SNIPPET id=... ... # END SNIPPET Example of C-style (c) comment: .... /* SNIPPET id=... */ /* BEGIN SNIPPET id=... */ ... /* END SNIPPET id=... */ Example of C++-style (cpp) comment: .... // SNIPPET id=... // BEGIN SNIPPET id=... ... // END SNIPPET id=... Example of SGML-style (html) comment: .... <!-- SNIPPET id=... --> <!-- BEGIN SNIPPET id=... --> ... <!-- END SNIPPET id=... --> Example of INI-style comment: .... // SNIPPET id=... ; BEGIN SNIPPET id=... ... ; END SNIPPET id=... =item * B<content>* => I<str> Snippet text. String containing text). =item * B<file>* => I<str> File name. File must already exist. =item * B<good_pattern> => I<str> Regex pattern which if found means snippet need not be inserted. =item * B<id>* => I<str> Snippet ID. =item * B<label> => I<code|str> (default C<"SNIPPET">) Comment label. If label is string (e.g. 'Foo'), then one-line snippet comment will be: # Foo id=... and multi-line snippet comment: # BEGIN Foo id=... ... # END Foo id=... If label is coderef, it will be called with named arguments: id, comment_style. It must return a hash with these keys: one_line_comment, begin_comment, end_comment, one_line_pattern (regex to match snippet content and extract it in $1), and multi_line_pattern (regex to match snippet content and extract it in $1). =item * B<replace_pattern> => I<str> Regex pattern which if found will be used for placement of snippet. If snippet needs to be inserted into file, then if replace_pattern is defined then it will be searched. If found, snippet will be placed to replace the pattern. Otherwise, snippet will be inserted at the end (or beginning, see top_style) of file. =item * B<should_exist> => I<bool> (default C<1>) Whether snippet should exist. You can set this to false if you want to ensure snippet doesn't exist. =item * B<top_style> => I<bool> (default C<0>) Whether to append snippet at beginning of file instead of at the end. Default is false, which means to append at the end of file. Note that this only has effect if replace_pattern is not defined or replace pattern is not found in file. Otherwise, snippet will be inserted to replace the pattern. =back =head1 BUGS/TODOS/LIMITATIONS If a snippet is removed due to should_exist=>0, its position is not recorded. Thus the undo step will reinsert snippet according to replace_pattern/top_style instead of the original position. The undo also currently doesn't record whether newline was autoappended on the file, so it doesn't restore that. TODO: Restore attrs. =head1 SEE ALSO Other modules in Setup:: namespace. =head1 AUTHOR Steven Haryanto <stevenharyanto@gmail.com> =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2011 by Steven Haryanto. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut __END__