File: testlib

package info (click to toggle)
libcache-memcached-managed-perl 0.26-1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, bullseye, sid
  • size: 264 kB
  • sloc: perl: 617; makefile: 2
file content (101 lines) | stat: -rw-r--r-- 2,119 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101

# make sure we can do sockets
use IO::Socket ();
use Data::Dumper ();

# some local lexicals
my $text;

# satisy -require-
1;

#------------------------------------------------------------------------
# anyport
#
# Return a free port for listening
#
#  IN: 1 servername or IP address (defaults to "localhost")
# OUT: 1 random port number

sub anyport {

    # attempt to obtain a port to work on
    my $port = '';
    if (my $socket = IO::Socket::INET->new(
      Listen    => 5,
      LocalAddr => (shift || '127.0.0.1'),
    ) ) {
        $port = $socket->sockport;
    }

    # make sure the system's freed up the port
    sleep 1;
    return $port;
} #anyport

#------------------------------------------------------------------------
# ft
#
# Helper sub for doing tests inside a forked process
#
# a. called without parameter in void context: initialize
# b. called with parameter in void context: add test result + comment
# c. called without parameter in scalar context: return result

sub ft {

    # completed, return what we got
    if ( defined wantarray ) {
        return $text;
    }

    # we're getting a test, return its result
    elsif (@_) {
        $text .= ($_[0] || '')."#$_[1]\n";
    }

    # we're initializing
    else {
        $text = '';
    }
} #ft

#------------------------------------------------------------------------
# pft
#
# Process forked test results
#
#  IN: 1 filename to read

sub pft {

    # open the file
    open my $handle, $_[0] or die "Could not open '$_[0]': $!";

    # process all lines
    chomp,&ok( split "#" ) while <$handle>;

    # deny all further knowledge
    close $handle;
    unlink $_[0];
} #pft

#------------------------------------------------------------------------
# slurp
#
# Slurp the contents of a file
#
#  IN: 1 filename
# OUT: 1 contents of file

sub slurp { open my $handle,$_[0]; local $/; <$handle> } #slurp

#------------------------------------------------------------------------
# splat
#
# Splat contents to a file
#
#  IN: 1 filename
#      2 contents of file

sub splat { open my $handle,">$_[0]"; print $handle $_[1] } #splat