| … | |
… | |
| 60 | s/&/&/g; |
60 | s/&/&/g; |
| 61 | s/>/>/g; |
61 | s/>/>/g; |
| 62 | s/</</g; |
62 | s/</</g; |
| 63 | |
63 | |
| 64 | $_ |
64 | $_ |
|
|
65 | } |
|
|
66 | |
|
|
67 | sub socketpipe() { |
|
|
68 | socketpair my $fh1, my $fh2, Socket::AF_UNIX, Socket::SOCK_STREAM, Socket::PF_UNSPEC |
|
|
69 | or die "cannot establish bidiretcional pipe: $!\n"; |
|
|
70 | |
|
|
71 | ($fh1, $fh2) |
|
|
72 | } |
|
|
73 | |
|
|
74 | sub background(&) { |
|
|
75 | my ($cb) = @_; |
|
|
76 | |
|
|
77 | my ($fh_r, $fh_w) = CFPlus::socketpipe; |
|
|
78 | |
|
|
79 | my $pid = fork; |
|
|
80 | |
|
|
81 | if (defined $pid && !$pid) { |
|
|
82 | $SIG{__DIE__} = sub { |
|
|
83 | my $msg = $_[0]; |
|
|
84 | $msg =~ s/\n+/\n/; |
|
|
85 | warn "FATAL: $msg"; |
|
|
86 | CFPlus::_exit 99; |
|
|
87 | }; |
|
|
88 | |
|
|
89 | open STDOUT, ">&", $fh_w; |
|
|
90 | open STDERR, ">&", $fh_w; |
|
|
91 | close $fh_r; |
|
|
92 | close $fh_w; |
|
|
93 | |
|
|
94 | $| = 1; |
|
|
95 | |
|
|
96 | $cb->(); |
|
|
97 | |
|
|
98 | # win32 is fucked up, of course. exit will clean stuff up, |
|
|
99 | # which destroys our database etc. _exit will exit ALL |
|
|
100 | # forked processes, because of the dreaded fork emulation. |
|
|
101 | CFPlus::_exit 0; |
|
|
102 | } |
|
|
103 | |
|
|
104 | close $fh_w; |
|
|
105 | |
|
|
106 | my $buffer; |
|
|
107 | |
|
|
108 | Event->io (fd => $fh_r, poll => 'r', cb => sub { |
|
|
109 | unless (sysread $fh_r, $buffer, 4096, length $buffer) { |
|
|
110 | $_[0]->w->cancel; |
|
|
111 | $buffer .= "done\n"; |
|
|
112 | } |
|
|
113 | |
|
|
114 | while ($buffer =~ s/^(.*)\n//) { |
|
|
115 | my $line = $1; |
|
|
116 | utf8::decode $line; |
|
|
117 | ::message ({ |
|
|
118 | markup => "editor($pid): " . CFPlus::asxml $line, |
|
|
119 | }); |
|
|
120 | } |
|
|
121 | }); |
| 65 | } |
122 | } |
| 66 | |
123 | |
| 67 | package CFPlus::Database; |
124 | package CFPlus::Database; |
| 68 | |
125 | |
| 69 | our @ISA = BerkeleyDB::Btree::; |
126 | our @ISA = BerkeleyDB::Btree::; |
| … | |
… | |
| 136 | $::CFG->{VERSION} = $::VERSION; |
193 | $::CFG->{VERSION} = $::VERSION; |
| 137 | |
194 | |
| 138 | open my $fh, ">:utf8", $file |
195 | open my $fh, ">:utf8", $file |
| 139 | or return; |
196 | or return; |
| 140 | print $fh to_json $::CFG; |
197 | print $fh to_json $::CFG; |
|
|
198 | } |
|
|
199 | |
|
|
200 | sub http_proxy { |
|
|
201 | my @proxy = win32_proxy_info; |
|
|
202 | |
|
|
203 | if (@proxy) { |
|
|
204 | "http://" . (@proxy < 2 ? "" : @proxy < 3 ? "$proxy[1]\@" : "$proxy[1]:$proxy[2]\@") . $proxy[0] |
|
|
205 | } elsif (exists $ENV{http_proxy}) { |
|
|
206 | $ENV{http_proxy} |
|
|
207 | } else { |
|
|
208 | () |
|
|
209 | } |
|
|
210 | } |
|
|
211 | |
|
|
212 | sub set_proxy { |
|
|
213 | my $proxy = http_proxy |
|
|
214 | or return; |
|
|
215 | |
|
|
216 | $ENV{http_proxy} = $proxy; |
| 141 | } |
217 | } |
| 142 | |
218 | |
| 143 | our $DB_ENV; |
219 | our $DB_ENV; |
| 144 | our $DB_STATE; |
220 | our $DB_STATE; |
| 145 | |
221 | |
