File: Util.pm

package info (click to toggle)
libmakefile-dom-perl 0.004-1
  • links: PTS, VCS
  • area: main
  • in suites: squeeze
  • size: 616 kB
  • ctags: 535
  • sloc: perl: 6,552; makefile: 2
file content (76 lines) | stat: -rw-r--r-- 1,932 bytes parent folder | download | duplicates (7)
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
package Test::Make::Util;

use Test::Util -Base;
#use Data::Dumper::Simple;

our @EXPORT = qw(
    process_args
    touch utouch
    clean_env
);

sub process_args ($) {
    my $text = shift;
    my @args = split_arg($text);
    foreach (@args) {
        #warn "----------\n";
        #warn Dumper(@args, $_);
        #warn "----------\n";
        if (/^"(.*)"$/) {
            #warn "---------";
            #warn qq{Pusing "$1" into args\n};
            $_ = $1;
            process_escape( $_, q{"\\$@\#} );
        } elsif (/^'(.*)'$/) {
            #warn "  Pusing '$1' into args\n";
            $_ = $1;
        }
    }
    return @args;
}

sub touch (@) {
    utouch(0, @_);
}

# Touch with a time offset.  To DTRT, call touch() then use stat() to get the
# access/mod time for each file and apply the offset.

sub utouch ($@) {
    my $off = shift;
    my @files = @_;
    foreach my $file (@files) {
        my $in;
        open $in, ">>$file" or
            print $in '' or close $in or
            die "Can't touch $file: $!";
    }
    my (@s) = stat($files[0]);
    utime($s[8] + $off, $s[9] + $off, @files);
}

# the current implementation of clean_env is buggy. haven't found a better approach
sub clean_env () {
  # Get a clean environment

  my %makeENV = ();
  # Pull in benign variables from the user's environment
  #
  foreach (# UNIX-specific things
           'TZ', 'LANG', 'TMPDIR', 'HOME', 'USER', 'LOGNAME', 'PATH',
           # Purify things
           'PURIFYOPTIONS',
           # Windows NT-specific stuff
           'Path', 'SystemRoot', 'TMP', 'SystemDrive', 'TEMP', 'OS', 'HOMEPATH',
           # DJGPP-specific stuff
           'DJDIR', 'DJGPP', 'SHELL', 'COMSPEC', 'HOSTNAME', 'LFN',
           'FNCASE', '387', 'EMU387', 'GROUP',
           'GNU_MAKE_PATH', 'GNU_SHELL_PATH', 'INC', 'path',
          ) {
    $makeENV{$_} = $ENV{$_} if defined $ENV{$_};
  }
  %ENV = ();
  %ENV = %makeENV;
}

1;