scip/note
1
0
Fork 0
mirror of https://codeberg.org/scip/note.git synced 2025-12-17 04:31:02 +01:00
Code Issues Packages Projects Releases Wiki Activity

fixed installer, on newer perls NOTEDB/* is being ignored

Browse Source
This commit is contained in:
Thomas von Dein
2018-11-02 16:11:11 +01:00
parent 2e4e268f58
commit ad6cb95614
9 changed files with 0 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

306
lib/NOTEDB.pm Normal file
View File

@@ -0,0 +1,306 @@
#
# this is a generic module, used by note database
# backend modules.
#
# Copyright (c) 2000-2017 T.v.Dein <tlinden@cpan.org>
package NOTEDB;
use Exporter ();
use vars qw(@ISA @EXPORT $crypt_supported);
$NOTEDB::VERSION = "1.45";
BEGIN {
# make sure, it works, otherwise encryption
# is not supported on this system!
eval { require Crypt::CBC; };
if($@) {
$NOTEDB::crypt_supported = 0;
}
else {
$NOTEDB::crypt_supported = 1;
}
}
sub no_crypt {
$NOTEDB::crypt_supported = 0;
}
sub use_crypt {
my($this,$key,$method) = @_;
my($cipher);
if($NOTEDB::crypt_supported == 1) {
eval {
$cipher = new Crypt::CBC($key, $method);
};
if($@) {
print "warning: Crypt::$method not supported by system!\n";
$NOTEDB::crypt_supported = 0;
}
else {
$this->{cipher} = $cipher;
}
}
else{
print "warning: Crypt::CBC not supported by system!\n";
}
}
sub use_cache {
#
# this sub turns on cache support
#
my $this = shift;
$this->{use_cache} = 1;
$this->{changed} = 1;
}
sub cache {
#
# store the whole db as hash
# if use_cache is turned on
#
my $this = shift;
if ($this->{use_cache}) {
my %res = @_;
%{$this->{cache}} = %res;
}
}
sub unchanged {
#
# return true if $this->{changed} is true, this will
# be set to true by writing subs using $this->changed().
#
my $this = shift;
return 0 if(!$this->{use_cache});
if ($this->{changed}) {
$this->{changed} = 0;
return 0;
}
else {
print "%\n";
return 1;
}
}
sub changed {
#
# turn on $this->{changed}
# this will be used by update or create subs.
#
my $this = shift;
$this->{changed} = 1;
return 1;
}
sub generate_search {
#
# get user input and create perlcode ready for eval
# sample input:
# "ann.a OR eg???on AND u*do$"
# resulting output:
# "$match = 1 if(/ann\.a/i or /eg...on/i and /u.*do\$/i );
#
my($this, $string) = @_;
my $case = "i";
if ($string =~ /^\/.+?\/$/) {
return $string;
}
elsif (!$string) {
return "/^/";
}
# we will get a / in front of the first word too!
$string = " " . $string . " ";
# check for apostrophs
$string =~ s/(?<=\s)(\(??)("[^"]+"|\S+)(\)??)(?=\s)/$1 . $this->check_exact($2) . $3/ge;
# remove odd spaces infront of and after <20>and<6E> and <20>or<6F>
$string =~ s/\s\s*(AND|OR)\s\s*/ $1 /g;
# remove odd spaces infront of <20>(<28> and after <20>)<29>
$string =~ s/(\s*\()/\(/g;
$string =~ s/(\)\s*)/\)/g;
# remove first and last space so it will not masked!
$string =~ s/^\s//;
$string =~ s/\s$//;
# mask spaces if not infront of or after <20>and<6E> and <20>or<6F>
$string =~ s/(?<!AND)(?<!OR)(\s+?)(?!AND|OR)/'\s' x length($1)/ge;
# add first space again
$string = " " . $string;
# lowercase AND and OR
$string =~ s/(\s??OR\s??|\s??AND\s??)/\L$1\E/g;
# surround brackets with at least one space
$string =~ s/(?<!\\)(\)|\()/ $1 /g;
# surround strings with slashes
$string =~ s/(?<=\s)(\S+)/ $this->check_or($1, $case) /ge;
# remove slashes on <20>and<6E> and <20>or<6F>
$string =~ s/\/(and|or)\/$case/$1/g;
# remove spaces inside /string/ constructs
$string =~ s/(?<!and)(?<!or)\s*\//\//g;
$string =~ s/\/\s*(?!and|or)/\//g;
#my $res = qq(\$match = 1 if($string););
return qq(\$match = 1 if($string););
#print $res . "\n";
#return $res;
}
sub check_or {
#
# surrounds string with slashes if it is not
# <20>and<6E> or <20>or<6F>
#
my($this, $str, $case) = @_;
if ($str =~ /^\s*(or|and)\s*$/) {
return " $str ";
}
elsif ($str =~ /(?<!\\)[)(]/) {
return $str;
}
else {
return " \/$str\/$case ";
}
}
sub check_exact {
#
# helper for generate_search()
# masks special chars if string
# not inside ""
#
my($this, $str) = @_;
my %wildcards = (
'*' => '.*',
'?' => '.',
'[' => '[',
']' => ']',
'+' => '\+',
'.' => '\.',
'$' => '\$',
'@' => '\@',
'/' => '\/',
'|' => '\|',
'}' => '\}',
'{' => '\{',
);
my %escapes = (
'*' => '\*',
'?' => '\?',
'[' => '[',
']' => ']',
'+' => '\+',
'.' => '\.',
'$' => '\$',
'@' => '\@',
'(' => '\(',
')' => '\)',
'/' => '\/',
'|' => '\|',
'}' => '\}',
'{' => '\{',
);
# mask backslash
$str =~ s/\\/\\\\/g;
if ($str =~ /^"/ && $str =~ /"$/) {
# mask bracket-constructs
$str =~ s/(.)/$escapes{$1} || "$1"/ge;
}
else {
$str =~ s/(.)/$wildcards{$1} || "$1"/ge;
}
$str =~ s/^"//;
$str =~ s/"$//;
# mask spaces
$str =~ s/\s/\\s/g;
return $str;
}
sub lock {
my ($this) = @_;
if (-e $this->{LOCKFILE}) {
open LOCK, "<$this->{LOCKFILE}" or die "could not open $this->{LOCKFILE}: $!\n";
my $data = <LOCK>;
close LOCK;
chomp $data;
print "-- waiting for lock by $data --\n";
print "-- remove the lockfile if you are sure: \"$this->{LOCKFILE}\" --\n";
}
my $timeout = 60;
eval {
local $SIG{ALRM} = sub { die "timeout" };
local $SIG{INT} = sub { die "interrupted" };
alarm $timeout - 2;
while (1) {
if (! -e $this->{LOCKFILE}) {
umask 022;
open LOCK, ">$this->{LOCKFILE}" or die "could not open $this->{LOCKFILE}: $!\n";
flock LOCK, LOCK_EX;
my $now = scalar localtime();
print LOCK "$ENV{USER} since $now (PID: $$)\n";
flock LOCK, LOCK_UN;
close LOCK;
alarm 0;
return 0;
}
printf " %0d\r", $timeout;
$timeout--;
sleep 1;
}
};
if($@) {
if ($@ =~ /^inter/) {
print " interrupted\n";
}
else {
print $@;
print " timeout\n";
}
return 1;
}
return 0;
}
sub unlock {
my ($this) = @_;
unlink $this->{LOCKFILE};
}
1;

7
lib/NOTEDB/README Normal file
View File

@@ -0,0 +1,7 @@
perl modules for note used as database backends.
the install.sh script will install both of them,
although you may only need one backend. Perhaps
other users on your system have oter ideas in mind...
Therefore, please ignore these file. There is nothing
to edit or to do. Simply leave this directory :-)

496
lib/NOTEDB/binary.pm Normal file
View File

