App-MHFS
view release on metacpan or search on metacpan
lib/MHFS/Util.pm view on Meta::CPAN
}
my $size = -s $path;
if(! defined $size) {
say "size not defined path $path file $file";
next;
}
next if( $size < $options->{'min_file_size'});
$options->{'on_file'}->($path, $unsafePath, $file) if($options->{'on_file'});
}
return;
}
# perform multiple async actions at the same time.
# continue on with $result_func on failure or completion of all actions
sub do_multiples {
my ($multiples, $result_func) = @_;
my %data;
my @mkeys = keys %{$multiples};
foreach my $multiple (@mkeys) {
my $multiple_cb = sub {
my ($res) = @_;
$data{$multiple} = $res;
# return failure if this multiple failed
if(! defined $data{$multiple}) {
$result_func->(undef);
return;
}
# yield if not all the results in
foreach my $m2 (@mkeys) {
return if(! defined $data{$m2});
}
# all results in we can continue
$result_func->(\%data);
};
say "launching multiple key: $multiple";
$multiples->{$multiple}->($multiple_cb);
}
}
sub getMIME {
my ($filename) = @_;
my %combined = (
# audio
'mp3' => 'audio/mp3',
'flac' => 'audio/flac',
'opus' => 'audio',
'ogg' => 'audio/ogg',
'wav' => 'audio/wav',
# video
'mp4' => 'video/mp4',
'ts' => 'video/mp2t',
'mkv' => 'video/x-matroska',
'webm' => 'video/webm',
'flv' => 'video/x-flv',
# media
'mpd' => 'application/dash+xml',
'm3u8' => 'application/x-mpegURL',
'm3u8_v' => 'application/x-mpegURL',
# text
'html' => 'text/html; charset=utf-8',
'json' => 'application/json',
'js' => 'application/javascript',
'txt' => 'text/plain; charset=utf-8',
'css' => 'text/css',
# images
'jpg' => 'image/jpeg',
'jpeg' => 'image/jpeg',
'png' => 'image/png',
'gif' => 'image/gif',
'bmp' => 'image/bmp',
# binary
'pdf' => 'application/pdf',
'tar' => 'application/x-tar',
'wasm' => 'application/wasm',
'bin' => 'application/octet-stream'
);
my ($ext) = $filename =~ /\.([^.]+)$/;
# default to binary
return $combined{$ext} // $combined{'bin'};
}
sub parse_ipv4 {
my ($ipstring) = @_;
my $failmessage = "invalid ip: $ipstring";
my @values = $ipstring =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/;
if(scalar(@values) != 4) {
croak $failmessage;
}
foreach my $i (0..3) {
($values[$i] <= 255) or croak $failmessage;
}
return ($values[0] << 24) | ($values[1] << 16) | ($values[2] << 8) | ($values[3]);
}
sub surrogatepairtochar {
my ($hi, $low) = @_;
my $codepoint = 0x10000 + (ord($hi) - 0xD800) * 0x400 + (ord($low) - 0xDC00);
return pack('U', $codepoint);
}
sub surrogatecodepointpairtochar {
my ($hi, $low) = @_;
my $codepoint = 0x10000 + ($hi - 0xD800) * 0x400 + ($low - 0xDC00);
return pack('U', $codepoint);
}
# returns the byte length and the codepoint
sub _peek_utf8_codepoint {
my ($octets) = @_;
my @rules = (
[0x80, 0x00, 1], # 1 byte sequence
[0xE0, 0xC0, 2], # 2 byte sequence
[0xF0, 0xE0, 3], # 3 byte sequence
[0XF8, 0xF0, 4] # 4 byte sequence
);
my $byteval = ord(substr($octets, 0, 1));
my $charlen;
foreach my $rule (@rules) {
if(($byteval & $rule->[0]) == $rule->[1]) {
$charlen = $rule->[2];
last;
( run in 0.822 second using v1.01-cache-2.11-cpan-39bf76dae61 )