[modify.pl] add support for groups
Now lines without commas with be handled correctly. Note that I cannot simply split on commas, because the "blocks" are grouped differently, in a way that is useful for the user during addition, removal or sorting operations. There is a limitation on adding an entry: currently it is added to the first "block" and user is given no choice. This can be fixed easily.
This commit is contained in:
Sławomir Nizio
367
modify.pl
367
modify.pl
@@ -32,7 +32,6 @@ my $file;
|
||||
my $section;
|
||||
|
||||
my $warn_on_unsorted = 1; # true; warn only once
|
||||
my @section_strings;
|
||||
|
||||
##### options ######
|
||||
exit 1 unless
|
||||
@@ -89,42 +88,14 @@ flock($fh_lock, LOCK_EX | LOCK_NB) or die ("Cannot lock file!\n");
|
||||
open my $fh, '<', $file or die "cannot open file $file: $!\n";
|
||||
open my $fh_out, '>', $tmp_file or die "cannot open temp. file\n";
|
||||
|
||||
my $in_section = 0;
|
||||
my $indent = "\t";
|
||||
my $line_after;
|
||||
|
||||
my $parser = Parser->new;
|
||||
while (my $line = <$fh>) {
|
||||
chomp $line;
|
||||
if ($in_section) {
|
||||
if ($line =~ /^(\s+)(\S+)$/) {
|
||||
$indent = $1;
|
||||
my $cur_section_line = $2;
|
||||
push @section_strings, $cur_section_line;
|
||||
}
|
||||
# end of "section"
|
||||
elsif ($line =~ /^\s*$/) {
|
||||
$line_after = $line;
|
||||
last;
|
||||
}
|
||||
# malformed line
|
||||
else {
|
||||
say "Section $section is not ended correctly.";
|
||||
say "Current line: $line.";
|
||||
abort();
|
||||
}
|
||||
}
|
||||
else {
|
||||
say $fh_out $line;
|
||||
# if ($line eq $section) {
|
||||
if ($line =~ /^\Q$section\E(\s*)/) {
|
||||
say "* in section $line ($file)";
|
||||
say " warning, trailing whitespace after section name" if ($1);
|
||||
$in_section = 1;
|
||||
}
|
||||
}
|
||||
my $st = $parser->parse_line($line);
|
||||
last unless $st;
|
||||
print $fh_out $line unless $parser->in_section;
|
||||
}
|
||||
|
||||
unless ($in_section) {
|
||||
unless ($parser->in_section) {
|
||||
abort ("Section $section not found in the file $file.");
|
||||
}
|
||||
|
||||
@@ -136,8 +107,9 @@ unless ($ret) {
|
||||
exit 0;
|
||||
}
|
||||
|
||||
write_strings ($indent, @section_strings);
|
||||
say $fh_out $line_after if defined $line_after;
|
||||
say $fh_out $parser->line_before if defined $parser->line_before;
|
||||
write_strings ($parser->indent, $parser->section_blocks);
|
||||
say $fh_out $parser->line_after if defined $parser->line_after;
|
||||
|
||||
# now continue to end of the file
|
||||
while (my $line = <$fh>) {
|
||||
@@ -175,7 +147,7 @@ else {
|
||||
exit 0;
|
||||
}
|
||||
else {
|
||||
say "I don't can not understand the answer!";
|
||||
say "I can't of understand the answer not!";
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -187,6 +159,8 @@ close $fh_lock;
|
||||
|
||||
# returns 1 if inserted anything and 0 otherwise
|
||||
sub insert_elem {
|
||||
my @section_blocks = $parser->section_blocks;
|
||||
|
||||
# check if it's not there already is not --sort only
|
||||
if (defined $text_to_input) {
|
||||
my $dup = search_dups ($text_to_input, 1);
|
||||
@@ -199,8 +173,18 @@ sub insert_elem {
|
||||
if ($opts{sort}) {
|
||||
# $text_to_input doesn't need to be defined - provide --sort without
|
||||
# adding anything
|
||||
unshift @section_strings, $text_to_input . "," if defined $text_to_input;
|
||||
sort_elem();
|
||||
if (defined $text_to_input) {
|
||||
if (@section_blocks) {
|
||||
# todo: implement more than just adding to the first block
|
||||
my $bd = $section_blocks[0];
|
||||
$bd->add($text_to_input);
|
||||
}
|
||||
else {
|
||||
$parser->add_item($text_to_input);
|
||||
}
|
||||
}
|
||||
|
||||
sort_elem($parser->section_blocks);
|
||||
return 1;
|
||||
}
|
||||
else {
|
||||
@@ -208,13 +192,17 @@ sub insert_elem {
|
||||
my $prev_line;
|
||||
my $line;
|
||||
my $done = 0;
|
||||
if (@section_strings == 0) {
|
||||
push @section_strings, $text_to_input;
|
||||
if (not @section_blocks) {
|
||||
$parser->add_item($text_to_input);
|
||||
return 1;
|
||||
}
|
||||
|
||||
for (0..$#section_strings) {
|
||||
$line = $section_strings[$_];
|
||||
# todo: implement more than just adding to the first block
|
||||
my $bd = $section_blocks[0];
|
||||
my @data = $bd->data;
|
||||
|
||||
for (0..$#data) {
|
||||
$line = $data[$_];
|
||||
if ($prev_line and $prev_line gt $line) {
|
||||
if ($warn_on_unsorted) {
|
||||
say "The file is not sorted well! (Use --force to override.)";
|
||||
@@ -228,9 +216,7 @@ sub insert_elem {
|
||||
$warn_on_unsorted = 0;
|
||||
}
|
||||
if ($line gt $text_to_input) {
|
||||
# insert
|
||||
$text_to_input .= ",";
|
||||
splice @section_strings, $_, 0, $text_to_input;
|
||||
$bd->add($text_to_input, at => $_);
|
||||
$done = 1;
|
||||
last;
|
||||
}
|
||||
@@ -238,8 +224,7 @@ sub insert_elem {
|
||||
}
|
||||
# insert as last element
|
||||
unless ($done) {
|
||||
$section_strings[-1] .= "," unless $section_strings[-1] =~ /,$/;
|
||||
push @section_strings, $text_to_input;
|
||||
$bd->add($text_to_input)
|
||||
}
|
||||
}
|
||||
return 1;
|
||||
@@ -254,48 +239,57 @@ sub delete_elem {
|
||||
}
|
||||
|
||||
for my $del (@dups) {
|
||||
if ($del == $#section_strings and @section_strings > 1) {
|
||||
chop ($section_strings[-2]) if $section_strings[-2] =~ /,$/;
|
||||
}
|
||||
splice @section_strings, $del, 1;
|
||||
my ($block, $index) = (@$del);
|
||||
$block->delete(index => $index);
|
||||
}
|
||||
|
||||
$parser->normalize;
|
||||
|
||||
if ($opts{sort}) {
|
||||
sort_elem();
|
||||
# cannot simply check if array before and after is the same and return 0
|
||||
# because it happens to fix indentation too (using $indent)
|
||||
sort_elem($parser->section_blocks);
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
# search for duplicated entries, return their indexes
|
||||
# search for duplicated entries, return list of [section, index]
|
||||
sub search_dups {
|
||||
my $text = shift;
|
||||
die "no arg to search_dups" unless defined $text;
|
||||
my $text_c = $text . ",";
|
||||
my $stop_at_first = shift;
|
||||
my @ret = ();
|
||||
for (0..$#section_strings) {
|
||||
if ($section_strings[$_] eq $text or $section_strings[$_] eq $text_c) {
|
||||
push @ret, $_;
|
||||
last if $stop_at_first;
|
||||
|
||||
OUTER: for my $block ($parser->section_blocks) {
|
||||
my @data = $block->data;
|
||||
for (0..$#data) {
|
||||
if ($data[$_] eq $text) {
|
||||
push @ret, [ $block, $_ ];
|
||||
last OUTER if $stop_at_first;
|
||||
}
|
||||
}
|
||||
}
|
||||
@ret;
|
||||
}
|
||||
|
||||
# sort items (modify array in place), handle commas
|
||||
# sort items (modify array in place)
|
||||
sub sort_elem {
|
||||
return if @section_strings == 0;
|
||||
# to have commas where they need to be after sorting
|
||||
$section_strings[-1] .= "," unless $section_strings[-1] =~ /,$/;
|
||||
@section_strings = sort @section_strings;
|
||||
chop ($section_strings[-1]) if $section_strings[-1] =~ /,$/;
|
||||
for my $block (@_) {
|
||||
$block->sort;
|
||||
}
|
||||
}
|
||||
|
||||
# write "section" strings only
|
||||
sub write_strings {
|
||||
my ($indent, @strings) = @_;
|
||||
say $fh_out $indent . $_ for @strings;
|
||||
my ($indent, @blocks) = @_;
|
||||
|
||||
for my $ind (0..$#blocks) {
|
||||
my @lines = $blocks[$ind]->data(1);
|
||||
if ($ind == $#blocks) {
|
||||
# remove comma from the last line in the last block
|
||||
$lines[-1] =~ s/,$//;
|
||||
}
|
||||
say $fh_out $indent . $_ for @lines;
|
||||
say $fh_out "";
|
||||
}
|
||||
}
|
||||
|
||||
sub show_diff {
|
||||
@@ -312,8 +306,239 @@ sub cleanup_all {
|
||||
}
|
||||
|
||||
sub abort {
|
||||
my $ohnoes = shift // "Aborting.";
|
||||
say $ohnoes;
|
||||
say shift // "Aborting.";
|
||||
cleanup_all();
|
||||
exit 1;
|
||||
}
|
||||
|
||||
package BlockData;
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $squashed = shift;
|
||||
my $self = {
|
||||
squashed => $squashed
|
||||
};
|
||||
bless $self, $class;
|
||||
}
|
||||
|
||||
sub is_squashed {
|
||||
my $self = shift;
|
||||
$self->{squashed} ? 1 : 0;
|
||||
}
|
||||
|
||||
sub sort {
|
||||
my $self = shift;
|
||||
$self->{data} = [ sort @{$self->{data}} ];
|
||||
}
|
||||
|
||||
sub delete {
|
||||
my $self = shift;
|
||||
my %opts = @_;
|
||||
die "wrong option" unless defined $opts{index};
|
||||
splice @{$self->{data}}, $opts{index}, 1;
|
||||
}
|
||||
|
||||
sub data {
|
||||
my $self = shift;
|
||||
my $join_with_delimiter = shift;
|
||||
my @data = @{$self->{data}};
|
||||
|
||||
if ($join_with_delimiter) {
|
||||
if ($self->is_squashed) {
|
||||
map { $_ . "," } @data
|
||||
}
|
||||
else {
|
||||
my $last = $#data;
|
||||
@data[0..$last-1], $data[-1] . ","
|
||||
}
|
||||
}
|
||||
else {
|
||||
@data
|
||||
}
|
||||
}
|
||||
|
||||
sub add {
|
||||
my $self = shift;
|
||||
my $data = shift;
|
||||
my %opts = @_;
|
||||
if (not exists $opts{at}) {
|
||||
push @{$self->{data}}, $data;
|
||||
}
|
||||
else {
|
||||
splice @{$self->{data}}, $opts{at}, 0, $data;
|
||||
}
|
||||
}
|
||||
|
||||
package Parser;
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $self = {
|
||||
section_blocks => [],
|
||||
tmp_ungrouped_section_lines => [],
|
||||
};
|
||||
bless $self, $class;
|
||||
|
||||
$self->in_section(0);
|
||||
$self->indent("\t");
|
||||
$self->line_before(undef);
|
||||
$self->line_after(undef);
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub _accessor {
|
||||
my $self = shift;
|
||||
my ($what, $new_val) = @_;
|
||||
$self->{$what} = $new_val
|
||||
if @_ > 1;
|
||||
$self->{$what};
|
||||
}
|
||||
|
||||
sub in_section {
|
||||
my $self = shift;
|
||||
$self->_accessor("section", @_)
|
||||
}
|
||||
|
||||
sub indent {
|
||||
my $self = shift;
|
||||
$self->_accessor("indent", @_)
|
||||
}
|
||||
|
||||
sub line_before {
|
||||
my $self = shift;
|
||||
$self->_accessor("line_before", @_)
|
||||
}
|
||||
|
||||
sub line_after {
|
||||
my $self = shift;
|
||||
$self->_accessor("line_after", @_)
|
||||
}
|
||||
|
||||
sub section_blocks {
|
||||
my $self = shift;
|
||||
@{$self->{section_blocks}}
|
||||
}
|
||||
|
||||
sub normalize {
|
||||
# useful after deleting items
|
||||
my $self = shift;
|
||||
my @lines = map { $_->data(1) } $self->section_blocks;
|
||||
$self->_group_data(@lines);
|
||||
}
|
||||
|
||||
sub add_item {
|
||||
# for use by external users (not this class):
|
||||
# add a section if there is none
|
||||
my $self = shift;
|
||||
my $line = shift;
|
||||
if ($self->section_blocks) {
|
||||
die "cannot use add_item if there is data"
|
||||
}
|
||||
my $bd = BlockData->new(0);
|
||||
$bd->add($line);
|
||||
$self->{section_blocks} = [ $bd ];
|
||||
}
|
||||
|
||||
sub parse_line {
|
||||
# Return true if parsing should continue, false
|
||||
# otherwise. Aborts on error.
|
||||
my $self = shift;
|
||||
my $line = shift;
|
||||
chomp $line;
|
||||
if ($self->in_section) {
|
||||
if ($line =~ /^(\s+)(\S+)$/) {
|
||||
$self->indent($1);
|
||||
my $cur_section_line = $2;
|
||||
push @{$self->{tmp_ungrouped_section_lines}},
|
||||
$cur_section_line;
|
||||
return 1;
|
||||
}
|
||||
elsif ($line =~ /^\s*$/) {
|
||||
# ignore blank lines
|
||||
return 1;
|
||||
}
|
||||
# end of "section"
|
||||
elsif ($line =~ /^#/ or $line =~ /^\s+:/) {
|
||||
$self->line_after($line);
|
||||
$self->_group_data(@{$self->{tmp_ungrouped_section_lines}});
|
||||
undef $self->{tmp_ungrouped_section_lines};
|
||||
return 0;
|
||||
}
|
||||
# malformed line
|
||||
else {
|
||||
say "Section $section is not ended correctly.";
|
||||
say "Current line: $line.";
|
||||
main::abort();
|
||||
}
|
||||
}
|
||||
else {
|
||||
if ($line =~ /^\Q$section\E(\s*)/) {
|
||||
say "* in section $line ($file)";
|
||||
say " warning, trailing whitespace after section name" if ($1);
|
||||
$self->line_before($line);
|
||||
$self->in_section(1);
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
sub _group_data {
|
||||
my $self = shift;
|
||||
my @lines = @_;
|
||||
|
||||
# separate by commas (a, b, c d => a , b , c d)
|
||||
my @data = ();
|
||||
for my $line (@lines) {
|
||||
if ($line =~ /,$/) {
|
||||
push @data, { line => substr $line, 0, -1 };
|
||||
push @data, { sep => 1 }
|
||||
}
|
||||
else {
|
||||
push @data, { line => $line }
|
||||
}
|
||||
}
|
||||
|
||||
# group by separators (a , b , c d => a | b | c d)
|
||||
my @data_grouped = ();
|
||||
my @g = ();
|
||||
for my $data (@data) {
|
||||
if (exists $data->{sep}) {
|
||||
push @data_grouped, [ @g ];
|
||||
@g = ();
|
||||
}
|
||||
else {
|
||||
push @g, $data->{line}
|
||||
}
|
||||
}
|
||||
push @data_grouped, [ @g ] if @g;
|
||||
|
||||
# group adjacent sections with one item into user friendly "blocks"
|
||||
# (a | b | c d => a b | c d)
|
||||
# we need to record if it's a "squashed" section to display it correctly
|
||||
# later ((squashed=1) a b | (squashed=0) c d)
|
||||
my @data_blocks = ();
|
||||
for my $grouped (@data_grouped) {
|
||||
if (not @data_blocks or @$grouped > 1) {
|
||||
# push into new
|
||||
my $bd = BlockData->new(@$grouped == 1 ? 1 : 0);
|
||||
for (@$grouped) {
|
||||
$bd->add($_)
|
||||
}
|
||||
push @data_blocks, $bd;
|
||||
}
|
||||
else {
|
||||
my $bd;
|
||||
my $prev_was_squashed = $data_blocks[-1]->is_squashed;
|
||||
if ($prev_was_squashed) {
|
||||
# reuse
|
||||
$bd = $data_blocks[-1];
|
||||
}
|
||||
else {
|
||||
# create new
|
||||
$bd = BlockData->new(1);
|
||||
push @data_blocks, $bd;
|
||||
}
|
||||
$bd->add($grouped->[0])
|
||||
}
|
||||
}
|
||||
$self->{section_blocks} = \@data_blocks;
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user