Module-Generic

 view release on metacpan or  search on metacpan

lib/Module/Generic/File/Cache.pm  view on Meta::CPAN

{
    my $self = shift( @_ );
    my $key  = shift( @_ );
    no strict 'subs';
    if( !defined( $key ) || $key eq '' )
    {
        return( Data::UUID->new->create_str );
    }
    # We do not actually use any path, but this is for standardisation with Module::Generic::SharedMem
    my $path;
    ( $key, $path ) = ref( $key ) eq 'ARRAY' ? @$key : ( $key, [getpwuid($>)]->[7] );
    $path = [getpwuid($path)]->[7] if( $path =~ /^\d+$/ );
    if( $key =~ /^\d+$/ )
    {
        my $id = $self->ftok( $key ) ||
            return( $self->error( "Unable to get a key using IPC::SysV::ftok: $!" ) );
        return( $id );
    }
    else
    {
        my $id = 0;
        $id += $_ for( unpack( "C*", $key ) );

lib/Module/Generic/File/Mmap.pm  view on Meta::CPAN

{
    my $self = shift( @_ );
    my $key  = shift( @_ );
    no strict 'subs';
    if( !defined( $key ) || $key eq '' )
    {
        return( Data::UUID->new->create_str );
    }
    # We do not actually use any path, but this is for standardisation with Module::Generic::SharedMem
    my $path;
    ( $key, $path ) = ref( $key ) eq 'ARRAY' ? @$key : ( $key, [getpwuid($>)]->[7] );
    $path = [getpwuid($path)]->[7] if( $path =~ /^\d+$/ );
    if( $key =~ /^\d+$/ )
    {
        my $id = $self->ftok( $key ) ||
            return( $self->error( "Unable to get a key using ftok: $!" ) );
        return( $id );
    }
    else
    {
        my $id = 0;
        $id += $_ for( unpack( "C*", $key ) );

lib/Module/Generic/Finfo.pm  view on Meta::CPAN

    my $data = $self->{_data};
    return( want( 'OBJECT' ) ? Module::Generic::Null->new : '' ) if( !scalar( @$data ) );
    return( $self->new_number( $data->[ FINFO_UID ] ) );
}

sub user
{
    my $self = shift( @_ );
    my $data = $self->{_data};
    return( want( 'OBJECT' ) ? Module::Generic::Null->new : '' ) if( !scalar( @$data ) );
    # perlport: "getpwuid: (Win32) Not implemented. (RISC OS) Not useful.
    return( $self->uid ) if( $^O =~ /^(win32|riscok)/i );
    return( $self->new_scalar( scalar( getpwuid( $data->[ FINFO_UID ] ) ) ) );
}

sub FREEZE
{
    my $self = CORE::shift( @_ );
    my $serialiser = CORE::shift( @_ ) // '';
    my $class = CORE::ref( $self );
    my %hash  = %$self;
    # Return an array reference rather than a list so this works with Sereal and CBOR
    # On or before Sereal version 4.023, Sereal did not support multiple values returned

lib/Module/Generic/SharedMem.pm  view on Meta::CPAN

sub _str2key
{
    my $self = shift( @_ );
    my $key  = shift( @_ );
    no strict 'subs';
    if( !defined( $key ) || $key eq '' )
    {
        return( &IPC::SysV::IPC_PRIVATE );
    }
    my $path;
    ( $key, $path ) = ref( $key ) eq 'ARRAY' ? @$key : ( $key, [getpwuid($>)]->[7] );
    $path = [getpwuid($path)]->[7] if( $path =~ /^\d+$/ );
    $path ||= File::Spec->rootdir();
    if( $key =~ /^\d+$/ )
    {
        my $id = &IPC::SysV::ftok( $path, $key ) ||
            return( $self->error( "Unable to get a key using IPC::SysV::ftok: $!" ) );
        return( $id );
    }
    else
    {
        # my $id = 0;

lib/Module/Generic/SharedMemXS.pm  view on Meta::CPAN

sub _str2key
{
    my $self = shift( @_ );
    my $key  = shift( @_ );
    no strict 'subs';
    if( !defined( $key ) || $key eq '' )
    {
        return( &IPC::SysV::IPC_PRIVATE );
    }
    my $path;
    ( $key, $path ) = ref( $key ) eq 'ARRAY' ? @$key : ( $key, [getpwuid($>)]->[7] );
    $path = [getpwuid($path)]->[7] if( $path =~ /^\d+$/ );
    $path ||= File::Spec->rootdir();
    if( $key =~ /^\d+$/ )
    {
        my $id = &IPC::SysV::ftok( $path, $key ) ||
            return( $self->error( "Unable to get a key using IPC::SysV::ftok: $!" ) );
        return( $id );
    }
    else
    {
        # my $id = 0;

t/11.finfo.t  view on Meta::CPAN

    no warnings 'Module::Generic::Finfo';
    my $failed = Module::Generic::Finfo->new( './not-existing.txt' );
    ok( defined( $failed ), 'Non-existing file' );
    ok( $failed->filetype == Module::Generic::Finfo::FILETYPE_NOFILE, 'Non-existing file type' );
};

ok( FILETYPE_REG == Module::Generic::Finfo::FILETYPE_REG && FILETYPE_SOCK == Module::Generic::Finfo::FILETYPE_SOCK, 'import of constants' );

my @finfo = CORE::stat( $file );
my $grname = scalar( CORE::getgrgid( $finfo[ FINFO_GID ] ) );
my $usrname = scalar( CORE::getpwuid( $finfo[ FINFO_UID ] ) );
is( $f->size, $finfo[ FINFO_SIZE ], 'size' );
is( $f->csize, $finfo[ FINFO_SIZE ], 'csize' );

is( $f->device, $finfo[ FINFO_DEV ], 'device' );

is( $f->filetype, Module::Generic::Finfo::FILETYPE_REG, 'file type' );

is( $f->fname, $file, 'file name' );

is( $f->gid, $finfo[ FINFO_GID ], 'gid' );