5 use POSIX
qw(EINTR EEXIST EOPNOTSUPP);
20 my $IPV4OCTET = "(?:25[0-5]|(?:2[0-4]|1[0-9]|[1-9])?[0-9])";
21 our $IPV4RE = "(?:(?:$IPV4OCTET\\.){3}$IPV4OCTET)";
22 my $IPV6H16 = "(?:[0-9a-fA-F]{1,4})";
23 my $IPV6LS32 = "(?:(?:$IPV4RE|$IPV6H16:$IPV6H16))";
26 "(?:(?:" . "(?:$IPV6H16:){6})$IPV6LS32)|" .
27 "(?:(?:" . "::(?:$IPV6H16:){5})$IPV6LS32)|" .
28 "(?:(?:(?:" . "$IPV6H16)?::(?:$IPV6H16:){4})$IPV6LS32)|" .
29 "(?:(?:(?:(?:$IPV6H16:){0,1}$IPV6H16)?::(?:$IPV6H16:){3})$IPV6LS32)|" .
30 "(?:(?:(?:(?:$IPV6H16:){0,2}$IPV6H16)?::(?:$IPV6H16:){2})$IPV6LS32)|" .
31 "(?:(?:(?:(?:$IPV6H16:){0,3}$IPV6H16)?::(?:$IPV6H16:){1})$IPV6LS32)|" .
32 "(?:(?:(?:(?:$IPV6H16:){0,4}$IPV6H16)?::" . ")$IPV6LS32)|" .
33 "(?:(?:(?:(?:$IPV6H16:){0,5}$IPV6H16)?::" . ")$IPV6H16)|" .
34 "(?:(?:(?:(?:$IPV6H16:){0,6}$IPV6H16)?::" . ")))";
36 our $IPRE = "(?:$IPV4RE|$IPV6RE)";
38 sub file_set_contents
{
39 my ($filename, $data, $perm) = @_;
41 $perm = 0644 if !defined($perm);
43 my $tmpname = "$filename.tmp.$$";
46 my ($fh, $tries) = (undef, 0);
47 while (!$fh && $tries++ < 3) {
48 $fh = IO
::File-
>new($tmpname, O_WRONLY
|O_CREAT
|O_EXCL
, $perm);
49 if (!$fh && $! == EEXIST
) {
50 unlink($tmpname) or die "unable to delete old temp file: $!\n";
53 die "unable to open file '$tmpname' - $!\n" if !$fh;
54 die "unable to write '$tmpname' - $!\n" unless print $fh $data;
55 die "closing file '$tmpname' failed - $!\n" unless close $fh;
64 if (!rename($tmpname, $filename)) {
65 my $msg = "close (rename) atomic file '$filename' failed: $!\n";
71 sub file_get_contents
{
72 my ($filename, $max) = @_;
74 my $fh = IO
::File-
>new($filename, "r") ||
75 die "can't open '$filename' - $!\n";
77 my $content = safe_read_from
($fh, $max, 0, $filename);
84 sub file_read_firstline
{
87 my $fh = IO
::File-
>new ($filename, "r");
96 my ($fh, $max, $oneline, $filename) = @_;
98 $max = 32768 if !$max;
100 my $subject = defined($filename) ?
"file '$filename'" : 'input';
105 while ($count = sysread($fh, $input, 8192, $br)) {
107 die "$subject too long - aborting\n" if $br > $max;
108 if ($oneline && $input =~ m/^(.*)\n/) {
113 die "unable to read $subject - $!\n" if !defined($count);
119 my $listtxt = shift || '';
121 return split (/\0/, $listtxt) if $listtxt =~ m/\0/;
123 $listtxt =~ s/[,;]/ /g;
124 $listtxt =~ s/^\s+//;
126 my @data = split (/\s+/, $listtxt);
131 # split an shell argument string into an array,
135 return $str ?
[ Text
::ParseWords
::shellwords
($str) ] : [];
139 my ($param, $key) = @_;
141 my $res = $param->{$key};
142 delete $param->{$key};