File: common.pl

package info (click to toggle)
liblog-agent-perl 1.001-2
  • links: PTS, VCS
  • area: main
  • in suites: buster, stretch
  • size: 468 kB
  • ctags: 275
  • sloc: perl: 2,278; makefile: 2
file content (49 lines) | stat: -rw-r--r-- 1,168 bytes parent folder | download
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
#!perl
###########################################################################
#
#   common.pl
#
#   Copyright (C) 1999 Raphael Manfredi.
#   Copyright (C) 2002-2015 Mark Rogaski, mrogaski@cpan.org;
#   all rights reserved.
#
#   See the README file included with the
#   distribution for license information.
#
##########################################################################

sub contains ($$) {
    my ($file, $pattern) = @_;
    $pattern = qr{$pattern};
    local *FILE;
    local $_;
    open(FILE, $file) || die "can't open $file: $!\n";
    my $found = 0;
    my $line = 0;
    while (<FILE>) {
        s/[\n\r]//sg;
        $line++;
        if (/$pattern/) {
            $found = 1;
            last;
        }
    }
    close FILE;
    return $found ? $line : 0;
}

sub perm_ok ($$) {
    #
    # Given a fileame and target permissions, checks if the file
    # was created with the correct permissions.
    #
    my($file, $target) = @_;

    $target &= ~ umask;         # account for user mask
    my $mode = (stat $file)[2]; # find the current mode
    $mode &= 0777;              # we only care about UGO

    return $mode == $target;
}

1;