File: Unicode.pm

package info (click to toggle)
perl 5.24.1-3%2Bdeb9u7
  • links: PTS, VCS
  • area: main
  • in suites: stretch
  • size: 107,108 kB
  • sloc: perl: 559,649; ansic: 293,918; sh: 67,316; pascal: 7,632; cpp: 3,895; makefile: 2,436; xml: 2,410; yacc: 989; sed: 6; lisp: 1
file content (90 lines) | stat: -rw-r--r-- 1,835 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
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
package MakeMaker::Test::Setup::Unicode;

@ISA = qw(Exporter);
require Exporter;
@EXPORT = qw(setup_recurs teardown_recurs);

use strict;
use File::Path;
use File::Basename;
use MakeMaker::Test::Utils;
use utf8;
use Config;

my %Files = (
             'Problem-Module/Makefile.PL'   => <<'PL_END',
use ExtUtils::MakeMaker;
use utf8;

WriteMakefile(
    NAME          => 'Problem::Module',
    ABSTRACT_FROM => 'lib/Problem/Module.pm',
    AUTHOR        => q{Danijel Tašov},
    EXE_FILES     => [ qw(bin/probscript) ],
    INSTALLMAN1DIR => "some", # even if disabled in $Config{man1dir}
    MAN1EXT       => 1, # set to 0 if man pages disabled
);
PL_END

            'Problem-Module/lib/Problem/Module.pm'  => <<'pm_END',
use utf8;

=pod

=encoding utf8

=head1 NAME

Problem::Module - Danijel Tašov's great new module

=cut

1;
pm_END

            'Problem-Module/bin/probscript'  => <<'pl_END',
#!/usr/bin/perl
use utf8;

=encoding utf8

=head1 NAME

文档 - Problem script
pl_END
);


sub setup_recurs {
    while(my($file, $text) = each %Files) {
        # Convert to a relative, native file path.
        $file = File::Spec->catfile(File::Spec->curdir, split m{\/}, $file);

        my $dir = dirname($file);
        mkpath $dir;
        my $utf8 = ($] < 5.008 or !$Config{useperlio}) ? "" : ":utf8";
        open(FILE, ">$utf8", $file) || die "Can't create $file: $!";
        print FILE $text;
        close FILE;

        # ensure file at least 1 second old for makes that assume
        # files with the same time are out of date.
        my $time = calibrate_mtime();
        utime $time, $time - 1, $file;
    }

    return 1;
}

sub teardown_recurs {
    foreach my $file (keys %Files) {
        my $dir = dirname($file);
        if( -e $dir ) {
            rmtree($dir) || return;
        }
    }
    return 1;
}


1;