From 22b3387cb6ca719aa2b8fb9df4f2f06ebc5969ec Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?S=C5=82awomir=20Nizio?= <slawomir.nizio@sabayon.org>
Date: Wed, 12 Oct 2011 19:59:55 +0200
Subject: [PATCH] [molecules] add a script to update molecule/particle files

This is a silly script to modify .common (molecules) and .particle
files.
It can be used to modify (even automatic) another files with similar format too.
For .common files it uses "packages_to_add:" section, and for .particle
"packages:", but any can be used using --section.
Commiting it to this git repository because it could be most useful
here.

When adding an item it aborts if encountered file fragment is not sorted
(can be overridden with --force).
It can sort entries in a "section" too (--sort).
It can delete an item instead of adding (--delete).
Unless --noask is specified, displays diff and asks for confirmation.

usage examples:
	./modify.pl kde.common dev-util/geany
	./modify.pl --sort kde.common dev-util/geany
	./modify.pl --sort kde.common
	./modify.pl --delete kde.common x11-terms/xterm

I don't know if it'll be used. I've made it for fun.
Feel free to (re)move
it to another directory, like scripts/ (I think it fits
better here).
---
 modify.pl | 301 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 301 insertions(+)
 create mode 100755 modify.pl

diff --git a/modify.pl b/modify.pl
new file mode 100755
index 0000000..ee8a4dc
--- /dev/null
+++ b/modify.pl
@@ -0,0 +1,301 @@
+#!/usr/bin/env perl
+use warnings;
+use strict;
+use 5.010;
+use Fcntl ':flock';
+use Getopt::Long;
+
+# A simple script to insert data to particle/molecule file.
+# Sławomir Nizio <slawomir.nizio<at>sabayon.org>
+
+my $tmp_file = "/tmp/add-data.temp";
+my $lock_file = "/tmp/add-data.lock";
+
+my %opts = (
+	force_on_unsorted => 0,
+	sort => 0,
+	noask => 0,
+	help => 0,
+	delete => 0,
+	section => undef
+);
+
+# common sections
+my %sections = (
+	common   => 'packages_to_add:',
+	particle => 'packages:'
+);
+
+my $text_to_input;
+my $file;
+my $section;
+
+my $warn_on_unsorted = 1; # true; warn only once
+my @section_strings;
+
+##### options ######
+exit 1 unless
+	GetOptions (
+		help => \$opts{help}, sort => \$opts{sort},
+		force => \$opts{force_on_unsorted}, noask => \$opts{noask},
+		'section=s' => \$opts{section}, delete => \$opts{delete}
+);
+if ($opts{help}) {
+	say "usage examples:\n\t$0 kde.common dev-util/geany";
+	say "\t$0 --sort kde.common dev-util/geany";
+	say "\t$0 --sort kde.common";
+	say "\t$0 --delete kde.common x11-terms/xterm";
+	say "--sort - sort entries";
+	say "--force - don't abort if entries aren't sorted (default for --delete)";
+	say "--noask - don't ask for confirmation";
+	say "--delete - delete instead of adding";
+	say "--section - provide own \"section\" to update, for example: ",
+		'"packages_to_remove:" (note the colon)';
+	exit 0;
+}
+$file = shift;
+$text_to_input = shift;
+if (not defined $file or $file !~ /\S/ or
+	  (not $opts{sort}) and (not defined $text_to_input or $text_to_input !~ /\S/)) {
+	die "no arg(s)... try --help\n";
+}
+if ($opts{delete} and (not defined $text_to_input or $text_to_input !~ /\S/)) {
+	die "keyword is required when --delete used even with --sort\n";
+}
+if (defined $opts{section}) {
+	$section = $opts{section}
+} else {
+	my $ext;
+	my $tmp = rindex ($file, ".");
+	$ext = substr ($file, $tmp+1);
+	if ($sections{$ext}) {
+		$section = $sections{$ext}
+	}
+	else {
+		die "unknown extension, specify --section (and see --help)\n";
+	}
+}
+####################
+
+open my $fh_lock, '>', $lock_file or die "cannot open lock file\n";
+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;
+
+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 (index($line, $section) == 0) {
+		if ($line eq $section) {
+			say "*   in section $line ($file)";
+			$in_section = 1;
+		}
+	}
+}
+
+unless ($in_section) {
+	abort ("Section $section not found in the file $file.");
+}
+
+my $ret = $opts{delete} ? delete_elem() : insert_elem();
+
+unless ($ret) {
+	# no change made
+	close $fh;
+	close $fh_out;
+	close $fh_lock;
+	exit 0;
+}
+
+write_strings ($indent, @section_strings);
+say $fh_out $line_after if defined $line_after;
+
+# now continue to end of the file
+while (my $line = <$fh>) {
+	print $fh_out $line;
+}
+
+if ($opts{noask}) {
+	unless (rename $tmp_file, $file) {
+		warn "moving file failed: $!\n";
+		exit 1;
+	}
+	say "Wrote to $file.";
+	exit 0;
+}
+else {
+	show_diff($file, $tmp_file);
+	say "OK to proceed? [y/n]";
+	while (my $inp = <STDIN>) {
+		chomp $inp;
+		given (lc($inp)) {
+			when ('y') {
+				unless (rename $tmp_file, $file) {
+					warn "moving file failed: $!\n";
+					exit 1;
+				}
+				say "Wrote to $file.";
+				exit 0;
+			}
+			when ('n') {
+				say "Okay, not saving changes.";
+				unlink $tmp_file or warn "removing temp. file failed: $!\n";
+				unlink $lock_file or warn "removing lock file failed: $!\n";
+				exit 0;
+			}
+			default {
+				say "I don't can not understand the answer!";
+			}
+		}
+	}
+}
+
+# Close them here due to the lock.
+close $fh;
+close $fh_out;
+close $fh_lock;
+
+# returns 1 if inserted anything and 0 otherwise
+sub insert_elem {
+	# check if it's not there already is not --sort only
+	if (defined $text_to_input) {
+		my $dup = search_dups ($text_to_input, 1);
+		if ($dup) {
+			say "Entry $text_to_input is already in the file.";
+			return 0;
+		}
+	}
+
+	if ($opts{sort}) {
+		# $text_to_input doesn't need to be defined - provide --sort without
+		# adding anything
+		push @section_strings, $text_to_input if defined $text_to_input;
+		@section_strings = sort @section_strings;
+		# cannot simply check if array before and after is the same and return 0
+		# because it happens to fix indentation too (using $indent)
+		return 1;
+	}
+	else {
+		# No --sort, $text_to_sort is always defined.
+		my $prev_line;
+		my $line;
+		my $done = 0;
+		if (@section_strings == 0) {
+			push @section_strings, $text_to_input;
+			return 1;
+		}
+
+		for (0..$#section_strings) {
+			$line = $section_strings[$_];
+			if ($prev_line and $prev_line gt $line) {
+				if ($warn_on_unsorted) {
+					say "The file is not sorted well! (Use --force to override.)";
+					say "previous:\t$prev_line";
+					say "current:\t$line";
+				}
+				abort() unless ($opts{force_on_unsorted});
+				if ($warn_on_unsorted) {
+					say "Ignoring such warnings from now.";
+				}
+				$warn_on_unsorted = 0;
+			}
+			if ($line gt $text_to_input) {
+				# insert
+				$text_to_input .= ",";
+				splice @section_strings, $_, 0, $text_to_input;
+				$done = 1;
+				last;
+			}
+			$prev_line = $line;
+		}
+		# insert as last element
+		unless ($done) {
+			$section_strings[-1] .= ",";
+			push @section_strings, $text_to_input;
+		}
+	}
+	return 1;
+}
+
+# returns 1 if deleted anything and 0 otherwise
+sub delete_elem {
+	my @dups = search_dups ($text_to_input);
+	unless (@dups) {
+		say "Entry $text_to_input not present, nothing to delete.";
+		return 0;
+	}
+
+	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;
+	}
+	if ($opts{sort}) {
+		@section_strings = sort @section_strings;
+		# cannot simply check if array before and after is the same and return 0
+		# because it happens to fix indentation too (using $indent)
+	}
+	return 1;
+}
+
+# search for duplicated entries, return their indexes
+sub search_dups {
+	my $text = shift or die "no arg to search_dups";
+	my $text_c = $text . ",";
+	my $stop_at_first = shift;
+	my @ret = ();
+	for (0..$#section_strings) {
+		if ($section_strings[$_] ~~ [ $text, $text_c ]) {
+			push @ret, $_;
+			last if $stop_at_first;
+		}
+	}
+	@ret;
+}
+
+# write "section" strings only
+sub write_strings {
+	my ($indent, @strings) = @_;
+	say $fh_out $indent . $_ for @strings;
+}
+
+sub show_diff {
+	my ($file1, $file2) = @_;
+	system ("diff", "-u", $file1, $file2);
+}
+
+sub abort {
+	my $ohnoes = shift // "Aborting.";
+	say $ohnoes;
+	close $fh;
+	close $fh_out;
+	unlink $tmp_file or warn "removing temp. file failed: $!\n";
+	unlink $lock_file or warn "removing lock file failed: $!\n";
+	close $fh_lock;
+	exit 1;
+}
+