# # this is a generic module, used by note database # backend modules. # # $Id: NOTEDB.pm,v 1.2 2000/08/11 00:05:58 zarahg Exp $ # # Copyright (c) 2000 Thomas Linden 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) = @_; my($cipher); if($NOTEDB::crypt_supported == 1) { eval { $cipher = new Crypt::CBC($key, $method); }; if($@) { $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; } 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 »and« and »or« $string =~ s/\s\s*(AND|OR)\s\s*/ $1 /g; # remove odd spaces infront of »(« and after »)« $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 »and« and »or« $string =~ s/(?check_or($1, $case) /ge; # remove slashes on »and« and »or« $string =~ s/\/(and|or)\/$case/$1/g; # remove spaces inside /string/ constructs $string =~ s/(? '.*', '?' => '.', '[' => '[', ']' => ']', '+' => '\+', '.' => '\.', '$' => '\$', '@' => '\@', '/' => '\/', '|' => '\|', '}' => '\}', '{' => '\{', ); 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; } 1;