| … | |
… | |
| 547 | reset_signals; |
547 | reset_signals; |
| 548 | &$cb |
548 | &$cb |
| 549 | }, @args; |
549 | }, @args; |
| 550 | |
550 | |
| 551 | wantarray ? @res : $res[-1] |
551 | wantarray ? @res : $res[-1] |
|
|
552 | } |
|
|
553 | |
|
|
554 | =item $coin = coin_from_name $name |
|
|
555 | |
|
|
556 | =cut |
|
|
557 | |
|
|
558 | our %coin_alias = ( |
|
|
559 | "silver" => "silvercoin", |
|
|
560 | "silvercoin" => "silvercoin", |
|
|
561 | "silvercoins" => "silvercoin", |
|
|
562 | "gold" => "goldcoin", |
|
|
563 | "goldcoin" => "goldcoin", |
|
|
564 | "goldcoins" => "goldcoin", |
|
|
565 | "platinum" => "platinacoin", |
|
|
566 | "platinumcoin" => "platinacoin", |
|
|
567 | "platinumcoins" => "platinacoin", |
|
|
568 | "platina" => "platinacoin", |
|
|
569 | "platinacoin" => "platinacoin", |
|
|
570 | "platinacoins" => "platinacoin", |
|
|
571 | "royalty" => "royalty", |
|
|
572 | "royalties" => "royalty", |
|
|
573 | ); |
|
|
574 | |
|
|
575 | sub coin_from_name($) { |
|
|
576 | $coin_alias{$_[0]} |
|
|
577 | ? cf::arch::find $coin_alias{$_[0]} |
|
|
578 | : undef |
| 552 | } |
579 | } |
| 553 | |
580 | |
| 554 | =item $value = cf::db_get $family => $key |
581 | =item $value = cf::db_get $family => $key |
| 555 | |
582 | |
| 556 | Returns a single value from the environment database. |
583 | Returns a single value from the environment database. |
| … | |
… | |
| 2349 | ? normalise $_ |
2376 | ? normalise $_ |
| 2350 | : () |
2377 | : () |
| 2351 | } @{ aio_readdir $UNIQUEDIR or [] } |
2378 | } @{ aio_readdir $UNIQUEDIR or [] } |
| 2352 | ] |
2379 | ] |
| 2353 | } |
2380 | } |
| 2354 | |
|
|
| 2355 | package cf; |
|
|
| 2356 | |
2381 | |
| 2357 | =back |
2382 | =back |
| 2358 | |
2383 | |
| 2359 | =head3 cf::object |
2384 | =head3 cf::object |
| 2360 | |
2385 | |
| … | |
… | |
| 3417 | warn "runtime file written.\n"; |
3442 | warn "runtime file written.\n"; |
| 3418 | |
3443 | |
| 3419 | 1 |
3444 | 1 |
| 3420 | } |
3445 | } |
| 3421 | |
3446 | |
|
|
3447 | our $uuid_lock; |
|
|
3448 | our $uuid_skip; |
|
|
3449 | |
|
|
3450 | sub write_uuid_sync($) { |
|
|
3451 | $uuid_skip ||= $_[0]; |
|
|
3452 | |
|
|
3453 | return if $uuid_lock; |
|
|
3454 | local $uuid_lock = 1; |
|
|
3455 | |
|
|
3456 | my $uuid = "$LOCALDIR/uuid"; |
|
|
3457 | |
|
|
3458 | my $fh = aio_open "$uuid~", O_WRONLY | O_CREAT, 0644 |
|
|
3459 | or return; |
|
|
3460 | |
|
|
3461 | my $value = uuid_str $uuid_skip + uuid_seq uuid_cur; |
|
|
3462 | $uuid_skip = 0; |
|
|
3463 | |
|
|
3464 | (aio_write $fh, 0, (length $value), $value, 0) <= 0 |
|
|
3465 | and return; |
|
|
3466 | |
|
|
3467 | # always fsync - this file is important |
|
|
3468 | aio_fsync $fh |
|
|
3469 | and return; |
|
|
3470 | |
|
|
3471 | close $fh |
|
|
3472 | or return; |
|
|
3473 | |
|
|
3474 | aio_rename "$uuid~", $uuid |
|
|
3475 | and return; |
|
|
3476 | |
|
|
3477 | warn "uuid file written ($value).\n"; |
|
|
3478 | |
|
|
3479 | 1 |
|
|
3480 | |
|
|
3481 | } |
|
|
3482 | |
|
|
3483 | sub write_uuid($$) { |
|
|
3484 | my ($skip, $sync) = @_; |
|
|
3485 | |
|
|
3486 | $sync ? write_uuid_sync $skip |
|
|
3487 | : async { write_uuid_sync $skip }; |
|
|
3488 | } |
|
|
3489 | |
| 3422 | sub emergency_save() { |
3490 | sub emergency_save() { |
| 3423 | my $freeze_guard = cf::freeze_mainloop; |
3491 | my $freeze_guard = cf::freeze_mainloop; |
| 3424 | |
3492 | |
| 3425 | warn "enter emergency perl save\n"; |
3493 | warn "enter emergency perl save\n"; |
| 3426 | |
3494 | |
| … | |
… | |
| 3446 | warn "end emergency map save\n"; |
3514 | warn "end emergency map save\n"; |
| 3447 | |
3515 | |
| 3448 | warn "begin emergency database checkpoint\n"; |
3516 | warn "begin emergency database checkpoint\n"; |
| 3449 | BDB::db_env_txn_checkpoint $DB_ENV; |
3517 | BDB::db_env_txn_checkpoint $DB_ENV; |
| 3450 | warn "end emergency database checkpoint\n"; |
3518 | warn "end emergency database checkpoint\n"; |
|
|
3519 | |
|
|
3520 | warn "begin write uuid\n"; |
|
|
3521 | write_uuid_sync 1; |
|
|
3522 | warn "end write uuid\n"; |
| 3451 | }; |
3523 | }; |
| 3452 | |
3524 | |
| 3453 | warn "leave emergency perl save\n"; |
3525 | warn "leave emergency perl save\n"; |
| 3454 | } |
3526 | } |
| 3455 | |
3527 | |
