#!/usr/bin/perl -w # -*- Mode: perl -*- #template by ~tconnors/bin/newplscript #Sat Jun 1 19:45:43 AEST 2024 # $Revision: 1.4 $ $Date: 2024/06/30 07:34:49 $ # $Id: keyval.pl,v 1.4 2024/06/30 07:34:49 tconnors Exp $ # $Header: /home/tconnors/cvsroot/bin/keyval.pl,v 1.4 2024/06/30 07:34:49 tconnors Exp $ # $RCSfile: keyval.pl,v $ # This program keeps a hash of key=values stored on disk, that can be # imported/exported from a flat file #use Modern::Perl 2013; use 5.012; # implies "use strict;" use warnings; use autodie; use Carp::Assert; #use mycommon; use Getopt::Long; Getopt::Long::Configure ("bundling"); use Pod::Usage; #use Term::ReadLine; use Storable qw(lock_store lock_nstore lock_retrieve); my $verbose=0; my $debug=0; my $delete=0; my $import=0; my $export=0; my $colour=0; my $VERSION='$Revision: 1.4 $'; $VERSION=~s/\$[R]evision: ([^ ].*[^ ]) *\$/$1/; my $DATE='$Date: 2024/06/30 07:34:49 $';#'# - comment for emacs' fontifying $DATE=~s/\$[D]ate: ([^ ].*[^ ]) *\$/$1/; my $FILE='$RCSfile: keyval.pl,v $'; $FILE=~s/\$[R]CSfile: ([^ ].*[^ ]),v *\$/$1/; my $WHAT="Some Hack"; my (@SAVEARGV)=@ARGV; sub isNum($) { ($_[0] =~ /^[+-]?\d+$/); } my $getOptVerbose = sub { my ($junk, $v)=(@_); $v=$verbose+1 if ($v eq ""); die "verbosity level is not a number: $v\n" if (!isNum $v); $verbose=$v; }; my $getOptDebug = sub { my ($junk, $d)=(@_); $d=$debug+1 if ($d eq ""); die "debug level is not a number: $d\n" if (!isNum $d); $debug=$d; }; my $getOptColour = sub { my ($junk, $c)=(@_); $c=1 if ($c eq ""); #could also be "tty" $colour=$c; }; my ($opt_help, $opt_man, $opt_version); my $result = GetOptions (#'colour:s' => $getOptColour, 'debug:s' => $getOptDebug, 'verbose:s' => $getOptVerbose, 'c' => sub { $colour=1 }, 'd|delete' => sub { $delete=1 }, 'i|import' => sub { $import=1 }, 'e|export' => sub { $export=1 }, 'v' => sub { $verbose++ }, 'nocolour' => sub { $colour = 0 }, 'help|?|h' => \$opt_help, 'man' => \$opt_man, 'version|V' => \$opt_version, ) || pod2usage(2); pod2usage(1) if ($opt_help); pod2usage(-verbose => 2) if ($opt_man); #pod2usage(-verbose => 0) if ($opt_version); if ($opt_version) { print "$FILE ($WHAT) $VERSION ($DATE)\n"; print "Copyright ... (....-....)\n"; print "Author(s): Tim Connors " ) . "\n"; #print "debug=$debug\n"; #print "verbose=$verbose\n"; my ($dieatend); sub signalDie($) { $dieatend=!$dieatend; if ($dieatend) { print "ACK. Will die sometime...\n"; } else { print "NAK. Will not die now...\n"; } #perhaps unset signal handler here, and kill oneself with same signal, after removing files? } ############### $SIG{HUP}=\&signalDie; $SIG{INT}=\&signalDie; my (%hash, $hashref); if (!eval {$hashref=lock_retrieve($filename);}) { warn("Couldn't open $filename for read, but will write to it"); $hashref=\%hash; } my $write_to_file=0; if ($import) { my $INFILE; open($INFILE, $keyvalorfile) or die "can't open $keyvalorfile to populate $filename"; print STDERR "Importing $keyvalorfile\n"; while(my $line = <$INFILE>) { chomp $line; my ($key, $val) = split(" ", $line, 2); # print "key=$key, val=$val\n"; $hashref->{$key}=$val; } close $INFILE; $write_to_file=1; } else { if ($delete) { my $key = $keyvalorfile; if (!delete $hashref->{$key}) { print STDERR "$key was not found\n"; exit 1; } $write_to_file=1; } else { my ($key, $val); if ($export) { my $outfile = $keyvalorfile; my $OUTFILE; open($OUTFILE, ">$outfile") or die "can't open $outfile for write"; foreach $key (keys %$hashref) { print $OUTFILE "$key $hashref->{$key}\n"; } close $OUTFILE; } elsif ($keyvalorfile =~ /=/) { ($key, $val) = split('=', $keyvalorfile, 2); $hashref->{$key}=$val; $write_to_file=1; } else { $key = $keyvalorfile; if (defined $hashref->{$key}) { print "$key " if $verbose; print "$hashref->{$key}\n"; } else { exit 1; } } } } if ($write_to_file) { print STDERR "Writing to $filename\n" if $debug; lock_nstore($hashref, $filename); } # $Log: keyval.pl,v $ # Revision 1.4 2024/06/30 07:34:49 tconnors # improve the help slightly # # Revision 1.3 2024/06/06 09:18:12 tconnors # add --export and also exit 1 if --delete on an item that already doesnt exist # # Revision 1.2 2024/06/06 09:03:27 tconnors # add --delete and --import # # Revision 1.1 2024/06/01 10:45:55 tconnors # added a simple keyval file storer and searcher # # Revision 1.26 2009/11/20 12:43:13 twc # comment # # Revision 1.25 2008/05/07 06:53:41 tconnors # rearrange defaults a bit # # Revision 1.24 2007/04/30 05:33:51 tconnors # parseinput not used with getopt # # Revision 1.23 2007/01/17 08:38:36 tconnors # fix RCSfile, update uses # # Revision 1.22 2007/01/11 10:59:21 tconnors # change to Getopts::Long, and add perldoc stuff # __END__ =head1 NAME code.p - Some Code =head1 SYNOPSIS code.p [options] Options: [--help|-?|-h] [--man] [--version|-V] [--colour |--nocolour|-c] [--debug |-d] [--verbose |-v] =head1 OPTIONS =over 8 =item B<--help|-h|-?> Print a brief help message and exits. =item B<--man> Prints the manual page and exits. =item B<--version|-V> Prints version information and exits. =item B<--colour {yes|auto|no}|--nocolour|-c> STDIO uses colour always, only when STDOUT is a terminal, or never =item B<--debug {level}|-d> Sets or increments the debug level. Current level is 1 =item B<--verbose {level}|-d> Sets or increments the verbosity level. Current level is 1 =back =head1 DESCRIPTION B does something useful. =cut