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 )