ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/lib/cf.pm
(Generate patch)

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.435 by root, Thu May 29 03:33:20 2008 UTC vs.
Revision 1.443 by root, Sun Aug 31 10:05:26 2008 UTC

… …
19# The authors can be reached via e-mail to <support@deliantra.net> 19# The authors can be reached via e-mail to <support@deliantra.net>
20# 20#
21 21
22package cf; 22package cf;
23 23
24use 5.10.0;
24use utf8; 25use utf8;
25use strict; 26use strict "vars", "subs";
26 27
27use Symbol; 28use Symbol;
28use List::Util; 29use List::Util;
29use Socket; 30use Socket;
30use EV; 31use EV;
… …
34use Storable (); 35use Storable ();
35 36
36use Coro (); 37use Coro ();
37use Coro::State; 38use Coro::State;
38use Coro::Handle; 39use Coro::Handle;
40use Coro::EV;
39use Coro::AnyEvent; 41use Coro::AnyEvent;
40use Coro::Timer; 42use Coro::Timer;
41use Coro::Signal; 43use Coro::Signal;
42use Coro::Semaphore; 44use Coro::Semaphore;
43use Coro::AnyEvent; 45use Coro::AnyEvent;
44use Coro::AIO; 46use Coro::AIO;
45use Coro::BDB; 47use Coro::BDB 1.6;
46use Coro::Storable; 48use Coro::Storable;
47use Coro::Util (); 49use Coro::Util ();
48 50
49use JSON::XS 2.01 (); 51use JSON::XS 2.01 ();
50use BDB (); 52use BDB ();
… …
243for my $pkg (qw( 245for my $pkg (qw(
244 cf::global cf::attachable 246 cf::global cf::attachable
245 cf::object cf::object::player 247 cf::object cf::object::player
246 cf::client cf::player 248 cf::client cf::player
247 cf::arch cf::living 249 cf::arch cf::living
250 cf::map cf::mapspace
248 cf::map cf::party cf::region 251 cf::party cf::region
249)) { 252)) {
250 no strict 'refs';
251 @{"safe::$pkg\::wrap::ISA"} = @{"$pkg\::wrap::ISA"} = $pkg; 253 @{"safe::$pkg\::wrap::ISA"} = @{"$pkg\::wrap::ISA"} = $pkg;
252} 254}
253 255
254$EV::DIED = sub { 256$EV::DIED = sub {
255 warn "error in event callback: @_"; 257 warn "error in event callback: @_";
… …
1086 1088
1087sub reattach { 1089sub reattach {
1088 # basically do the same as instantiate, without calling instantiate 1090 # basically do the same as instantiate, without calling instantiate
1089 my ($obj) = @_; 1091 my ($obj) = @_;
1090 1092
1093 # no longer needed after getting rid of delete_package?
1091 bless $obj, ref $obj; # re-bless in case extensions have been reloaded 1094 #bless $obj, ref $obj; # re-bless in case extensions have been reloaded
1092 1095
1093 my $registry = $obj->registry; 1096 my $registry = $obj->registry;
1094 1097
1095 @$registry = (); 1098 @$registry = ();
1096 1099
… …
1332 1335
1333 $ext{meta} = { map { (split /=/, $_, 2)[0, 1] } split /\s+/, $1 } 1336 $ext{meta} = { map { (split /=/, $_, 2)[0, 1] } split /\s+/, $1 }
1334 if $source =~ /\A#!.*?perl.*?#\s*(.*)$/m; 1337 if $source =~ /\A#!.*?perl.*?#\s*(.*)$/m;
1335 1338
1336 $ext{source} = 1339 $ext{source} =
1337 "package $pkg; use strict; use utf8;\n" 1340 "package $pkg; use 5.10.0; use strict 'vars', 'subs'; use utf8;\n"
1338 . "#line 1 \"$path\"\n{\n" 1341 . "#line 1 \"$path\"\n{\n"
1339 . $source 1342 . $source
1340 . "\n};\n1"; 1343 . "\n};\n1";
1341 1344
1342 $todo{$base} = \%ext; 1345 $todo{$base} = \%ext;
… …
1520 my ($pl) = @_; 1523 my ($pl) = @_;
1521 1524
1522 my $name = $pl->ob->name; 1525 my $name = $pl->ob->name;
1523 1526
1524 $pl->{deny_save} = 1; 1527 $pl->{deny_save} = 1;
1525 $pl->password ("*"); # this should lock out the player until we nuked the dir 1528 $pl->password ("*"); # this should lock out the player until we have nuked the dir
1526 1529
1527 $pl->invoke (cf::EVENT_PLAYER_LOGOUT, 1) if $pl->active; 1530 $pl->invoke (cf::EVENT_PLAYER_LOGOUT, 1) if $pl->active;
1528 $pl->deactivate; 1531 $pl->deactivate;
1529 my $killer = cf::arch::get "killer_quit"; $pl->killer ($killer); $killer->destroy; 1532 my $killer = cf::arch::get "killer_quit"; $pl->killer ($killer); $killer->destroy;
1530 $pl->ob->check_score; 1533 $pl->ob->check_score;
… …
1622 1625
1623Expand crossfire pod fragments into protocol xml. 1626Expand crossfire pod fragments into protocol xml.
1624 1627
1625=cut 1628=cut
1626 1629
1627use re 'eval';
1628
1629my $group;
1630my $interior; $interior = qr{
1631 # match a pod interior sequence sans C<< >>
1632 (?:
1633 \ (.*?)\ (?{ $group = $^N })
1634 | < (??{$interior}) >
1635 )
1636}x;
1637
1638sub expand_cfpod { 1630sub expand_cfpod {
1639 my ($self, $pod) = @_; 1631 my ($self, $pod) = @_;
1640 1632
1633 my @nest = [qr<\G$>, undef, ""];
1641 my $xml; 1634 my $xml;
1642 1635
1636 for ($pod) {
1643 while () { 1637 while () {
1644 if ($pod =~ /\G( (?: [^BCGHITU]+ | .(?!<) )+ )/xgcs) { 1638 if (/\G( (?: [^BCEGHITUZ&>\n\ ]+ | [BCEGHITUZ](?!<) | \ (?!>) )+ )/xgcs) {
1645 $group = $1;
1646
1647 $group =~ s/&/&amp;/g;
1648 $group =~ s/</&lt;/g;
1649
1650 $xml .= $group; 1639 $xml .= $1;
1651 } elsif ($pod =~ m%\G 1640 } elsif (/\G\n(?=\S)/xgcs) {
1652 ([BCGHITU]) 1641 $xml .= " ";
1653 < 1642 } elsif (/\G\n/xgcs) {
1654 (?: 1643 $xml .= "\n";
1655 ([^<>]*) (?{ $group = $^N }) 1644 } elsif (/\G ([BCEGHITUZ]) (< (?: <+\ | (?!<) ) )/xgcs) {
1656 | < $interior > 1645 my ($code, $delim) = ($1, scalar reverse $2);
1657 ) 1646 $delim =~ y/</>/; # delim now contains the stop sequence
1658 > 1647 $delim = qr{\G\Q$delim};
1659 %gcsx
1660 ) {
1661 my ($code, $data) = ($1, $group);
1662 1648
1649 my $cb;
1650
1663 if ($code eq "B") { 1651 if ($code eq "B") {
1664 $xml .= "<b>" . expand_cfpod ($self, $data) . "</b>"; 1652 $cb = sub { "<b>$_[0]</b>" };
1665 } elsif ($code eq "I") {
1666 $xml .= "<i>" . expand_cfpod ($self, $data) . "</i>";
1667 } elsif ($code eq "U") {
1668 $xml .= "<u>" . expand_cfpod ($self, $data) . "</u>";
1669 } elsif ($code eq "C") { 1653 } elsif ($code eq "C") {
1670 $xml .= "<tt>" . expand_cfpod ($self, $data) . "</tt>"; 1654 $cb = sub { "<tt>$_[0]</tt>" };
1671 } elsif ($code eq "T") { 1655 } elsif ($code eq "E") {
1672 $xml .= "<big><b>" . expand_cfpod ($self, $data) . "</b></big>"; 1656 $cb = sub { warn "E<$_[0]>\n";"&$_[0];" };
1673 } elsif ($code eq "G") { 1657 } elsif ($code eq "G") {
1658 $cb = sub {
1674 my ($male, $female) = split /\|/, $data; 1659 my ($male, $female) = split /\|/, $_[0];
1675 $data = $self->gender ? $female : $male; 1660 $self->gender ? $female : $male
1676 $xml .= expand_cfpod ($self, $data); 1661 };
1677 } elsif ($code eq "H") { 1662 } elsif ($code eq "H") {
1678 $xml .= ("<fg name=\"lightblue\">[" . expand_cfpod ($self, $data) . " (Use hintmode to suppress hints)]</fg>", 1663 $cb = sub {
1664 (
1665 "<fg name=\"lightblue\">[$_[0] (Use hintmode to suppress hints)]</fg>",
1679 "<fg name=\"lightblue\">[Hint suppressed, see hintmode]</fg>", 1666 "<fg name=\"lightblue\">[Hint suppressed, see hintmode]</fg>",
1680 "") 1667 "",
1681 [$self->{hintmode}]; 1668 )[$self->{hintmode}];
1669 };
1670 } elsif ($code eq "I") {
1671 $cb = sub { "<i>$_[0]</i>" };
1672 } elsif ($code eq "T") {
1673 $cb = sub { "<big><b>$_[0]</b></big>" };
1674 } elsif ($code eq "U") {
1675 $cb = sub { "<u>$_[0]</u>" };
1676 } elsif ($code eq "Z") {
1677 $cb = sub { };
1678 } else {
1679 die "FATAL error in expand_cfpod";
1680 }
1681
1682 push @nest, [$delim, $cb, $xml];
1683 undef $xml;
1684
1685 } elsif ($_ =~ /$nest[-1][0]/gcs) {
1686 my $nest = pop @nest;
1687
1688 if ($nest->[1]) {
1689 $xml = $nest->[2] . $nest->[1]->($xml);
1690 } else {
1691 last;
1692 }
1693 } elsif (/\G</xgcs) {
1694 $xml .= "&lt;";
1695 } elsif (/\G&/xgcs) {
1696 $xml .= "&amp;";
1697 } elsif (/\G>/xgcs) {
1698 $xml .= ">";
1682 } else { 1699 } else {
1683 $xml .= "error processing '$code($data)' directive"; 1700 if ($pod =~ /\G(.+)/xgcs) {
1701 warn "parse error (at $1)($nest[-1][0]) while expanding cfpod:\n$pod";
1702 last;
1703 } else {
1704 warn "parse error (unclosed interior sequence at end of cfpod) while expanding cfpod:\n$pod";
1705 return "<b>Sorry, the server encountered an internal error when formatting this message, please report this.</b>";
1706 }
1684 } 1707 }
1685 } else {
1686 if ($pod =~ /\G(.+)/) {
1687 warn "parse error while expanding $pod (at $1)";
1688 } 1708 }
1689 last;
1690 }
1691 }
1692
1693 for ($xml) {
1694 # create single paragraphs (very hackish)
1695 s/(?<=\S)\n(?=\w)/ /g;
1696
1697 # compress some whitespace
1698 s/\s+\n/\n/g; # ws line-ends
1699 s/\n\n+/\n/g; # double lines
1700 s/^\n+//; # beginning lines
1701 s/\n+$//; # ending lines
1702 } 1709 }
1703 1710
1704 $xml 1711 $xml
1705} 1712}
1706
1707no re 'eval';
1708 1713
1709sub hintmode { 1714sub hintmode {
1710 $_[0]{hintmode} = $_[1] if @_ > 1; 1715 $_[0]{hintmode} = $_[1] if @_ > 1;
1711 $_[0]{hintmode} 1716 $_[0]{hintmode}
1712} 1717}
… …
2086 my $f = new_from_file cf::object::thawer $self->{load_path}; 2091 my $f = new_from_file cf::object::thawer $self->{load_path};
2087 $f->skip_block; 2092 $f->skip_block;
2088 $self->_load_objects ($f) 2093 $self->_load_objects ($f)
2089 or return; 2094 or return;
2090 2095
2091 $self->set_object_flag (cf::FLAG_OBJ_ORIGINAL, 1) 2096 $self->post_load_original
2092 if delete $self->{load_original}; 2097 if delete $self->{load_original};
2093 2098
2094 if (my $uniq = $self->uniq_path) { 2099 if (my $uniq = $self->uniq_path) {
2095 utf8::encode $uniq; 2100 utf8::encode $uniq;
2096 unless (aio_stat $uniq) { 2101 unless (aio_stat $uniq) {
… …
2613Moves the player to the given map-path and coordinates by first freezing 2618Moves the player to the given map-path and coordinates by first freezing
2614her, loading and preparing them map, calling the provided $check callback 2619her, loading and preparing them map, calling the provided $check callback
2615that has to return the map if sucecssful, and then unfreezes the player on 2620that has to return the map if sucecssful, and then unfreezes the player on
2616the new (success) or old (failed) map position. In either case, $done will 2621the new (success) or old (failed) map position. In either case, $done will
2617be called at the end of this process. 2622be called at the end of this process.
2623
2624Note that $check will be called with a potentially non-loaded map, so if
2625it needs a loaded map it has to call C<< ->load >>.
2618 2626
2619=cut 2627=cut
2620 2628
2621our $GOTOGEN; 2629our $GOTOGEN;
2622 2630
… …
2899 if ($self->can_msg) { 2907 if ($self->can_msg) {
2900 # default colour, mask it out 2908 # default colour, mask it out
2901 $color &= ~(cf::NDI_COLOR_MASK | cf::NDI_DEF) 2909 $color &= ~(cf::NDI_COLOR_MASK | cf::NDI_DEF)
2902 if $color & cf::NDI_DEF; 2910 if $color & cf::NDI_DEF;
2903 2911
2904 $self->send_packet ("msg " . $self->{json_coder}->encode ( 2912 my $pkt = "msg "
2913 . $self->{json_coder}->encode (
2905 [$color & cf::NDI_CLIENT_MASK, $channel, $msg, @extra])); 2914 [$color & cf::NDI_CLIENT_MASK, $channel, $msg, @extra]
2915 );
2916
2917 # try lzf for large packets
2918 $pkt = "lzf " . Compress::LZF::compress $pkt
2919 if 1024 <= length $pkt and $self->{can_lzf};
2920
2921 # split very large packets
2922 if (8192 < length $pkt and $self->{can_lzf}) {
2923 $self->send_packet ("frag $_") for unpack "(a8192)*", $pkt;
2924 $pkt = "frag";
2925 }
2926
2927 $self->send_packet ($pkt);
2906 } else { 2928 } else {
2907 if ($color >= 0) { 2929 if ($color >= 0) {
2908 # replace some tags by gcfclient-compatible ones 2930 # replace some tags by gcfclient-compatible ones
2909 for ($msg) { 2931 for ($msg) {
2910 1 while 2932 1 while
… …
3125=cut 3147=cut
3126 3148
3127for ( 3149for (
3128 ["cf::object" => qw(contr pay_amount pay_player map force_find force_add x y 3150 ["cf::object" => qw(contr pay_amount pay_player map force_find force_add x y
3129 insert remove inv nrof name archname title slaying race 3151 insert remove inv nrof name archname title slaying race
3130 decrease split destroy)], 3152 decrease split destroy change_exp)],
3131 ["cf::object::player" => qw(player)], 3153 ["cf::object::player" => qw(player)],
3132 ["cf::player" => qw(peaceful)], 3154 ["cf::player" => qw(peaceful)],
3133 ["cf::map" => qw(trigger)], 3155 ["cf::map" => qw(trigger)],
3134) { 3156) {
3135 no strict 'refs'; 3157 no strict 'refs';
… …
3583 3605
3584 warn Carp::longmess "post_cleanup backtrace" 3606 warn Carp::longmess "post_cleanup backtrace"
3585 if $make_core; 3607 if $make_core;
3586} 3608}
3587 3609
3610# a safer delete_package, copied from Symbol
3611sub clear_package($) {
3612 my $pkg = shift;
3613
3614 # expand to full symbol table name if needed
3615 unless ($pkg =~ /^main::.*::$/) {
3616 $pkg = "main$pkg" if $pkg =~ /^::/;
3617 $pkg = "main::$pkg" unless $pkg =~ /^main::/;
3618 $pkg .= '::' unless $pkg =~ /::$/;
3619 }
3620
3621 my($stem, $leaf) = $pkg =~ m/(.*::)(\w+::)$/;
3622 my $stem_symtab = *{$stem}{HASH};
3623
3624 defined $stem_symtab and exists $stem_symtab->{$leaf}
3625 or return;
3626
3627 # clear all symbols
3628 my $leaf_symtab = *{$stem_symtab->{$leaf}}{HASH};
3629 for my $name (keys %$leaf_symtab) {
3630 _gv_clear *{"$pkg$name"};
3631# use PApp::Util; PApp::Util::sv_dump *{"$pkg$name"};
3632 }
3633 warn "cleared package #$pkg\n";#d#
3634}
3635
3636our $RELOAD; # how many times to reload
3637
3588sub do_reload_perl() { 3638sub do_reload_perl() {
3589 # can/must only be called in main 3639 # can/must only be called in main
3590 if ($Coro::current != $Coro::main) { 3640 if ($Coro::current != $Coro::main) {
3591 warn "can only reload from main coroutine"; 3641 warn "can only reload from main coroutine";
3592 return; 3642 return;
3593 } 3643 }
3594 3644
3645 return if $RELOAD++;
3646
3647 while ($RELOAD) {
3595 warn "reloading..."; 3648 warn "reloading...";
3596 3649
3597 warn "entering sync_job"; 3650 warn "entering sync_job";
3598 3651
3599 cf::sync_job { 3652 cf::sync_job {
3600 cf::write_runtime_sync; # external watchdog should not bark 3653 cf::write_runtime_sync; # external watchdog should not bark
3601 cf::emergency_save; 3654 cf::emergency_save;
3602 cf::write_runtime_sync; # external watchdog should not bark 3655 cf::write_runtime_sync; # external watchdog should not bark
3603 3656
3604 warn "syncing database to disk"; 3657 warn "syncing database to disk";
3605 BDB::db_env_txn_checkpoint $DB_ENV; 3658 BDB::db_env_txn_checkpoint $DB_ENV;
3606 3659
3607 # if anything goes wrong in here, we should simply crash as we already saved 3660 # if anything goes wrong in here, we should simply crash as we already saved
3608 3661
3609 warn "flushing outstanding aio requests"; 3662 warn "flushing outstanding aio requests";
3610 for (;;) {
3611 BDB::flush;
3612 IO::AIO::flush;
3613 Coro::cede_notself;
3614 last unless IO::AIO::nreqs || BDB::nreqs; 3663 while (IO::AIO::nreqs || BDB::nreqs) {
3615 warn "iterate..."; 3664 Coro::EV::timer_once 0.01; # let the sync_job do it's thing
3616 }
3617
3618 ++$RELOAD;
3619
3620 warn "cancelling all extension coros";
3621 $_->cancel for values %EXT_CORO;
3622 %EXT_CORO = ();
3623
3624 warn "removing commands";
3625 %COMMAND = ();
3626
3627 warn "removing ext/exti commands";
3628 %EXTCMD = ();
3629 %EXTICMD = ();
3630
3631 warn "unloading/nuking all extensions";
3632 for my $pkg (@EXTS) {
3633 warn "... unloading $pkg";
3634
3635 if (my $cb = $pkg->can ("unload")) {
3636 eval {
3637 $cb->($pkg);
3638 1
3639 } or warn "$pkg unloaded, but with errors: $@";
3640 } 3665 }
3641 3666
3642 warn "... nuking $pkg"; 3667 warn "cancelling all extension coros";
3643 Symbol::delete_package $pkg; 3668 $_->cancel for values %EXT_CORO;
3644 } 3669 %EXT_CORO = ();
3645 3670
3646 warn "unloading all perl modules loaded from $LIBDIR"; 3671 warn "removing commands";
3647 while (my ($k, $v) = each %INC) { 3672 %COMMAND = ();
3648 next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/;
3649 3673
3674 warn "removing ext/exti commands";
3675 %EXTCMD = ();
3676 %EXTICMD = ();
3677
3678 warn "unloading/nuking all extensions";
3679 for my $pkg (@EXTS) {
3650 warn "... unloading $k"; 3680 warn "... unloading $pkg";
3651 delete $INC{$k};
3652 3681
3653 $k =~ s/\.pm$//;
3654 $k =~ s/\//::/g;
3655
3656 if (my $cb = $k->can ("unload_module")) { 3682 if (my $cb = $pkg->can ("unload")) {
3683 eval {
3657 $cb->(); 3684 $cb->($pkg);
3685 1
3686 } or warn "$pkg unloaded, but with errors: $@";
3687 }
3688
3689 warn "... clearing $pkg";
3690 clear_package $pkg;
3658 } 3691 }
3659 3692
3660 Symbol::delete_package $k; 3693 warn "unloading all perl modules loaded from $LIBDIR";
3694 while (my ($k, $v) = each %INC) {
3695 next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/;
3696
3697 warn "... unloading $k";
3698 delete $INC{$k};
3699
3700 $k =~ s/\.pm$//;
3701 $k =~ s/\//::/g;
3702
3703 if (my $cb = $k->can ("unload_module")) {
3704 $cb->();
3705 }
3706
3707 clear_package $k;
3661 } 3708 }
3662 3709
3663 warn "getting rid of safe::, as good as possible"; 3710 warn "getting rid of safe::, as good as possible";
3664 Symbol::delete_package "safe::$_" 3711 clear_package "safe::$_"
3665 for qw(cf::attachable cf::object cf::object::player cf::client cf::player cf::map cf::party cf::region); 3712 for qw(cf::attachable cf::object cf::object::player cf::client cf::player cf::map cf::party cf::region);
3666 3713
3667 warn "unloading cf.pm \"a bit\""; 3714 warn "unloading cf.pm \"a bit\"";
3668 delete $INC{"cf.pm"}; 3715 delete $INC{"cf.pm"};
3669 delete $INC{"cf/pod.pm"}; 3716 delete $INC{"cf/pod.pm"};
3670 3717
3671 # don't, removes xs symbols, too, 3718 # don't, removes xs symbols, too,
3672 # and global variables created in xs 3719 # and global variables created in xs
3673 #Symbol::delete_package __PACKAGE__; 3720 #clear_package __PACKAGE__;
3674 3721
3675 warn "unload completed, starting to reload now"; 3722 warn "unload completed, starting to reload now";
3676 3723
3677 warn "reloading cf.pm"; 3724 warn "reloading cf.pm";
3678 require cf; 3725 require cf;
3679 cf::_connect_to_perl; # nominally unnecessary, but cannot hurt 3726 cf::_connect_to_perl; # nominally unnecessary, but cannot hurt
3680 3727
3681 warn "loading config and database again"; 3728 warn "loading config and database again";
3682 cf::reload_config; 3729 cf::reload_config;
3683 3730
3684 warn "loading extensions"; 3731 warn "loading extensions";
3685 cf::load_extensions; 3732 cf::load_extensions;
3686 3733
3687 warn "reattaching attachments to objects/players"; 3734 warn "reattaching attachments to objects/players";
3688 _global_reattach; # objects, sockets 3735 _global_reattach; # objects, sockets
3689 warn "reattaching attachments to maps"; 3736 warn "reattaching attachments to maps";
3690 reattach $_ for values %MAP; 3737 reattach $_ for values %MAP;
3691 warn "reattaching attachments to players"; 3738 warn "reattaching attachments to players";
3692 reattach $_ for values %PLAYER; 3739 reattach $_ for values %PLAYER;
3693 3740
3694 warn "leaving sync_job"; 3741 warn "leaving sync_job";
3695 3742
3696 1 3743 1
3697 } or do { 3744 } or do {
3698 warn $@; 3745 warn $@;
3699 cf::cleanup "error while reloading, exiting."; 3746 cf::cleanup "error while reloading, exiting.";
3700 }; 3747 };
3701 3748
3702 warn "reloaded"; 3749 warn "reloaded";
3750 --$RELOAD;
3751 }
3703}; 3752};
3704 3753
3705our $RELOAD_WATCHER; # used only during reload 3754our $RELOAD_WATCHER; # used only during reload
3706 3755
3707sub reload_perl() { 3756sub reload_perl() {
… …
3793 BDB::max_poll_reqs $TICK * 0.1; 3842 BDB::max_poll_reqs $TICK * 0.1;
3794 $AnyEvent::BDB::WATCHER->priority (1); 3843 $AnyEvent::BDB::WATCHER->priority (1);
3795 3844
3796 unless ($DB_ENV) { 3845 unless ($DB_ENV) {
3797 $DB_ENV = BDB::db_env_create; 3846 $DB_ENV = BDB::db_env_create;
3798 $DB_ENV->set_flags (BDB::AUTO_COMMIT | BDB::REGION_INIT | BDB::TXN_NOSYNC 3847 $DB_ENV->set_flags (BDB::AUTO_COMMIT | BDB::REGION_INIT);
3799 | BDB::LOG_AUTOREMOVE, 1); 3848 $DB_ENV->set_flags (&BDB::LOG_AUTOREMOVE ) if BDB::VERSION v0, v4.7;
3849 $DB_ENV->log_set_config (&BDB::LOG_AUTO_REMOVE) if BDB::VERSION v4.7;
3800 $DB_ENV->set_timeout (30, BDB::SET_TXN_TIMEOUT); 3850 $DB_ENV->set_timeout (30, BDB::SET_TXN_TIMEOUT);
3801 $DB_ENV->set_timeout (30, BDB::SET_LOCK_TIMEOUT); 3851 $DB_ENV->set_timeout (30, BDB::SET_LOCK_TIMEOUT);
3802 3852
3803 cf::sync_job { 3853 cf::sync_job {
3804 eval { 3854 eval {

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines