use
vars
qw(@ISA @EXPORT $crypt_supported)
;
$NOTEDB::VERSION
=
"1.45"
;
BEGIN {
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 {
my
$this
=
shift
;
$this
->{use_cache} = 1;
$this
->{changed} = 1;
}
sub
cache {
my
$this
=
shift
;
if
(
$this
->{use_cache}) {
my
%res
=
@_
;
%{
$this
->{cache}} =
%res
;
}
}
sub
unchanged {
my
$this
=
shift
;
return
0
if
(!
$this
->{use_cache});
if
(
$this
->{changed}) {
$this
->{changed} = 0;
return
0;
}
else
{
print
"%\n"
;
return
1;
}
}
sub
changed {
my
$this
=
shift
;
$this
->{changed} = 1;
return
1;
}
sub
generate_search {
my
(
$this
,
$string
) =
@_
;
my
$case
=
"i"
;
if
(
$string
=~ /^\/.+?\/$/) {
return
$string
;
}
elsif
(!
$string
) {
return
"/^/"
;
}
$string
=
" "
.
$string
.
" "
;
$string
=~ s/(?<=\s)(\(??)(
"[^"
]+"|\S+)(\)??)(?=\s)/$1 .
$this
->check_exact($2) . $3/ge;
$string
=~ s/\s\s*(AND|OR)\s\s*/ $1 /g;
$string
=~ s/(\s*\()/\(/g;
$string
=~ s/(\)\s*)/\)/g;
$string
=~ s/^\s//;
$string
=~ s/\s$//;
$string
=~ s/(?<!AND)(?<!OR)(\s+?)(?!AND|OR)/
'\s'
x
length
($1)/ge;
$string
=
" "
.
$string
;
$string
=~ s/(\s??OR\s??|\s??AND\s??)/\L$1\E/g;
$string
=~ s/(?<!\\)(\)|\()/ $1 /g;
$string
=~ s/(?<=\s)(\S+)/
$this
->check_or($1,
$case
) /ge;
$string
=~ s/\/(and|or)\/
$case
/$1/g;
$string
=~ s/(?<!and)(?<!or)\s*\//\//g;
$string
=~ s/\/\s*(?!and|or)/\//g;
return
qq(\$match = 1 if($string)
;);
}
sub
check_or {
my
(
$this
,
$str
,
$case
) =
@_
;
if
(
$str
=~ /^\s*(or|and)\s*$/) {
return
" $str "
;
}
elsif
(
$str
=~ /(?<!\\)[)(]/) {
return
$str
;
}
else
{
return
" \/$str\/$case "
;
}
}
sub
check_exact {
my
(
$this
,
$str
) =
@_
;
my
%wildcards
= (
'*'
=>
'.*'
,
'?'
=>
'.'
,
'['
=>
'['
,
']'
=>
']'
,
'+'
=>
'\+'
,
'.'
=>
'\.'
,
'$'
=>
'\$'
,
'@'
=>
'\@'
,
'/'
=>
'\/'
,
'|'
=>
'\|'
,
'}'
=>
'\}'
,
'{'
=>
'\{'
,
);
my
%escapes
= (
'*'
=>
'\*'
,
'?'
=>
'\?'
,
'['
=>
'['
,
']'
=>
']'
,
'+'
=>
'\+'
,
'.'
=>
'\.'
,
'$'
=>
'\$'
,
'@'
=>
'\@'
,
'('
=>
'\('
,
')'
=>
'\)'
,
'/'
=>
'\/'
,
'|'
=>
'\|'
,
'}'
=>
'\}'
,
'{'
=>
'\{'
,
);
$str
=~ s/\\/\\\\/g;
if
(
$str
=~ /^
"/ && $str =~ /"
$/) {
$str
=~ s/(.)/
$escapes
{$1} ||
"$1"
/ge;
}
else
{
$str
=~ s/(.)/
$wildcards
{$1} ||
"$1"
/ge;
}
$str
=~ s/^"//;
$str
=~ s/"$//;
$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;