@@ -0,0 +1,496 @@
#!/usr/bin/perl
# $Id: binary.pm,v 1.3 2000/08/11 00:05:58 zarahg Exp $
# Perl module for note
# binary database backend. see docu: perldoc NOTEDB::binary
#
package NOTEDB::binary;
$NOTEDB::binary::VERSION = "1.12";
use strict;
use IO::Seekable;
use File::Spec;
use FileHandle;
use Fcntl qw(LOCK_EX LOCK_UN);
use NOTEDB;
use Exporter ();
use vars qw(@ISA @EXPORT);
@ISA = qw(NOTEDB Exporter);
sub new {
my($this, %param) = @_;
my $class = ref($this) || $this;
my $self = {};
bless($self,$class);
$self->{NOTEDB} = $self->{dbname} = $param{dbname} || File::Spec->catfile($ENV{HOME}, ".notedb");
my $MAX_NOTE = $param{MaxNoteByte} || 4096;
my $MAX_TIME = $param{MaxTimeByte} || 64;
if(! -e $self->{NOTEDB}) {
open(TT,">$self->{NOTEDB}") or die "Could not create $self->{NOTEDB}: $!\n";
close (TT);
}
elsif(! -w $self->{NOTEDB}) {
print "$self->{NOTEDB} is not writable!\n";
exit(1);
}
my $TYPEDEF = "i a$MAX_NOTE a$MAX_TIME";
my $SIZEOF = length pack($TYPEDEF, () );
$self->{sizeof} = $SIZEOF;
$self->{typedef} = $TYPEDEF;
$self->{maxnote} = $MAX_NOTE;
$self->{LOCKFILE} = $self->{NOTEDB} . "~LOCK";
return $self;
}
sub DESTROY
{
# clean the desk!
}
sub version {
my $this = shift;
return $NOTEDB::binary::VERSION;
}
sub set_del_all
{
my $this = shift;
unlink $this->{NOTEDB};
open(TT,">$this->{NOTEDB}") or die "Could not create $this->{NOTEDB}: $!\n";
close (TT);
}
sub get_single {
my($this, $num) = @_;
my($address, $note, $date, $n, $t, $buffer, );
open NOTE, "+<$this->{NOTEDB}" or die "could not open $this->{NOTEDB}\n";
flock NOTE, LOCK_EX;
$address = ($num-1) * $this->{sizeof};
seek(NOTE, $address, IO::Seekable::SEEK_SET);
read(NOTE, $buffer, $this->{sizeof});
($num, $n, $t) = unpack($this->{typedef}, $buffer);
$note = $this->ude($n);
$date = $this->ude($t);
flock NOTE, LOCK_UN;
close NOTE;
return $note, $date;
}
sub get_all
{
my $this = shift;
my($num, $note, $date, %res);
if ($this->unchanged) {
return %{$this->{cache}};
}
open NOTE, "+<$this->{NOTEDB}" or die "could not open $this->{NOTEDB}\n";
flock NOTE, LOCK_EX;
my($buffer, $t, $n);
seek(NOTE, 0, 0); # START FROM BEGINNING
while(read(NOTE, $buffer, $this->{sizeof})) {
($num, $note, $date) = unpack($this->{typedef}, $buffer);
$t = $this->ude($date);
$n = $this->ude($note);
$res{$num}->{'note'} = $n;
$res{$num}->{'date'} = $t;
}
flock NOTE, LOCK_UN;
close NOTE;
$this->cache(%res);
return %res;
}
sub import_data {
my ($this, $data) = @_;
foreach my $num (sort keys %{$data}) {
my $pos = $this->get_nextnum();
$this->set_edit($pos, $data->{$num}->{note}, $data->{$num}->{date});
}
}
sub get_nextnum
{
my $this = shift;
my($num, $te, $me, $buffer);
if ($this->unchanged) {
$num = 1;
foreach (keys %{$this->{cache}}) {
$num++;
}
return $num;
}
open NOTE, "+<$this->{NOTEDB}" or die "could not open $this->{NOTEDB}\n";
flock NOTE, LOCK_EX;
seek(NOTE, 0, 0); # START FROM BEGINNING
while(read(NOTE, $buffer, $this->{sizeof})) {
($num, $te, $me) = unpack($this->{typedef}, $buffer);
}
$num += 1;
flock NOTE, LOCK_UN;
close NOTE;
return $num;
}
sub get_search
{
my($this, $searchstring) = @_;
my($buffer, $num, $note, $date, %res, $t, $n, $match);
my $regex = $this->generate_search($searchstring);
eval $regex;
if ($@) {
print "invalid expression: \"$searchstring\"!\n";
return;
}
$match = 0;
if ($this->unchanged) {
foreach my $num (keys %{$this->{cache}}) {
$_ = $this->{cache}{$num}->{note};
eval $regex;
if ($match) {
$res{$num}->{note} = $this->{cache}{$num}->{note};
$res{$num}->{date} = $this->{cache}{$num}->{date}
}
$match = 0;
}
return %res;
}
open NOTE, "+<$this->{NOTEDB}" or die "could not open $this->{NOTEDB}\n";
flock NOTE, LOCK_EX;
seek(NOTE, 0, 0); # START FROM BEGINNING
while(read(NOTE, $buffer, $this->{sizeof})) {
($num, $note, $date) = unpack($this->{typedef}, $buffer);
$n = $this->ude($note);
$t = $this->ude($date);
$_ = $n;
eval $regex;
if($match)
{
$res{$num}->{'note'} = $n;
$res{$num}->{'date'} = $t;
}
$match = 0;
}
flock NOTE, LOCK_UN;
close NOTE;
return %res;
}
sub set_edit {
my($this, $num, $note, $date) = @_;
$this->warn_if_too_big($note, $num);
my $address = ($num -1 ) * $this->{sizeof};
open NOTE, "+<$this->{NOTEDB}" or die "could not open $this->{NOTEDB}\n";
flock NOTE, LOCK_EX;
seek(NOTE, $address, IO::Seekable::SEEK_SET);
my $n = $this->uen($note);
my $t = $this->uen($date);
my $buffer = pack($this->{typedef}, $num, $n, $t);
print NOTE $buffer;
flock NOTE, LOCK_UN;
close NOTE;
$this->changed;
}
sub set_new {
my($this, $num, $note, $date) = @_;
$this->warn_if_too_big($note, $num);
open NOTE, "+<$this->{NOTEDB}" or die "could not open $this->{NOTEDB}\n";
flock NOTE, LOCK_EX;
seek(NOTE, 0, IO::Seekable::SEEK_END); # APPEND
my $n = $this->uen($note);
my $t = $this->uen($date);
my $buffer = pack($this->{typedef}, $num, $n, $t);
print NOTE $buffer;
flock NOTE, LOCK_UN;
close NOTE;
$this->changed;
}
sub set_del
{
my($this, $num) = @_;
my(%orig, $note, $date, $T, $setnum, $buffer, $n, $N, $t);
$setnum = 1;
%orig = $this->get_all();
return "ERROR" if (! exists $orig{$num});
delete $orig{$num};
# overwrite, but keep number!
open NOTE, ">$this->{NOTEDB}" or die "could not open $this->{NOTEDB}\n";
flock NOTE, LOCK_EX;
seek(NOTE, 0, 0); # START FROM BEGINNING
foreach $N (keys %orig) {
$n = $this->uen($orig{$N}->{'note'});
$t = $this->uen($orig{$N}->{'date'});
$buffer = pack( $this->{typedef}, $N, $n, $t);
# keep orig number, note have to call recount!
print NOTE $buffer;
seek(NOTE, 0, IO::Seekable::SEEK_END);
$setnum++;
}
flock NOTE, LOCK_UN;
close NOTE;
$this->changed;
return;
}
sub set_recountnums
{
my($this) = @_;
my(%orig, $note, $date, $T, $setnum, $buffer, $n, $N, $t);
$setnum = 1;
%orig = $this->get_all();
open NOTE, ">$this->{NOTEDB}" or die "could not open $this->{NOTEDB}\n";
flock NOTE, LOCK_EX;
seek(NOTE, 0, 0); # START FROM BEGINNING
foreach $N (sort {$a <=> $b} keys %orig) {
$n = $this->uen($orig{$N}->{'note'});
$t = $this->uen($orig{$N}->{'date'});
$buffer = pack( $this->{typedef}, $setnum, $n, $t);
print NOTE $buffer;
seek(NOTE, 0, IO::Seekable::SEEK_END);
$setnum++;
}
flock NOTE, LOCK_UN;
close NOTE;
$this->changed;
return;
}
sub uen
{
my $this = shift;
my($T);
if($NOTEDB::crypt_supported == 1) {
eval {
$T = pack("u", $this->{cipher}->encrypt($_[0]));
};
}
else {
$T = pack("u", $_[0]);
}
chomp $T;
return $T;
}
sub ude
{
my $this = shift;
my($T);
if($NOTEDB::crypt_supported == 1) {
eval {
$T = $this->{cipher}->decrypt(unpack("u",$_[0]));
};
}
else {
$T = unpack("u", $_[0]);
}
return $T;
}
sub warn_if_too_big {
my ($this, $note, $num) = @_;
my $len = length($this->uen($note));
if ($len > $this->{maxnote}) {
# calculate the 30% uuencoding overhead
my $overhead = int(($this->{maxnote} / 100) * 28);
# fetch what's left by driver
my $left = substr $note, $this->{maxnote} - $overhead;
$left = "\n$left\n";
$left =~ s/\n/\n> /gs;
print STDERR "*** WARNING $this->{version} WARNING ***\n"
."The driver encountered a string length problem with your\n"
."note entry number $num. The entry is too long. Either shorten\n"
."the entry or resize the database field for entries.\n\n"
."The following data has been cut off the entry:\n"
."\n$left\n\n";
my $copy = File::Spec->catfile($ENV{'HOME'}, "entry-$num.txt");
open N, ">$copy" or die "Could not open $copy: $!\n";
print N $note;
close N;
print "*** Wrote the complete note entry number $num to file: $copy ***\n";
}
}
sub _retrieve {
my ($this) = @_;
my $file = $this->{dbname};
if (-s $file) {
if ($this->changed() || $this->{unread}) {
open NOTE, "+<$this->{NOTEDB}" or die "could not open $this->{NOTEDB}\n";
flock NOTE, LOCK_EX;
my($buffer, $t, $n, %res);
seek(NOTE, 0, 0); # START FROM BEGINNING
while(read(NOTE, $buffer, $this->{sizeof})) {
my ($num, $note, $date) = unpack($this->{typedef}, $buffer);
$t = $this->ude($date);
$n = $this->ude($note);
$res{$num}->{'note'} = $n;
$res{$num}->{'date'} = $t;
}
flock NOTE, LOCK_UN;
close NOTE;
$this->cache(%res);
return %res;
}
else {
return %{$this->{data}};
}
}
else {
return ();
}
}
sub _store {
# compatibility dummy
return 1;
}
1; # keep this!
__END__
=head1 NAME
NOTEDB::binary - module lib for accessing a notedb from perl
=head1 SYNOPSIS
# include the module
use NOTEDB;
# create a new NOTEDB object
$db = new NOTEDB("binary", "/home/tom/.notedb", 4096, 24);
# decide to use encryption
# $key is the cipher to use for encryption
# $method must be either Crypt::IDEA or Crypt::DES
# you need Crypt::CBC, Crypt::IDEA and Crypt::DES to have installed.
$db->use_crypt($key,$method);
# do not use encryption
# this is the default
$db->no_crypt;
# get a single note
($note, $date) = $db->get_single(1);
# search for a certain note
%matching_notes = $db->get_search("somewhat");
# format of returned hash:
#$matching_notes{$numberofnote}->{'note' => 'something', 'date' => '23.12.2000 10:33:02'}
# get all existing notes
%all_notes = $db->get_all();
# format of returnes hash like the one from get_search above
# get the next noteid available
$next_num = $db->get_nextnum();
# modify a certain note
$db->set_edit(1, "any text", "23.12.2000 10:33:02");
# create a new note
$db->set_new(5, "any new text", "23.12.2000 10:33:02");
# delete a certain note
$db->set_del(5);
# turn on encryption. CryptMethod must be IDEA, DES or BLOWFISH
$db->use_crypt("passphrase", "CryptMethod");
# turn off encryption. This is the default.
$db->no_crypt();
=head1 DESCRIPTION
You can use this module for accessing a note database. There are currently
two versions of this module, one version for a SQL database and one for a
binary file (note's own database-format).
However, both versions provides identical interfaces, which means, you do
not need to change your code, if you want to switch to another database format.
Currently, NOTEDB module is only used by note itself. But feel free to use it
within your own project! Perhaps someone want to implement a webinterface to
note...
=head1 USAGE
please see the section SYNOPSIS, it says it all.
=head1 AUTHOR
Thomas Linden <tom@daemon.de>.
=cut

269
lib/NOTEDB/dbm.pm Normal file
View File

@@ -0,0 +1,269 @@
#!/usr/bin/perl
# $Id: dbm.pm,v 1.3 2000/08/11 00:05:58 zarahg Exp $
# Perl module for note
# DBM database backend. see docu: perldoc NOTEDB::dbm
#
package NOTEDB::dbm;
$NOTEDB::dbm::VERSION = "1.41";
use DB_File;
use NOTEDB;
use strict;
use Exporter ();
use vars qw(@ISA @EXPORT %note %date);
@ISA = qw(NOTEDB Exporter);
sub new
{
my($this, %param) = @_;
my $class = ref($this) || $this;
my $self = {};
bless($self,$class);
my $notefile = "note.dbm";
my $timefile = "date.dbm";
my $dbm_dir = $self->{dbname} = $param{dbname} || File::Spec->catfile($ENV{HOME}, ".note_dbm");
if (! -d $dbm_dir) {
# try to make it
mkdir $dbm_dir || die "Could not create $dbm_dir: $!\n";
}
tie %note, "DB_File", "$dbm_dir/$notefile" || die "Could not tie $dbm_dir/$notefile: $!\n";
tie %date, "DB_File", "$dbm_dir/$timefile" || die "Could not tie $dbm_dir/$timefile: $!\n";
$self->{LOCKFILE} = $param{dbname} . "~LOCK";
return $self;
}
sub DESTROY
{
# clean the desk!
untie %note, %date;
}
sub version {
my $this = shift;
return $this->{version};
}
sub get_single
{
my($this, $num) = @_;
my($note, $date);
return $this->ude ($note{$num}), $this->ude($date{$num});
}
sub get_all
{
my $this = shift;
my($num, $note, $date, %res, $real);
foreach $num (sort {$a <=> $b} keys %date) {
$res{$num}->{'note'} = $this->ude($note{$num});
$res{$num}->{'date'} = $this->ude($date{$num});
}
return %res;
}
sub import_data {
my ($this, $data) = @_;
foreach my $num (keys %{$data}) {
my $pos = $this->get_nextnum();
$note{$pos} = $this->ude($note{$num}->{note});
$date{$pos} = $this->ude($date{$num}->{date});
}
}
sub get_nextnum
{
my($this, $num);
foreach (sort {$a <=> $b} keys %date) {
$num = $_;
}
$num++;
return $num;
}
sub get_search
{
my($this, $searchstring) = @_;
my($num, $note, $date, %res, $match);
my $regex = $this->generate_search($searchstring);
eval $regex;
if ($@) {
print "invalid expression: \"$searchstring\"!\n";
return;
}
$match = 0;
foreach $num (sort {$a <=> $b} keys %date) {
$_ = $this->ude($note{$num});
eval $regex;
if ($match) {
$res{$num}->{'note'} = $this->ude($note{$num});
$res{$num}->{'date'} = $this->ude($date{$num});
}
$match = 0;
}
return %res;
}
sub set_recountnums
{
my $this = shift;
my(%Note, %Date, $num, $setnum);
$setnum = 1;
foreach $num (sort {$a <=> $b} keys %note) {
$Note{$setnum} = $note{$num};
$Date{$setnum} = $date{$num};
$setnum++;
}
%note = %Note;
%date = %Date;
}
sub set_edit
{
my($this, $num, $note, $date) = @_;
$note{$num} = $this->uen($note);
$date{$num} = $this->uen($date);
}
sub set_new
{
my($this, $num, $note, $date) = @_;
$this->set_edit($num, $note, $date); # just the same thing
}
sub set_del
{
my($this, $num) = @_;
my($note, $date, $T);
($note, $date) = $this->get_single($num);
return "ERROR" if ($date !~ /^\d/);
delete $note{$num};
delete $date{$num};
}
sub set_del_all
{
my($this) = @_;
%note = ();
%date = ();
return;
}
sub uen
{
my $this = shift;
my($T);
if($NOTEDB::crypt_supported == 1) {
eval {
$T = pack("u", $this->{cipher}->encrypt($_[0]));
};
}
else {
$T = $_[0];
}
chomp $T;
return $T;
}
sub ude
{
my $this = shift;
my($T);
if($NOTEDB::crypt_supported == 1) {
eval {
$T = $this->{cipher}->decrypt(unpack("u",$_[0]))
};
return $T;
}
else {
return $_[0];
}
}
1; # keep this!
__END__
=head1 NAME
NOTEDB::dbm - module lib for accessing a notedb from perl
=head1 SYNOPSIS
# include the module
use NOTEDB;
# create a new NOTEDB object (the last 4 params are db table/field names)
$db = new NOTEDB("mysql","note","/home/user/.notedb/");
# get a single note
($note, $date) = $db->get_single(1);
# search for a certain note
%matching_notes = $db->get_search("somewhat");
# format of returned hash:
#$matching_notes{$numberofnote}->{'note' => 'something', 'date' => '23.12.2000 10:33:02'}
# get all existing notes
%all_notes = $db->get_all();
# format of returnes hash like the one from get_search above
# get the next noteid available
$next_num = $db->get_nextnum();
# recount all noteids starting by 1 (usefull after deleting one!)
$db->set_recountnums();
# modify a certain note
$db->set_edit(1, "any text", "23.12.2000 10:33:02");
# create a new note
$db->set_new(5, "any new text", "23.12.2000 10:33:02");
# delete a certain note
$db->set_del(5);
=head1 DESCRIPTION
You can use this module for accessing a note database. This is the dbm module.
It uses the DB_FILE module to store it's data and it uses DBM files for tis purpose.
Currently, NOTEDB module is only used by note itself. But feel free to use it
within your own project! Perhaps someone want to implement a webinterface to
note...
=head1 USAGE
please see the section SYNOPSIS, it says it all.
=head1 AUTHOR
Thomas Linden <tom@daemon.de>.
=cut

371
lib/NOTEDB/dumper.pm Normal file
View File

@@ -0,0 +1,371 @@
# Perl module for note
# text database backend. see docu: perldoc NOTEDB::text
# using Storable as backend.
package NOTEDB::dumper;
$NOTEDB::dumper::VERSION = "1.02";
use strict;
use Data::Dumper;
use File::Spec;
use MIME::Base64;
use NOTEDB;
use Fcntl qw(LOCK_EX LOCK_UN);
use Exporter ();
use vars qw(@ISA @EXPORT);
@ISA = qw(NOTEDB Exporter);
sub new {
my($this, %param) = @_;
my $class = ref($this) || $this;
my $self = {};
bless($self,$class);
$self->{NOTEDB} = $self->{dbname} = $param{dbname} || File::Spec->catfile($ENV{HOME}, ".notedb");
if(! -e $param{dbname}) {
open(TT,">$param{dbname}") or die "Could not create $param{dbname}: $!\n";
close (TT);
}
elsif(! -w $param{dbname}) {
print "$param{dbname} is not writable!\n";
exit(1);
}
$self->{LOCKFILE} = $param{dbname} . "~LOCK";
$self->{mtime} = $self->get_stat();
$self->{unread} = 1;
$self->{data} = {};
return $self;
}
sub DESTROY
{
# clean the desk!
}
sub version {
my $this = shift;
return $NOTEDB::text::VERSION;
}
sub get_stat {
my ($this) = @_;
my $mtime = (stat($this->{dbname}))[9];
return $mtime;
}
sub set_del_all {
my $this = shift;
unlink $this->{NOTEDB};
open(TT,">$this->{NOTEDB}") or die "Could not create $this->{NOTEDB}: $!\n";
close (TT);
}
sub get_single {
my($this, $num) = @_;
my($address, $note, $date, $n, $t, $buffer, );
my %data = $this->get_all();
return ($data{$num}->{note}, $data{$num}->{date});
}
sub get_all {
my $this = shift;
my($num, $note, $date, %res);
if ($this->unchanged) {
return %{$this->{cache}};
}
my %data = $this->_retrieve();
foreach my $num (keys %data) {
$res{$num}->{note} = $this->ude($data{$num}->{note});
$res{$num}->{date} = $this->ude($data{$num}->{date});
}
$this->cache(%res);
return %res;
}
sub import_data {
my ($this, $data) = @_;
my %res = $this->_retrieve();
my $pos = (scalar keys %res) + 1;
foreach my $num (keys %{$data}) {
$res{$pos}->{note} = $this->uen($data->{$num}->{note});
$res{$pos}->{date} = $this->uen($data->{$num}->{date});
$pos++;
}
$this->_store(\%res);
}
sub get_nextnum {
my $this = shift;
my($num, $te, $me, $buffer);
if ($this->unchanged) {
$num = 1;
foreach (keys %{$this->{cache}}) {
$num++;
}
return $num;
}
my %data = $this->get_all();
my $size = scalar keys %data;
$num = $size + 1;
return $num;
}
sub get_search {
my($this, $searchstring) = @_;
my($buffer, $num, $note, $date, %res, $t, $n, $match);
my $regex = $this->generate_search($searchstring);
eval $regex;
if ($@) {
print "invalid expression: \"$searchstring\"!\n";
return;
}
$match = 0;
if ($this->unchanged) {
foreach my $num (keys %{$this->{cache}}) {
$_ = $this->{cache}{$num}->{note};
eval $regex;
if ($match) {
$res{$num}->{note} = $this->{cache}{$num}->{note};
$res{$num}->{date} = $this->{cache}{$num}->{date}
}
$match = 0;
}
return %res;
}
my %data = $this->get_all();
foreach my $num(sort keys %data) {
$_ = $data{$num}->{note};
eval $regex;
if($match)
{
$res{$num}->{note} = $data{$num}->{note};
$res{$num}->{date} = $data{$num}->{data};
}
$match = 0;
}
return %res;
}
sub set_edit {
my($this, $num, $note, $date) = @_;
my %data = $this->_retrieve();
$data{$num} = {
note => $this->uen($note),
date => $this->uen($date)
};
$this->_store(\%data);
$this->changed;
}
sub set_new {
my($this, $num, $note, $date) = @_;
$this->set_edit($num, $note, $date);
}
sub set_del {
my($this, $num) = @_;
my(%data, $note, $date, $T, $setnum, $buffer, $n, $N, $t);
$setnum = 1;
%data = $this->_retrieve();
return "ERROR" if (! exists $data{$num});
delete $data{$num};
$this->_store(\%data);
$this->changed;
return;
}
sub set_recountnums {
my($this) = @_;
my(%orig, %data, $note, $date, $T, $setnum, $buffer, $n, $N, $t);
$setnum = 1;
%orig = $this->_retrieve();
foreach $N (sort {$a <=> $b} keys %orig) {
$data{$setnum} = {
note => $orig{$N}->{note},
date => $orig{$N}->{date}
};
$setnum++;
}
$this->_store(\%data);
$this->changed;
return;
}
sub uen {
my ($this, $raw) = @_;
my($crypted);
if($NOTEDB::crypt_supported == 1) {
eval {
$crypted = $this->{cipher}->encrypt($raw);
return encode_base64($crypted);
};
}
else {
return $raw;
}
}
sub ude {
my ($this, $crypted) = @_;
my($raw);
if($NOTEDB::crypt_supported == 1) {
eval {
$raw = $this->{cipher}->decrypt(decode_base64($crypted));
};
return $raw;
}
else {
return $crypted;
}
}
sub _store {
my ($this, $data) = @_;
open N, ">$this->{NOTEDB}" or die "Could not open db: $!\n";
print N Data::Dumper->Dump([$data], [qw(*data)]);
close N;
}
sub _retrieve {
my $this = shift;
if (-s $this->{NOTEDB}) {
if ($this->changed() || $this->{unread}) {
open N, "<$this->{NOTEDB}" or die "Could not open db: $!\n";
my $content = join "", <N>;
close N;
my %data;
eval $content; # creates %data
$this->{unread} = 0;
$this->{data} = \%data;
return %data;
}
}
else {
return ();
}
}
1; # keep this!
__END__
=head1 NAME
NOTEDB::text - module lib for accessing a notedb from perl
=head1 SYNOPSIS
# include the module
use NOTEDB;
# create a new NOTEDB object
$db = new NOTEDB("text", "/home/tom/.notedb", 4096, 24);
# decide to use encryption
# $key is the cipher to use for encryption
# $method must be either Crypt::IDEA or Crypt::DES
# you need Crypt::CBC, Crypt::IDEA and Crypt::DES to have installed.
$db->use_crypt($key,$method);
# do not use encryption
# this is the default
$db->no_crypt;
# get a single note
($note, $date) = $db->get_single(1);
# search for a certain note
%matching_notes = $db->get_search("somewhat");
# format of returned hash:
#$matching_notes{$numberofnote}->{'note' => 'something', 'date' => '23.12.2000 10:33:02'}
# get all existing notes
%all_notes = $db->get_all();
# format of returnes hash like the one from get_search above
# get the next noteid available
$next_num = $db->get_nextnum();
# modify a certain note
$db->set_edit(1, "any text", "23.12.2000 10:33:02");
# create a new note
$db->set_new(5, "any new text", "23.12.2000 10:33:02");
# delete a certain note
$db->set_del(5);
# turn on encryption. CryptMethod must be IDEA, DES or BLOWFISH
$db->use_crypt("passphrase", "CryptMethod");
# turn off encryption. This is the default.
$db->no_crypt();
=head1 DESCRIPTION
You can use this module for accessing a note database. This backend uses
a text file for storage and Storable for accessing the file.
Currently, NOTEDB module is only used by note itself. But feel free to use it
within your own project! Perhaps someone want to implement a webinterface to
note...
=head1 USAGE
please see the section SYNOPSIS, it says it all.
=head1 AUTHOR
Thomas Linden <tom@daemon.de>.
=cut

412
lib/NOTEDB/general.pm Normal file
View File

@@ -0,0 +1,412 @@
# Perl module for note
# general database backend. see docu: perldoc NOTEDB::general
# using Config::General as backend.
package NOTEDB::general;
$NOTEDB::general::VERSION = "1.04";
use strict;
#use Data::Dumper;
use File::Spec;
use Config::General qw(ParseConfig SaveConfig SaveConfigString);
use MIME::Base64;
use FileHandle;
use NOTEDB;
use Fcntl qw(LOCK_EX LOCK_UN);
use Exporter ();
use vars qw(@ISA @EXPORT);
@ISA = qw(NOTEDB Exporter);
sub new {
my($this, %param) = @_;
my $class = ref($this) || $this;
my $self = {};
bless($self,$class);
$self->{dbname} = $param{dbname} || File::Spec->catfile($ENV{HOME}, ".notedb");
if(! -e $param{dbname}) {
open(TT,">$param{dbname}") or die "Could not create $param{dbname}: $!\n";
close (TT);
}
elsif(! -w $param{dbname}) {
print "$param{dbname} is not writable!\n";
exit(1);
}
$self->{mtime} = $self->get_stat();
$self->{unread} = 1;
$self->{changed} = 1;
$self->{data} = {};
$self->{LOCKFILE} = $param{dbname} . "~LOCK";
return $self;
}
sub DESTROY {
# clean the desk!
}
sub version {
my $this = shift;
return $NOTEDB::general::VERSION;
}
sub get_stat {
my ($this) = @_;
my $mtime = (stat($this->{dbname}))[9];
return $mtime;
}
sub changed {
my ($this) = @_;
my $current = $this->get_stat();
if ($current > $this->{mtime}) {
$this->{mtime} = $current;
return $current;
}
else {
return 0;
}
}
sub set_del_all {
my $this = shift;
unlink $this->{dbname};
open(TT,">$this->{dbname}") or die "Could not create $this->{dbname}: $!\n";
close (TT);
}
sub get_single {
my($this, $num) = @_;
my($address, $note, $date, $n, $t, $buffer, );
my %data = $this->get_all();
return ($data{$num}->{note}, $data{$num}->{date});
}
sub get_all {
my $this = shift;
my($num, $note, $date, %res);
if ($this->unchanged) {
return %{$this->{cache}};
}
my %data = $this->_retrieve();
foreach my $num (keys %data) {
$res{$num}->{note} = $this->ude($data{$num}->{note});
$res{$num}->{date} = $this->ude($data{$num}->{date});
}
$this->cache(%res);
return %res;
}
sub import_data {
my ($this, $data) = @_;
my %res = $this->_retrieve();
my $pos = (scalar keys %res) + 1;
foreach my $num (keys %{$data}) {
$res{$pos}->{note} = $this->uen($data->{$num}->{note});
$res{$pos}->{date} = $this->uen($data->{$num}->{date});
$pos++;
}
$this->_store(\%res);
}
sub get_nextnum {
my $this = shift;
my($num, $te, $me, $buffer);
if ($this->unchanged) {
$num = 1;
foreach (keys %{$this->{cache}}) {
$num++;
}
return $num;
}
my %data = $this->get_all();
my @numbers = sort { $a <=> $b } keys %data;
$num = pop @numbers;
$num++;
return $num;
}
sub get_search {
my($this, $searchstring) = @_;
my($buffer, $num, $note, $date, %res, $t, $n, $match);
my $regex = $this->generate_search($searchstring);
eval $regex;
if ($@) {
print "invalid expression: \"$searchstring\"!\n";
return;
}
$match = 0;
if ($this->unchanged) {
foreach my $num (keys %{$this->{cache}}) {
$_ = $this->{cache}{$num}->{note};
eval $regex;
if ($match) {
$res{$num}->{note} = $this->{cache}{$num}->{note};
$res{$num}->{date} = $this->{cache}{$num}->{date}
}
$match = 0;
}
return %res;
}
my %data = $this->get_all();
foreach my $num(sort keys %data) {
$_ = $data{$num}->{note};
eval $regex;
if($match)
{
$res{$num}->{note} = $data{$num}->{note};
$res{$num}->{date} = $data{$num}->{data};
}
$match = 0;
}
return %res;
}
sub set_edit {
my($this, $num, $note, $date) = @_;
my %data = $this->_retrieve();
$data{$num} = {
note => $this->uen($note),
date => $this->uen($date)
};
$this->_store(\%data);
$this->changed;
}
sub set_new {
my($this, $num, $note, $date) = @_;
$this->set_edit($num, $note, $date);
}
sub set_del {
my($this, $num) = @_;
my(%data, $note, $date, $T, $setnum, $buffer, $n, $N, $t);
$setnum = 1;
%data = $this->_retrieve();
return "ERROR" if (! exists $data{$num});
delete $data{$num};
$this->_store(\%data);
$this->changed;
return;
}
sub set_recountnums {
my($this) = @_;
my(%orig, %data, $note, $date, $T, $setnum, $buffer, $n, $N, $t);
$setnum = 1;
%orig = $this->_retrieve();
foreach $N (sort {$a <=> $b} keys %orig) {
$data{$setnum} = {
note => $orig{$N}->{note},
date => $orig{$N}->{date}
};
$setnum++;
}
$this->_store(\%data);
$this->changed;
return;
}
sub uen {
my ($this, $raw) = @_;
my($crypted);
if($NOTEDB::crypt_supported == 1) {
eval {
$crypted = $this->{cipher}->encrypt($raw);
};
print $@;
}
else {
$crypted = $raw;
}
my $coded = encode_base64($crypted);
chomp $coded;
return $coded;
}
sub ude {
my ($this, $crypted) = @_;
my($raw);
if($NOTEDB::crypt_supported == 1) {
eval {
$raw = $this->{cipher}->decrypt(decode_base64($crypted));
};
}
else {
$raw = decode_base64($crypted)
}
return $raw;
}
sub _store {
my ($this, $data) = @_;
open NOTE, ">$this->{dbname}" or die "could not open $this->{dbname}: $!\n";
flock NOTE, LOCK_EX;
if (%{$data}) {
my $content = SaveConfigString($data) or die "could not serialize data: $!\n";
print NOTE $content;
}
else {
print NOTE "";
}
flock NOTE, LOCK_UN;
close NOTE;
# finally re-read the db, so that we always have the latest data
$this->_retrieve();
}
sub _retrieve {
my ($this) = @_;
my $file = $this->{dbname};
if (-s $file) {
if ($this->{changed} || $this->{unread}) {
my $fh = new FileHandle "<$this->{dbname}" or die "could not open $this->{dbname}\n";
flock $fh, LOCK_EX;
my %data = ParseConfig(-ConfigFile => $fh) or die "could not read to database: $!\n";
flock $fh, LOCK_UN;
$fh->close();
$this->{unread} = 0;
$this->{data} = \%data;
return %data;
}
else {
return %{$this->{data}};
}
}
else {
return ();
}
}
1; # keep this!
__END__
=head1 NAME
NOTEDB::general - module lib for accessing a notedb from perl
=head1 SYNOPSIS
# include the module
use NOTEDB;
# create a new NOTEDB object
$db = new NOTEDB("text", "/home/tom/.notedb", 4096, 24);
# decide to use encryption
# $key is the cipher to use for encryption
# $method must be either Crypt::IDEA or Crypt::DES
# you need Crypt::CBC, Crypt::IDEA and Crypt::DES to have installed.
$db->use_crypt($key,$method);
# do not use encryption
# this is the default
$db->no_crypt;
# get a single note
($note, $date) = $db->get_single(1);
# search for a certain note
%matching_notes = $db->get_search("somewhat");
# format of returned hash:
#$matching_notes{$numberofnote}->{'note' => 'something', 'date' => '23.12.2000 10:33:02'}
# get all existing notes
%all_notes = $db->get_all();
# format of returnes hash like the one from get_search above
# get the next noteid available
$next_num = $db->get_nextnum();
# modify a certain note
$db->set_edit(1, "any text", "23.12.2000 10:33:02");
# create a new note
$db->set_new(5, "any new text", "23.12.2000 10:33:02");
# delete a certain note
$db->set_del(5);
# turn on encryption. CryptMethod must be IDEA, DES or BLOWFISH
$db->use_crypt("passphrase", "CryptMethod");
# turn off encryption. This is the default.
$db->no_crypt();
=head1 DESCRIPTION
You can use this module for accessing a note database. This backend uses
a text file for storage and Config::General for accessing the file.
Currently, NOTEDB module is only used by note itself. But feel free to use it
within your own project! Perhaps someone want to implement a webinterface to
note...
=head1 USAGE
please see the section SYNOPSIS, it says it all.
=head1 AUTHOR
Thomas Linden <tom@daemon.de>.
=cut

425
lib/NOTEDB/mysql.pm Normal file
View File

@@ -0,0 +1,425 @@
#
# Perl module for note
# mysql database backend. see docu: perldoc NOTEDB::mysql
#
package NOTEDB::mysql;
$NOTEDB::mysql::VERSION = "1.51";
use DBI;
use strict;
#use Data::Dumper;
use NOTEDB;
use Exporter ();
use vars qw(@ISA @EXPORT);
@ISA = qw(NOTEDB Exporter);
sub new {
my($this, %param) = @_;
my $class = ref($this) || $this;
my $self = {};
bless($self,$class);
my $dbname = $param{dbname} || "note";
my $dbhost = $param{dbhost} || "localhost";
my $dbuser = $param{dbuser} || "";
my $dbpasswd = $param{dbpasswd} || "";
my $dbport = $param{dbport} || "";
my $fnum = "number";
my $fnote = "note";
my $fdate = "date";
my $ftopic = "topic";
my $database;
if ($dbport) {
$database = "DBI:mysql:$dbname;host=$dbhost:$dbport";
}
else {
$database = "DBI:mysql:$dbname;host=$dbhost";
}
$self->{table} = "note";
$self->{sql_getsingle} = "SELECT $fnote,$fdate,$ftopic FROM $self->{table} WHERE $fnum = ?";
$self->{sql_all} = "SELECT $fnum,$fnote,$fdate,$ftopic FROM $self->{table}";
$self->{sql_nextnum} = "SELECT max($fnum) FROM $self->{table}";
$self->{sql_incrnum} = "SELECT $fnum FROM $self->{table} ORDER BY $fnum";
$self->{sql_setnum} = "UPDATE $self->{table} SET $fnum = ? WHERE $fnum = ?";
$self->{sql_edit} = "UPDATE $self->{table} SET $fnote = ?, $fdate = ?, $ftopic = ? WHERE $fnum = ?";
$self->{sql_insertnew} = "INSERT INTO $self->{table} VALUES (?, ?, ?, ?)";
$self->{sql_del} = "DELETE FROM $self->{table} WHERE $fnum = ?";
$self->{sql_del_all} = "DELETE FROM $self->{table}";
$self->{DB} = DBI->connect($database, $dbuser, $dbpasswd) or die DBI->errstr();
return $self;
}
sub DESTROY
{
# clean the desk!
my $this = shift;
$this->{DB}->disconnect;
}
sub lock {
my($this) = @_;
# LOCK the database!
my $lock = $this->{DB}->prepare("LOCK TABLES $this->{table} WRITE")
|| die $this->{DB}->errstr();
$lock->execute() || die $this->{DB}->errstr();
}
sub unlock {
my($this) = @_;
my $unlock = $this->{DB}->prepare("UNLOCK TABLES") || die $this->{DB}->errstr;
$unlock->execute() || die $this->{DB}->errstr();
}
sub version {
my $this = shift;
return $this->{version};
}
sub get_single {
my($this, $num) = @_;
my($note, $date, $topic);
my $statement = $this->{DB}->prepare($this->{sql_getsingle}) || die $this->{DB}->errstr();
$statement->execute($num) || die $this->{DB}->errstr();
$statement->bind_columns(undef, \($note, $date, $topic)) || die $this->{DB}->errstr();
while($statement->fetch) {
$note = $this->ude($note);
if ($topic) {
$note = "$topic\n" . $note;
}
return $note, $this->ude($date);
}
}
sub get_all
{
my $this = shift;
my($num, $note, $date, %res, $topic);
if ($this->unchanged) {
return %{$this->{cache}};
}
my $statement = $this->{DB}->prepare($this->{sql_all}) or die $this->{DB}->errstr();
$statement->execute or die $this->{DB}->errstr();
$statement->bind_columns(undef, \($num, $note, $date, $topic)) or die $this->{DB}->errstr();
while($statement->fetch) {
$res{$num}->{'note'} = $this->ude($note);
$res{$num}->{'date'} = $this->ude($date);
if ($topic) {
$res{$num}->{'note'} = "$topic\n" . $res{$num}->{'note'};
}
}
$this->cache(%res);
return %res;
}
sub get_nextnum
{
my $this = shift;
my($num);
if ($this->unchanged) {
$num = 1;
foreach (keys %{$this->{cache}}) {
$num++;
}
return $num;
}
my $statement = $this->{DB}->prepare($this->{sql_nextnum}) || die $this->{DB}->errstr();
$statement->execute || die $this->{DB}->errstr();
$statement->bind_columns(undef, \($num)) || die $this->{DB}->errstr();
while($statement->fetch) {
return $num+1;
}
}
sub get_search
{
my($this, $searchstring) = @_;
my($num, $note, $date, %res, $match, $use_cache, $topic);
my $regex = $this->generate_search($searchstring);
eval $regex;
if ($@) {
print "invalid expression: \"$searchstring\"!\n";
return;
}
$match = 0;
if ($this->unchanged) {
foreach my $num (keys %{$this->{cache}}) {
$_ = $this->{cache}{$num}->{note};
eval $regex;
if ($match) {
$res{$num}->{note} = $this->{cache}{$num}->{note};
$res{$num}->{date} = $this->{cache}{$num}->{date}
}
$match = 0;
}
return %res;
}
my $statement = $this->{DB}->prepare($this->{sql_all}) or die $this->{DB}->errstr();
$statement->execute or die $this->{DB}->errstr();
$statement->bind_columns(undef, \($num, $note, $date, $topic)) or die $this->{DB}->errstr();
while($statement->fetch) {
$note = $this->ude($note);
$date = $this->ude($date);
if ($topic) {
$note = "$topic\n" . $note;
}
$_ = $note;
eval $regex;
if($match) {
$res{$num}->{'note'} = $note;
$res{$num}->{'date'} = $date;
}
$match = 0;
}
return %res;
}
sub set_edit
{
my($this, $num, $note, $date) = @_;
$this->lock;
my $statement = $this->{DB}->prepare($this->{sql_edit}) or die $this->{DB}->errstr();
$note =~ s/'/\'/g;
$note =~ s/\\/\\\\/g;
$statement->execute($this->uen($note), $this->uen($date), $num)
or die $this->{DB}->errstr();
$this->unlock;
$this->changed;
}
sub set_new
{
my($this, $num, $note, $date) = @_;
$this->lock;
my $statement = $this->{DB}->prepare($this->{sql_insertnew}) || die $this->{DB}->errstr();
my ($topic, $note) = $this->get_topic($note);
$note =~ s/'/\'/g;
$note =~ s/\\/\\\\/g;
$topic =~ s/\\/\\\\/g;
$statement->execute($num, $this->uen($note), $this->uen($date), $topic) || die $this->{DB}->errstr();
$this->unlock;
$this->changed;
}
sub set_del
{
my($this, $num) = @_;
my($note, $date, $T);
$this->lock;
($note, $date) = $this->get_single($num);
return "ERROR" if ($date !~ /^\d/);
# delete record!
my $statement = $this->{DB}->prepare($this->{sql_del}) || die $this->{DB}->errstr();
$statement->execute($num) || die $this->{DB}->errstr();
$this->unlock;
$this->changed;
return;
}
sub set_del_all
{
my($this) = @_;
$this->lock;
my $statement = $this->{DB}->prepare($this->{sql_del_all}) || die $this->{DB}->errstr();
$statement->execute() || die $this->{DB}->errstr();
$this->unlock;
$this->changed;
return;
}
sub set_recountnums {
my $this = shift;
$this->lock;
my(@count, $i, $num, $setnum, $pos);
$setnum = 1;
$pos=0; $i=0; @count = ();
my $statement = $this->{DB}->prepare($this->{sql_incrnum}) || die $this->{DB}->errstr();
$statement->execute || die $this->{DB}->errstr();
$statement->bind_columns(undef, \($num)) || die $this->{DB}->errstr();
# store real id's in an array!
while($statement->fetch) {
$count[$i] = $num;
$i++;
}
# now recount them!
my $sub_statement = $this->{DB}->prepare($this->{sql_setnum}) || die $this->{DB}->errstr();
for($pos=0;$pos<$i;$pos++) {
$setnum = $pos +1;
$sub_statement->execute($setnum,$count[$pos]) || die $this->{DB}->errstr();
}
$this->unlock;
$this->changed;
}
sub import_data {
my ($this, $data) = @_;
foreach my $num (keys %{$data}) {
my $pos = $this->get_nextnum();
$this->set_new($pos, $data->{$num}->{note}, $data->{$num}->{date});
}
}
sub uen
{
my $this = shift;
my($T);
if($NOTEDB::crypt_supported == 1) {
eval {
$T = pack("u", $this->{cipher}->encrypt($_[0]));
};
}
else {
$T = $_[0];
}
chomp $T;
return $T;
}
sub ude
{
my $this = shift;
my($T);
if($NOTEDB::crypt_supported == 1) {
eval {
$T = $this->{cipher}->decrypt(unpack("u",$_[0]))
};
return $T;
}
else {
return $_[0];
}
}
sub get_topic {
my ($this, $data) = @_;
if ($data =~ /^\//) {
my($topic, $note) = split /\n/, $data, 2;
return ($topic, $note);
}
else {
return ("", $data);
}
}
1; # keep this!
__END__
=head1 NAME
NOTEDB::mysql - module lib for accessing a notedb from perl
=head1 SYNOPSIS
# include the module
use NOTEDB;
# create a new NOTEDB object (the last 4 params are db table/field names)
$db = new NOTEDB("mysql","note","localhost","username","password","note","number","note","date");
# get a single note
($note, $date) = $db->get_single(1);
# search for a certain note
%matching_notes = $db->get_search("somewhat");
# format of returned hash:
#$matching_notes{$numberofnote}->{'note' => 'something', 'date' => '23.12.2000 10:33:02'}
# get all existing notes
%all_notes = $db->get_all();
# format of returnes hash like the one from get_search above
# get the next noteid available
$next_num = $db->get_nextnum();
# recount all noteids starting by 1 (usefull after deleting one!)
$db->set_recountnums();
# modify a certain note
$db->set_edit(1, "any text", "23.12.2000 10:33:02");
# create a new note
$db->set_new(5, "any new text", "23.12.2000 10:33:02");
# delete a certain note
$db->set_del(5);
# turn on encryption. CryptMethod must be IDEA, DES or BLOWFISH
$db->use_crypt("passphrase", "CryptMethod");
# turn off encryption. This is the default.
$db->no_crypt();
=head1 DESCRIPTION
You can use this module for accessing a note database. There are currently
two versions of this module, one version for a SQL database and one for a
binary file (note's own database-format).
However, both versions provides identical interfaces, which means, you do
not need to change your code, if you want to switch to another database format.
Currently, NOTEDB module is only used by note itself. But feel free to use it
within your own project! Perhaps someone want to implement a webinterface to
note...
=head1 USAGE
please see the section SYNOPSIS, it says it all.
=head1 AUTHOR
Thomas Linden <tom@daemon.de>.
=cut

612
lib/NOTEDB/pwsafe3.pm Normal file
View File

@@ -0,0 +1,612 @@
# Perl module for note
# pwsafe3 backend. see docu: perldoc NOTEDB::pwsafe3
package NOTEDB::pwsafe3;
$NOTEDB::pwsafe3::VERSION = "1.08";
use strict;
use Data::Dumper;
use Time::Local;
use Crypt::PWSafe3;
use NOTEDB;
use Fcntl qw(LOCK_EX LOCK_UN);
use Exporter ();
use vars qw(@ISA @EXPORT);
@ISA = qw(NOTEDB Exporter);
sub new {
my($this, %param) = @_;
my $class = ref($this) || $this;
my $self = {};
bless($self,$class);
$self->{dbname} = $param{dbname} || File::Spec->catfile($ENV{HOME}, ".notedb");
$self->{mtime} = $self->get_stat();
$self->{unread} = 1;
$self->{data} = {};
$self->{LOCKFILE} = $param{dbname} . "~LOCK";
$self->{keepkey} = 0;
return $self;
}
sub DESTROY {
# clean the desk!
}
sub version {
my $this = shift;
return $NOTEDB::pwsafe3::VERSION;
}
sub get_stat {
my ($this) = @_;
if(-e $this->{dbname}) {
return (stat($this->{dbname}))[9];
}
else {
return time;
}
}
sub filechanged {
my ($this) = @_;
my $current = $this->get_stat();
if ($current > $this->{mtime}) {
$this->{mtime} = $current;
return $current;
}
else {
return 0;
}
}
sub set_del_all {
my $this = shift;
unlink $this->{dbname};
open(TT,">$this->{dbname}") or die "Could not create $this->{dbname}: $!\n";
close (TT);
}
sub get_single {
my($this, $num) = @_;
my($address, $note, $date, $n, $t, $buffer, );
my %data = $this->get_all();
return ($data{$num}->{note}, $data{$num}->{date});
}
sub get_all {
my $this = shift;
my($num, $note, $date, %res);
if ($this->unchanged) {
return %{$this->{cache}};
}
my %data = $this->_retrieve();
foreach my $num (keys %data) {
($res{$num}->{date}, $res{$num}->{note}) = $this->_pwsafe3tonote($data{$num}->{note});
}
$this->cache(%res);
return %res;
}
sub import_data {
my ($this, $data) = @_;
my $fh;
if (-s $this->{dbname}) {
$fh = new FileHandle "<$this->{dbname}" or die "could not open $this->{dbname}\n";
flock $fh, LOCK_EX;
}
my $key = $this->_getpass();
eval {
my $vault = new Crypt::PWSafe3(password => $key, file => $this->{dbname});
foreach my $num (keys %{$data}) {
my $checksum = $this->get_nextnum();
my %record = $this->_notetopwsafe3($checksum, $data->{$num}->{note}, $data->{$num}->{date});
my $rec = new Crypt::PWSafe3::Record();
$rec->uuid($record{uuid});
$vault->addrecord($rec);
$vault->modifyrecord($record{uuid}, %record);
}
$vault->save();
};
if ($@) {
print "Exception caught:\n$@\n";
exit 1;
}
eval {
flock $fh, LOCK_UN;
$fh->close();
};
$this->{keepkey} = 0;
$this->{key} = 0;
}
sub get_nextnum {
my $this = shift;
my($num, $te, $me, $buffer);
my $ug = new Data::UUID;
$this->{nextuuid} = unpack('H*', $ug->create());
$num = $this->_uuid( $this->{nextuuid} );
return $num;
}
sub get_search {
my($this, $searchstring) = @_;
my($buffer, $num, $note, $date, %res, $t, $n, $match);
my $regex = $this->generate_search($searchstring);
eval $regex;
if ($@) {
print "invalid expression: \"$searchstring\"!\n";
return;
}
$match = 0;
if ($this->unchanged) {
foreach my $num (keys %{$this->{cache}}) {
$_ = $this->{cache}{$num}->{note};
eval $regex;
if ($match) {
$res{$num}->{note} = $this->{cache}{$num}->{note};
$res{$num}->{date} = $this->{cache}{$num}->{date}
}
$match = 0;
}
return %res;
}
my %data = $this->get_all();
foreach my $num(sort keys %data) {
$_ = $data{$num}->{note};
eval $regex;
if($match)
{
$res{$num}->{note} = $data{$num}->{note};
$res{$num}->{date} = $data{$num}->{data};
}
$match = 0;
}
return %res;
}
sub set_edit {
my($this, $num, $note, $date) = @_;
my %data = $this->_retrieve();
my %record = $this->_notetopwsafe3($num, $note, $date);
if (exists $data{$num}) {
$data{$num}->{note} = \%record;
$this->_store(\%record);
}
else {
%record = $this->_store(\%record, 1);
}
$this->changed;
}
sub set_new {
my($this, $num, $note, $date) = @_;
$this->set_edit($num, $note, $date);
}
sub set_del {
my($this, $num) = @_;
my $uuid = $this->_getuuid($num);
if(! $uuid) {
print "Note $num does not exist!\n";
return;
}
my $fh = new FileHandle "<$this->{dbname}" or die "could not open $this->{dbname}\n";
flock $fh, LOCK_EX;
my $key = $this->_getpass();
eval {
my $vault = new Crypt::PWSafe3(password => $key, file => $this->{dbname});
delete $vault->{record}->{$uuid};
$vault->markmodified();
$vault->save();
};
if ($@) {
print "Exception caught:\n$@\n";
exit 1;
}
eval {
flock $fh, LOCK_UN;
$fh->close();
};
# finally re-read the db, so that we always have the latest data
$this->_retrieve($key);
$this->changed;
return;
}
sub set_recountnums {
my($this) = @_;
# unsupported
return;
}
sub _store {
my ($this, $record, $create) = @_;
my $fh;
if (-s $this->{dbname}) {
$fh = new FileHandle "<$this->{dbname}" or die "could not open $this->{dbname}\n";
flock $fh, LOCK_EX;
}
my $key;
my $prompt = "pwsafe password: ";
foreach my $try (1..5) {
if($try > 1) {
$prompt = "pwsafe password ($try retry): ";
}
$key = $this->_getpass($prompt);
eval {
my $vault = new Crypt::PWSafe3(password => $key, file => $this->{dbname});
if ($create) {
my $rec = new Crypt::PWSafe3::Record();
$rec->uuid($record->{uuid});
$vault->addrecord($rec);
$vault->modifyrecord($record->{uuid}, %{$record});
}
else {
$vault->modifyrecord($record->{uuid}, %{$record});
}
$vault->save();
};
if ($@) {
if($@ =~ /wrong pass/i) {
$key = '';
next;
}
else {
print "Exception caught:\n$@\n";
exit 1;
}
}
else {
last;
}
}
eval {
flock $fh, LOCK_UN;
$fh->close();
};
if(!$key) {
print STDERR "Giving up after 5 failed password attempts.\n";
exit 1;
}
# finally re-read the db, so that we always have the latest data
$this->_retrieve($key);
}
sub _retrieve {
my ($this, $key) = @_;
my $file = $this->{dbname};
if (-s $file) {
if ($this->filechanged() || $this->{unread}) {
my %data;
if (! $key) {
$key = $this->_getpass();
}
eval {
my $vault = new Crypt::PWSafe3(password => $key, file => $this->{dbname});
my @records = $vault->getrecords();
foreach my $record (sort { $a->ctime <=> $b->ctime } @records) {
my $num = $this->_uuid( $record->uuid );
my %entry = (
uuid => $record->uuid,
title => $record->title,
user => $record->user,
passwd => $record->passwd,
notes => $record->notes,
group => $record->group,
lastmod=> $record->lastmod,
ctime => $record->ctime,
);
$data{$num}->{note} = \%entry;
}
};
if ($@) {
print "Exception caught:\n$@\n";
exit 1;
}
$this->{unread} = 0;
$this->{data} = \%data;
return %data;
}
else {
return %{$this->{data}};
}
}
else {
return ();
}
}
sub _pwsafe3tonote {
#
# convert pwsafe3 record to note record
my ($this, $record) = @_;
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($record->{ctime});
my $date = sprintf("%02d.%02d.%04d %02d:%02d:%02d", $mday, $mon+1, $year+1900, $hour, $min, $sec);
chomp $date;
my $note;
if ($record->{group}) {
my $group = $record->{group};
# convert group separator
$group =~ s#\.#/#g;
$note = "/$group/\n";
}
# pwsafe3 uses windows newlines, so convert ours
$record->{notes} =~ s/\r\n/\n/gs;
#
# we do NOT add user and password fields here extra
# because if it is contained in the note, from were
# it was extracted initially, where it remains anyway
$note .= "$record->{title}\n$record->{notes}";
return ($date, $note);
}
sub _notetopwsafe3 {
#
# convert note record to pwsafe3 record
# only used on create or save
#
# this one is the critical part, because the two
# record types are fundamentally incompatible.
# we parse our record and try to guess the values
# required for pwsafe3
#
# expected input for note:
# /path/ -> group, optional
# any text -> title
# User: xxx -> user
# Password: xxx -> passwd
# anything else -> notes
#
# expected input for date:
# 23.02.2010 07:56:27
my ($this, $num, $text, $date) = @_;
my ($group, $title, $user, $passwd, $notes, $ts, $content);
if ($text =~ /^\//) {
($group, $title, $content) = split /\n/, $text, 3;
}
else {
($title, $content) = split /\n/, $text, 2;
}
if(!defined $content) { $content = ""; }
if(!defined $group) { $group = ""; }
$user = $passwd = '';
if ($content =~ /(user|username|login|account|benutzer):\s*(.+)/i) {
$user = $2;
}
if ($content =~ /(password|pass|passwd|kennwort|pw):\s*(.+)/i) {
$passwd = $2;
}
# 1 2 3 4 5 6
if ($date =~ /^(\d\d)\.(\d\d)\.(\d{4}) (\d\d):(\d\d):(\d\d)$/) {
# timelocal($sec,$min,$hour,$mday,$mon,$year);
$ts = timelocal($6, $5, $4, $1, $2-1, $3-1900);
}
# make our topics pwsafe3 compatible groups
$group =~ s#^/##;
$group =~ s#/$##;
$group =~ s#/#.#g;
# pwsafe3 uses windows newlines, so convert ours
$content =~ s/\n/\r\n/gs;
my %record = (
uuid => $this->_getuuid($num),
user => $user,
passwd => $passwd,
group => $group,
title => $title,
ctime => $ts,
lastmod=> $ts,
notes => $content,
);
return %record;
}
sub _uuid {
my ($this, $uuid) = @_;
if (exists $this->{uuidnum}->{$uuid}) {
return $this->{uuidnum}->{$uuid};
}
my $max = 0;
if (exists $this->{numuuid}) {
$max = (sort { $b <=> $a } keys %{$this->{numuuid}})[0];
}
my $num = $max + 1;
$this->{uuidnum}->{$uuid} = $num;
$this->{numuuid}->{$num} = $uuid;
return $num;
}
sub _getuuid {
my ($this, $num) = @_;
return $this->{numuuid}->{$num};
}
sub _getpass {
#
# We're doing this here ourselfes
# because the note way of handling encryption
# doesn't work with pwsafe3, we can't hold a cipher
# structure in memory, because pwsafe3 handles this
# itself.
# Instead we ask for the password everytime we want
# to fetch data from the actual file OR want to write
# to it. To minimize reads, we use caching by default.
my($this, $prompt) = @_;
if ($this->{key}) {
return $this->{key};
}
else {
my $key;
print STDERR $prompt ? $prompt : "pwsafe password: ";
eval {
local($|) = 1;
local(*TTY);
open(TTY,"/dev/tty") or die "No /dev/tty!";
system ("stty -echo </dev/tty") and die "stty failed!";
chomp($key = <TTY>);
print STDERR "\r\n";
system ("stty echo </dev/tty") and die "stty failed!";
close(TTY);
};
if ($@) {
$key = <>;
}
if ($this->{keepkey}) {
$this->{key} = $key;
}
return $key;
}
}
1; # keep this!
__END__
=head1 NAME
NOTEDB::pwsafe3 - module lib for accessing a notedb from perl
=head1 SYNOPSIS
# include the module
use NOTEDB;
# create a new NOTEDB object
$db = new NOTEDB("text", "/home/tom/.notedb", 4096, 24);
# decide to use encryption
# $key is the cipher to use for encryption
# $method must be either Crypt::IDEA or Crypt::DES
# you need Crypt::CBC, Crypt::IDEA and Crypt::DES to have installed.
$db->use_crypt($key,$method);
# do not use encryption
# this is the default
$db->no_crypt;
# get a single note
($note, $date) = $db->get_single(1);
# search for a certain note
%matching_notes = $db->get_search("somewhat");
# format of returned hash:
#$matching_notes{$numberofnote}->{'note' => 'something', 'date' => '23.12.2000 10:33:02'}
# get all existing notes
%all_notes = $db->get_all();
# format of returnes hash like the one from get_search above
# get the next noteid available
$next_num = $db->get_nextnum();
# modify a certain note
$db->set_edit(1, "any text", "23.12.2000 10:33:02");
# create a new note
$db->set_new(5, "any new text", "23.12.2000 10:33:02");
# delete a certain note
$db->set_del(5);
# turn on encryption. CryptMethod must be IDEA, DES or BLOWFISH
$db->use_crypt("passphrase", "CryptMethod");
# turn off encryption. This is the default.
$db->no_crypt();
=head1 DESCRIPTION
You can use this module for accessing a note database. This backend uses
a text file for storage and Config::General for accessing the file.
Currently, NOTEDB module is only used by note itself. But feel free to use it
within your own project! Perhaps someone want to implement a webinterface to
note...
=head1 USAGE
please see the section SYNOPSIS, it says it all.
=head1 AUTHOR
Thomas Linden <tom AT linden DOT at>
=cut

352
lib/NOTEDB/text.pm Normal file
View File

@@ -0,0 +1,352 @@
# Perl module for note
# text database backend. see docu: perldoc NOTEDB::text
# using Storable as backend.
package NOTEDB::text;
$NOTEDB::text::VERSION = "1.04";
use strict;
#use Data::Dumper;
use File::Spec;
use Storable qw(lock_nstore lock_retrieve);
use MIME::Base64;
use NOTEDB;
use Fcntl qw(LOCK_EX LOCK_UN);
use Exporter ();
use vars qw(@ISA @EXPORT);
@ISA = qw(NOTEDB Exporter);
sub new {
my($this, %param) = @_;
my $class = ref($this) || $this;
my $self = {};
bless($self,$class);
$self->{NOTEDB} = $self->{dbname} = $param{dbname} || File::Spec->catfile($ENV{HOME}, ".notedb");
if(! -e $param{dbname}) {
open(TT,">$param{dbname}") or die "Could not create $param{dbname}: $!\n";
close (TT);
}
elsif(! -w $param{dbname}) {
print "$param{dbname} is not writable!\n";
exit(1);
}
$self->{LOCKFILE} = $param{dbname} . "~LOCK";
$self->{mtime} = $self->get_stat();
$self->{unread} = 1;
$self->{data} = {};
return $self;
}
sub DESTROY
{
# clean the desk!
}
sub version {
my $this = shift;
return $NOTEDB::text::VERSION;
}
sub get_stat {
my ($this) = @_;
my $mtime = (stat($this->{dbname}))[9];
return $mtime;
}
sub set_del_all {
my $this = shift;
unlink $this->{NOTEDB};
open(TT,">$this->{NOTEDB}") or die "Could not create $this->{NOTEDB}: $!\n";
close (TT);
}
sub get_single {
my($this, $num) = @_;
my($address, $note, $date, $n, $t, $buffer, );
my %data = $this->get_all();
return ($data{$num}->{note}, $data{$num}->{date});
}
sub get_all {
my $this = shift;
my($num, $note, $date, %res);
if ($this->unchanged) {
return %{$this->{cache}};
}
my %data = $this->_retrieve();
foreach my $num (keys %data) {
$res{$num}->{note} = $this->ude($data{$num}->{note});
$res{$num}->{date} = $this->ude($data{$num}->{date});
}
$this->cache(%res);
return %res;
}
sub import_data {
my ($this, $data) = @_;
my %res = $this->_retrieve();
my $pos = (scalar keys %res) + 1;
foreach my $num (keys %{$data}) {
$res{$pos}->{note} = $this->uen($data->{$num}->{note});
$res{$pos}->{date} = $this->uen($data->{$num}->{date});
$pos++;
}
$this->_store(\%res);
}
sub get_nextnum {
my $this = shift;
my($num, $te, $me, $buffer);
if ($this->unchanged) {
my @numbers = sort { $a <=> $b } keys %{$this->{cache}};
$num = pop @numbers;
$num++;
return $num;
}
my %data = $this->get_all();
my @numbers = sort { $a <=> $b } keys %data;
$num = pop @numbers;
$num++;
return $num;
}
sub get_search {
my($this, $searchstring) = @_;
my($buffer, $num, $note, $date, %res, $t, $n, $match);
my $regex = $this->generate_search($searchstring);
eval $regex;
if ($@) {
print "invalid expression: \"$searchstring\"!\n";
return;
}
$match = 0;
if ($this->unchanged) {
foreach my $num (keys %{$this->{cache}}) {
$_ = $this->{cache}{$num}->{note};
eval $regex;
if ($match) {
$res{$num}->{note} = $this->{cache}{$num}->{note};
$res{$num}->{date} = $this->{cache}{$num}->{date}
}
$match = 0;
}
return %res;
}
my %data = $this->get_all();
foreach my $num(sort keys %data) {
$_ = $data{$num}->{note};
eval $regex;
if($match)
{
$res{$num}->{note} = $data{$num}->{note};
$res{$num}->{date} = $data{$num}->{data};
}
$match = 0;
}
return %res;
}
sub set_edit {
my($this, $num, $note, $date) = @_;
my %data = $this->_retrieve();
$data{$num} = {
note => $this->uen($note),
date => $this->uen($date)
};
$this->_store(\%data);
$this->changed;
}
sub set_new {
my($this, $num, $note, $date) = @_;
$this->set_edit($num, $note, $date);
}
sub set_del {
my($this, $num) = @_;
my(%data, $note, $date, $T, $setnum, $buffer, $n, $N, $t);
$setnum = 1;
%data = $this->_retrieve();
return "ERROR" if (! exists $data{$num});
delete $data{$num};
$this->_store(\%data);
$this->changed;
return;
}
sub set_recountnums {
# not required here
return;
}
sub uen {
my ($this, $raw) = @_;
my($crypted);
if($NOTEDB::crypt_supported == 1) {
eval {
$crypted = $this->{cipher}->encrypt($raw);
};
}
else {
$crypted = $raw;
}
my $coded = encode_base64($crypted);
return $coded;
}
sub ude {
my ($this, $crypted) = @_;
my($raw);
if($NOTEDB::crypt_supported == 1) {
eval {
$raw = $this->{cipher}->decrypt(decode_base64($crypted));
};
}
else {
$raw = decode_base64($crypted)
}
return $raw;
}
sub _store {
my ($this, $data) = @_;
lock_nstore($data, $this->{NOTEDB});
}
sub _retrieve {
my $this = shift;
if (-s $this->{NOTEDB}) {
if ($this->changed() || $this->{unread}) {
my $data = lock_retrieve($this->{NOTEDB});
$this->{unread} = 0;
$this->{data} = $data;
return %{$data};
}
}
else {
return ();
}
}
1; # keep this!
__END__
=head1 NAME
NOTEDB::text - module lib for accessing a notedb from perl
=head1 SYNOPSIS
# include the module
use NOTEDB;
# create a new NOTEDB object
$db = new NOTEDB("text", "/home/tom/.notedb", 4096, 24);
# decide to use encryption
# $key is the cipher to use for encryption
# $method must be either Crypt::IDEA or Crypt::DES
# you need Crypt::CBC, Crypt::IDEA and Crypt::DES to have installed.
$db->use_crypt($key,$method);
# do not use encryption
# this is the default
$db->no_crypt;
# get a single note
($note, $date) = $db->get_single(1);
# search for a certain note
%matching_notes = $db->get_search("somewhat");
# format of returned hash:
#$matching_notes{$numberofnote}->{'note' => 'something', 'date' => '23.12.2000 10:33:02'}
# get all existing notes
%all_notes = $db->get_all();
# format of returnes hash like the one from get_search above
# get the next noteid available
$next_num = $db->get_nextnum();
# modify a certain note
$db->set_edit(1, "any text", "23.12.2000 10:33:02");
# create a new note
$db->set_new(5, "any new text", "23.12.2000 10:33:02");
# delete a certain note
$db->set_del(5);
# turn on encryption. CryptMethod must be IDEA, DES or BLOWFISH
$db->use_crypt("passphrase", "CryptMethod");
# turn off encryption. This is the default.
$db->no_crypt();
=head1 DESCRIPTION
You can use this module for accessing a note database. This backend uses
a text file for storage and Storable for accessing the file.
Currently, NOTEDB module is only used by note itself. But feel free to use it
within your own project! Perhaps someone want to implement a webinterface to
note...
=head1 USAGE
please see the section SYNOPSIS, it says it all.
=head1 AUTHOR
Thomas Linden <tom@daemon.de>.
=cut