diff --git a/Changelog b/Changelog new file mode 100644 index 0000000..5e6130f --- /dev/null +++ b/Changelog @@ -0,0 +1,2 @@ +0.01 + initial commit diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..a6c97e6 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,10 @@ +MANIFEST +Makefile.PL +Manager.pm +bin/dbmtree +samples/zip.yaml +samples/sqlite.yaml +README +Changelog +META.yml Module meta-data (added by MakeMaker) +META.json Module meta-data (added by MakeMaker) diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..2c8d9a5 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,35 @@ +# +# Makefile.PL - build file for DBM::Tree::Manager +# +# Copyright (c) 2007-2014 T. v.Dein . +# All Rights Reserved. Std. disclaimer applies. +# Artistic License, same as perl itself. Have fun. +# + +use ExtUtils::MakeMaker; + +WriteMakefile( + NAME => 'DBM::Deep::Manager', + VERSION_FROM => 'Manager.pm', + 'EXE_FILES' => [ 'bin/dbmdeep' ], + ABSTRACT => 'Maintain DBM::Deep databases interactively', + LICENSE => 'perl', + AUTHOR => [ + 'Thomas v.Dein ', + ], + clean => { FILES => '*~ */*~' }, + PREREQ_PM => { + 'DBM::Deep' => 2.0, + 'YAML' => 0, + 'Data::Interactive::Inspect' => 0, + }, + dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, + test => { TESTS => 't/*.t' }, + 'META_MERGE' => { + resources => { + repository => 'https://github.com/TLINDEN/dbmdeep', + }, + }, + +); + diff --git a/Manager.pm b/Manager.pm new file mode 100644 index 0000000..d0b363c --- /dev/null +++ b/Manager.pm @@ -0,0 +1,148 @@ +package DBM::Deep::Manager; +$DBM::Deep::Manager::VERSION = 0.01; + + +use DBM::Deep 2.0; +use Data::Interactive::Inspect; +use YAML; + + + +use vars qw(@ISA @EXPORT @EXPORT_OK $db); +require Exporter; +@ISA = qw(Exporter); +@EXPORT = qw(getshell opendb _export _import); +@EXPORT_OK = qw(); + +sub getshell { + my ($db, $dbfile) = @_; + my $shell = Data::Interactive::Inspect->new( + begin => sub { + my ($self) = @_; + my $maindb = tied(%{$self->{struct}}); + if (!$self->{session}) { + eval { $maindb->begin_work; }; + if ($@) { + print STDERR "transactions not supported by $dbfile," . + " re-create with 'num_txns' > 1\n"; + } + else { + $self->{session} = 1; + print "ok\n"; + } + } + }, + commit => sub { + my ($self) = @_; + my $maindb = tied(%{$self->{struct}}); + if ($self->{session}) { + $maindb->commit(); + $self->{session} = 0; + print "ok\n"; + } + }, + rollback => sub { + my ($self) = @_; + my $maindb = tied(%{$self->{struct}}); + if ($self->{session}) { + $maindb->rollback(); + $self->{session} = 0; + print "ok\n"; + } + }, + name => $dbfile, + struct => $db, + export => sub { + my ($db) = @_; + return tied(%{$db})->export(); + } + ); + return $shell; +} + +sub opendb { + my ($dbfile, %dbparams) = @_; + my $db; + if (tie my %db, 'DBM::Deep', %dbparams) { + $db = \%db; + } + else { + die "Could not open dbfile $dbfile: $!\n"; + } + return $db; +} + +sub _export { + my ($file, $dbfile, %dbparams) = @_; + my $db = &opendb($dbfile, %dbparams); + my $fd; + if ($file eq '-') { + $fd = *STDOUT; + } + else { + open $fd, ">$file" or die "Could not open export file $file for writing: $!\n"; + } + print $fd YAML::Dump(tied(%{$db})->export()); + close $fd; +} + +sub _import { + my ($file, $dbfile, %dbparams) = @_; + my $db = &opendb($dbfile, %dbparams); + my $fd; + if ($file eq '-') { + $fd = *STDIN; + } + else { + open $fd, "<$file" or die "Could not open import file $file for reading: $!\n"; + } + my $yaml = join '', <$fd>; + my $perl = YAML::Load($yaml); + tied(%{$db})->import($perl); + close $fd; +} + + +1; + +=head1 NAME + +DBM::Deep::Manager - A container for functions for the dbmdeep program + +=head1 SYNOPSIS + +If you want to know about the L program, see the L file itself. +No user-serviceable parts inside. ack is all that should use this. + +=head1 AUTHOR + +T.v.Dein + +=head1 BUGS + +Report bugs to +http://rt.cpan.org/NoAuth/ReportBug.html?Queue=DBM::Deep::Manager + +=head1 SEE ALSO + +L + +L + +L + +=head1 COPYRIGHT + +Copyright (c) 2015 by T.v.Dein . +All rights reserved. + +=head1 LICENSE + +This program is free software; you can redistribute it +and/or modify it under the same terms as Perl itself. + +=head1 VERSION + +This is the manual page for B Version 0.01. + +=cut diff --git a/README b/README new file mode 100644 index 0000000..23e6297 --- /dev/null +++ b/README @@ -0,0 +1,65 @@ +NAME + dbmdeep - manage DBM::Deep databases via command line + +SYNOPSIS + Usage: dbmdeep [-ceiVhv] [] + Manage a DBM::Deep database. Options: + + --config= | -c yaml config containing connect params + --export= | -e export db to + --import= | -i import db from + --verbose | -V enable debug output + --help | -h this help message + --version | -v print program version + + If - is specified as , STDIN or STDOUT is used respectively. + Interactive commands can be piped into dbmdeep as well, e.g.: + echo "drop users" | dbmdeep my.db. + +DESCRIPTION + dbmdeep is a command line utility which can be used to maintain + DBM::Deep databases. It is possible to view, modify or delete contents + of the database and you can export to a YAML file or import from one. + + The utility presents an interactive prompt where you enter commands to + maintain the database, see section INTERACTIVE COMMANDS for more + details. Commands can also be piped into the tool via STDIN. Example: + + dbmdeep my.db + my.db> show + + is the same as: + + echo "show" | dbmdeep my.db + +INSTALLATION + + to install, type: + perl Makefile.PL + make + make test + make install + + to read the complete documentation, type: + perldoc Data::Interactive::Inspect + +AUTHOR + T.v.Dein + +BUGS + Report bugs to + http://rt.cpan.org/NoAuth/ReportBug.html?Queue=DBM::Deep::Manager + +SEE ALSO + DBM::Deep + +COPYRIGHT + Copyright (c) 2015 by T.v.Dein . All rights reserved. + +LICENSE + This program is free software; you can redistribute it and/or modify it + under the same terms as Perl itself. + +VERSION + This is the manual page for dbmdeep Version 0.01. + diff --git a/bin/dbmdeep b/bin/dbmdeep new file mode 100644 index 0000000..003b472 --- /dev/null +++ b/bin/dbmdeep @@ -0,0 +1,448 @@ +#!/usr/bin/perl -w +# +# Copyright (c) 2015 T.v.Dein . +# All Rights Reserved. Std. disclaimer applies. +# Artistic License, same as perl itself. Have fun. +# + + +use Getopt::Long; +use DBM::Deep::Manager; +use strict; +no strict 'refs'; + +our ($dbfile, $debug, $version, $help, $export, $import, $config); +our (%dbparams); + +Getopt::Long::Configure( qw(no_ignore_case)); +if (! GetOptions ( + "export|e=s" => \$export, + "import|i=s" => \$import, + "config|c=s" => \$config, + "version|v" => \$version, + "help|h" => \$help, + "verbose|V" => \$debug + ) ) { + &usage; +} + +if ($help){ + &usage; +} + +if ($version) { + print STDERR "dmbdeep version $DBM::Deep::Manager::VERSION\n"; + exit; +} + +$dbfile = shift; + +if ($config) { + if (open Y, "<$config") { + my $yaml = join '', ; + close Y; + my $parsed = YAML::Load($yaml); + %dbparams = %{$parsed}; + if (exists $dbparams{perl}) { + # there's perl code in the config, run it + my $perl = delete $dbparams{perl}; + my %params; # we expect $perl to define this + + eval $perl; + if ($@) { + print "Failed to evaluate perl code in $config: $@\n"; + } + + %dbparams = (%dbparams, %params); # merge them in + if (exists $dbparams{file}) { + $dbfile = $dbparams{file}; # no commandline $dbfile required + } + elsif ($dbfile) { + $dbparams{file} = $dbfile; + } + elsif (!exists $dbparams{dbi}) { + print STDERR "No 'file' or 'dbi' parameter specified\n"; + exit 1; + } + } + } + else { + die "Could not open config $config: $!\n"; + } +} +else { + # work with dbfile, assume defaults + if (!$dbfile) { + &usage; + } + %dbparams = ( + file => $dbfile, + locking => 1, + autoflush => 1, + num_txns => 10, + ); +} + +if ($export) { + _export($export, $dbfile, %dbparams); + exit; +} +if ($import) { + _import($import, $dbfile, %dbparams); + exit; +} + +# main +my $db = opendb($dbfile, %dbparams); +my $shell = getshell($db, $dbfile); +$shell->inspect(); +exit; + + + + +sub usage { + print STDERR qq(Usage: dbmdeep [-ceiVhv] [] +Manage a DBM::Deep database. Options: + + --config= | -c yaml config containing connect params + --export= | -e export db to + --import= | -i import db from + --verbose | -V enable debug output + --help | -h this help message + --version | -v print program version + +If - is specified as , STDIN or STDOUT is used respectively. +Interactive commands can be piped into dbmdeep as well, e.g.: +echo "drop users" | dbmdeep my.db. + +dbmdeep version $DBM::Deep::Manager::VERSION. +); + + exit 1; +} + + + + + + + +1; + +=head1 NAME + +dbmdeep - manage DBM::Deep databases via command line + +=head1 SYNOPSIS + + Usage: dbmdeep [-ceiVhv] [] + Manage a DBM::Deep database. Options: + + --config= | -c yaml config containing connect params + --export= | -e export db to + --import= | -i import db from + --verbose | -V enable debug output + --help | -h this help message + --version | -v print program version + + If - is specified as , STDIN or STDOUT is used respectively. + Interactive commands can be piped into dbmdeep as well, e.g.: + echo "drop users" | dbmdeep my.db. + + +=head1 DESCRIPTION + +B is a command line utility which can be used to maintain L +databases. It is possible to view, modify or delete contents of the database and +you can export to a L file or import from one. + +The utility presents an interactive prompt where you enter commands to maintain +the database, see section B for more details. Commands can +also be piped into the tool via STDIN. Example: + + dbmdeep my.db + my.db> show + +is the same as: + + echo "show" | dbmdeep my.db + +=head1 OPTIONS + +=over + +=item B<--config> + +Specify a config file in L format. The config may contain special customizations +for the L instanziation. See section B for more details. + +=item B<--export> + +Export the contents of the database to a L file. If the specified file name +is B<->, STDOUT will be used to print the export. + +=item B<--import> + +Import data from a L file. If the database already exists, the contents of +the import file will be merged with the existing contents, otherwise the database +will be created. + +=item B<--verbose> + +Enable debugging output. + +=item B<--help> + +Print a usage message to STDERR. + +=item B<--version> + +Print the software version to STDERR. + +=back + +=head1 CONFIG + +A config file is optional. If no config file is specified, B makes a couple +of assumptions about the database: it opens it with the L +backend with transactions enabled. + +Since L allows for a range of options about the storage backend, the B +utility supports complete customization using the config file (parameter B<--config>). + +Here are couple of examples: + + --- + perl: | + use Compress::Zlib; + %params = ( + filter_store_key => \&my_compress, + filter_store_value => \&my_compress, + filter_fetch_key => \&my_decompress, + filter_fetch_value => \&my_decompress, + ); + sub my_compress { + my $s = shift; + utf8::encode($s); + return Compress::Zlib::memGzip( $s ) ; + } + sub my_decompress { + my $s = Compress::Zlib::memGunzip( shift ) ; + utf8::decode($s); + return $s; + } + +This config implements the sample in L. +It uses the standard File backend but compresses everything using L. Note +that this config only contains one entry: B, with a multiline value which contains +perl code. This perl code will be evaluated by B at runtime. + +Please note, that the hash B<%params> is predefined by B, so it must exist and +must not be local (e.g. don't use: 'my %params'!). The hash may contain anything allowed +by L. + +Also note, that this config doesn't specify a database, so the file name of the database +must be specified on the command line, eg: + + dbmdeep -c zip.yaml my.db + +Another example: + + --- + dbi: + dsn: dbi:SQLite:dbname=sb.sqlite + username: + password: + connect_args: + +Here we use the L backend with a sqlite database. You don't need +to speficy a database file name on the command line in such a case, eg: + + dbmdeep -c sqlite.yaml + +Other supported config parameters are: B which will be used by the interactive +B command and B which will be used by interactive commands which display +large amounts of data. + +=head1 INTERACTIVE COMMANDS + +=head2 DISPLAY COMMANDS + +=over + +=item B + +Lists the keys of the current level of the database hash. + +Shortcut: B. + +=item B + +Does nearly the same as B but also shows the content of the +keys. If a key points to a structure (like a hash or an array), B +whill not display anything of it, but instead indicate, that there'e +more behind that key. + +Shortcut: B. + +=item B + +Dumps out everything of the current level of the database hash. + +Shortcut: B. + +=item B key | /regex> + +Displays the value of B. If you specify a regex, the values of +all matching keys will be shown. + +=back + +=head2 NAVIGATION COMMANDS + +=over + +=item B key + +You can use this command to enter a sub hash of the current hash. +It works like browsing a directory structure. You can only enter +keys which point to sub hashes. + +Shortcuts: B + +If the key you want to enter doesn't collide with a command, then +you can also just directly enter the key without 'enter' or 'cd' in +front of it, eg: + + my.db> list + subhash + my.db> subhash + my.db subhash> dump + my.db subhash> .. + my.db>^D + +If you specify B<..> as parameter (or as its own command like in the +example below), you go one level up and leave the current sub hash. + +=back + +=head2 EDIT COMMANDS + +=over + +=item B key value + +Use the B command to add a new key or to modify the value +of a key. B may be a valid perl structure, which you can +use to create sub hashes or arrays. Example: + + my.db> set users [ { name => 'max'}, { name => 'joe' } ] + ok + mydb> get users + users => + { + 'name' => 'max' + }, + { + 'name' => 'joe' + } + +B command overwrites existing values +without asking>. + +=item B key + +You can edit a whole structure pointed at by B with the +B command. It opens an editor with the structure converted +to L. Modify whatever you wish, save, and the structure will +be saved to the database. + +=item B key value + +This command can be used to append a value to an array. As with the +B command, B can be any valid perl structure. + +=item B key + +Delete a key. + +Again, note that all commands are executed without further asking +or warning! + +=item B key + +Remove the last element of the array pointed at by B. + +=item B key + +Remove the first element of the array pointed at by B. + +=back + +=head2 TRANSACTION COMMANDS + +See L. + +=over + +=item B + +Start a transaction. + +=item B + +Save all changes made since the transaction began to the database. + +=item B + +Discard all changes of the transaction. + +=back + +=head2 MISC COMMANDS + +=over + +=item B + +Display a short command help. + +Shortcuts: B or B. + +=item B + +Quit B + +Shortcuts: B. + +=back + +=head1 AUTHOR + +T.v.Dein + +=head1 BUGS + +Report bugs to +http://rt.cpan.org/NoAuth/ReportBug.html?Queue=DBM::Deep::Manager + +=head1 SEE ALSO + +L + +=head1 COPYRIGHT + +Copyright (c) 2015 by T.v.Dein . +All rights reserved. + +=head1 LICENSE + +This program is free software; you can redistribute it +and/or modify it under the same terms as Perl itself. + +=head1 VERSION + +This is the manual page for B Version 0.01. + +=cut diff --git a/samples/sqlite.yaml b/samples/sqlite.yaml new file mode 100644 index 0000000..648864c --- /dev/null +++ b/samples/sqlite.yaml @@ -0,0 +1,7 @@ +--- +dbi: + dsn: dbi:SQLite:dbname=sb.sqlite + username: + password: + connect_args: + diff --git a/samples/zip.yaml b/samples/zip.yaml new file mode 100644 index 0000000..2d18b64 --- /dev/null +++ b/samples/zip.yaml @@ -0,0 +1,20 @@ +--- +perl: | + use Compress::Zlib; + %params = ( + filter_store_key => \&my_compress, + filter_store_value => \&my_compress, + filter_fetch_key => \&my_decompress, + filter_fetch_value => \&my_decompress, + ); + sub my_compress { + my $s = shift; + utf8::encode($s); + return Compress::Zlib::memGzip( $s ) ; + } + sub my_decompress { + my $s = Compress::Zlib::memGunzip( shift ) ; + utf8::decode($s); + return $s; + } + diff --git a/t/blah.db b/t/blah.db new file mode 100644 index 0000000..cba1e3b Binary files /dev/null and b/t/blah.db differ