view release on metacpan or  search on metacpan

lib/CHI/Util.pm  view on Meta::CPAN

    ## no critic (RequireInitializationForLocalVars)
    local *DIRH;
    opendir( DIRH, $dir ) or croak "cannot open '$dir': $!";
    return grep { $_ ne "." && $_ ne ".." } readdir(DIRH);
}

sub read_file {
    my ($file) = @_;

    # Fast slurp, adapted from File::Slurp::read, with unnecessary options removed
    #
    my $buf = "";
    my $read_fh;
    unless ( sysopen( $read_fh, $file, $Fetch_Flags ) ) {
        croak "read_file '$file' - sysopen: $!";
    }
    my $size_left = -s $read_fh;
    while (1) {
        my $read_cnt = sysread( $read_fh, $buf, $size_left, length $buf );
        if ( defined $read_cnt ) {
            last if $read_cnt == 0;
            $size_left -= $read_cnt;
            last if $size_left <= 0;
        }
        else {
            croak "read_file '$file' - sysread: $!";
        }
    }
    return $buf;
}

sub write_file {
    my ( $file, $data, $file_create_mode ) = @_;
    $file_create_mode = oct(666) if !defined($file_create_mode);

    # Fast spew, adapted from File::Slurp::write, with unnecessary options removed
    #
    {
        my $write_fh;
        unless ( sysopen( $write_fh, $file, $Store_Flags, $file_create_mode ) )
        {
            croak "write_file '$file' - sysopen: $!";
        }
        my $size_left = length($data);
        my $offset    = 0;
        do {
            my $write_cnt = syswrite( $write_fh, $data, $size_left, $offset );
            unless ( defined $write_cnt ) {
                croak "write_file '$file' - syswrite: $!";
            }
            $size_left -= $write_cnt;
            $offset += $write_cnt;
        } while ( $size_left > 0 );
    }
}

{

    # For efficiency, use Data::UUID to generate an initial unique id, then suffix it to
    # generate a series of 0x10000 unique ids. Not to be used for hard-to-guess ids, obviously.

    my $uuid;
    my $suffix = 0;

    sub unique_id {
        if ( !$suffix || !defined($uuid) ) {
            my $ug = Data::UUID->new();
            $uuid = $ug->create_hex();
        }
        my $hex = sprintf( '%s%04x', $uuid, $suffix );
        $suffix = ( $suffix + 1 ) & 0xffff;
        return $hex;
    }
}

use constant _FILE_SPEC_USING_UNIX =>
  ( $File::Spec::ISA[0] eq 'File::Spec::Unix' );

sub fast_catdir {
    if (_FILE_SPEC_USING_UNIX) {
        return join '/', @_;
    }
    else {
        return catdir(@_);
    }
}

sub fast_catfile {
    if (_FILE_SPEC_USING_UNIX) {
        return join '/', @_;
    }
    else {
        return catfile(@_);
    }
}

my %memory_size_units = ( 'k' => 1024, 'm' => 1024 * 1024 );

sub parse_memory_size {
    my $size = shift;
    if ( $size =~ /^\d+b?$/ ) {
        return $size;
    }
    elsif ( my ( $quantity, $unit ) = ( $size =~ /^(\d+)\s*([km])b?$/i ) ) {
        return $quantity * $memory_size_units{ lc($unit) };
    }
    else {
        croak "cannot parse memory size '$size'";
    }
}

my $json = JSON::MaybeXS->new( utf8 => 1, canonical => 1 );

sub json_decode {
    $json->decode( $_[0] );
}

sub json_encode {
    $json->encode( $_[0] );
}