note/NOTEDB.pm

#
# this is a generic module, used by note database
# backend modules.
#
# $Id$
#
# Copyright (c) 2000 Thomas Linden <tom@daemon.de>


package NOTEDB;

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) = @_;
	if($NOTEDB::crypt_supported == 1) {
		eval {
			$cipher = new Crypt::CBC($key, $method);
		};
		if($@) {
                        $NOTEDB::crypt_supported == 0;
                }
	}
	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;
}


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;

    return qq(\$match = 1 if($string););
}

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 %globs = (
	       '*' => '.*',
	       '?' => '.',
	       '[' => '[',
	       ']' => ']',
	       '+' => '\+',
	       '.' => '\.',
	       '$' => '\$',
	       '@' => '\@',
	      );

  # mask backslash
  $str =~ s/\\/\\\\/g;

  if ($str =~ /^"/ && $str =~ /"$/) {
    # mask bracket-constructs
    $str =~ s/(\(|\))/\\$1/g;
  }
  $str =~ s/(.)/$globs{$1} || "$1"/ge;

  $str =~ s/^"//;
  $str =~ s/"$//;

  # mask spaces
  $str =~ s/\s/\\s/g;
  return $str;
}




1;