Char-HP15

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
0.31  2009-01-29 00:00:00
  - create test data file on execute test.pl
  - require run-time module version
  - rewrite all about "split" logic
  - created by INABA Hitoshi
 
0.30  2009-01-04 00:00:00
  - support context when calling lc(), lc, uc(), uc
  - support chr(0x5C) ended path on MSWin32
    - file test operators
    - functions lstat(), opendir(), stat(), and unlink()
    - glob() and <WILDCARD>
  - remove pl2ebat.bat, jperl55.bat, jperl58.bat, and jperl510.bat
  - merge esjis.pl into Sjis.pm
  - matched variables $1,$2,$3,... after s/// came to function as it was a description
  - support function of chr, ord, and reverse again
  - add test filetest, pathdir, pathfile, and perlmemo
  - created at kanmi-kissa Hahaso in Chichibu
 
0.29  2008-11-20 00:00:00
  - remove \G from $your_gap

lib/Ehp15.pm  view on Meta::CPAN

334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
sub Ehp15::u_();
sub Ehp15::g_();
sub Ehp15::k_();
sub Ehp15::T_();
sub Ehp15::B_();
sub Ehp15::M_();
sub Ehp15::A_();
sub Ehp15::C_();
sub Ehp15::glob($);
sub Ehp15::glob_();
sub Ehp15::lstat(*);
sub Ehp15::lstat_();
sub Ehp15::opendir(*$);
sub Ehp15::stat(*);
sub Ehp15::stat_();
sub Ehp15::unlink(@);
sub Ehp15::chdir(;$);
sub Ehp15::do($);
sub Ehp15::require(;$);
sub Ehp15::telldir(*);
 
sub HP15::ord(;$);
sub HP15::ord_();
sub HP15::reverse(@);

lib/Ehp15.pm  view on Meta::CPAN

4597
4598
4599
4600
4601
4602
4603
4604
4605
4606
4607
4608
4609
4610
4611
4612
4613
4614
4615
4616
4617
4618
4619
4620
4621
4622
4623
4624
4625
4626
    # For example, "nobody"-like users might use /nonexistant
    if (defined $home and ! Ehp15::d($home)) {
        $home = undef;
    }
    return $home;
}
 
#
# HP-15 file lstat (with parameter)
#
sub Ehp15::lstat(*) {
 
    local $_ = shift if @_;
 
    if (-e $_) {
        return CORE::lstat _;
    }
    elsif (_MSWin32_5Cended_path($_)) {
 
        # Even if ${^WIN32_SLOPPY_STAT} is set to a true value, Ehp15::lstat()
        # on Windows opens the file for the path which has 5c at end.
        # (and so on)
 
        local *MUST_BE_BAREWORD_AT_HERE;
        if (CORE::open(MUST_BE_BAREWORD_AT_HERE, $_)) {
            if (wantarray) {
                my @stat = CORE::stat MUST_BE_BAREWORD_AT_HERE; # not CORE::lstat
                close(MUST_BE_BAREWORD_AT_HERE) or die "Can't close file: $_: $!";
                return @stat;
            }

lib/Ehp15.pm  view on Meta::CPAN

4673
4674
4675
4676
4677
4678
4679
4680
4681
4682
4683
4684
4685
4686
4687
4688
4689
4690
4691
4692
4693
4694
4695
4696
4697
4698
4699
4700
4701
4702
4703
4704
4705
4706
        if (CORE::opendir $dh, "$_[1]/.") {
            return 1;
        }
    }
    return undef;
}
 
#
# HP-15 file stat (with parameter)
#
sub Ehp15::stat(*) {
 
    local $_ = shift if @_;
 
    my $fh = qualify_to_ref $_;
    if (defined fileno $fh) {
        return CORE::stat $fh;
    }
    elsif (-e $_) {
        return CORE::stat _;
    }
    elsif (_MSWin32_5Cended_path($_)) {
 
        # Even if ${^WIN32_SLOPPY_STAT} is set to a true value, Ehp15::stat()
        # on Windows opens the file for the path which has 5c at end.
        # (and so on)
 
        local *MUST_BE_BAREWORD_AT_HERE;
        if (CORE::open(MUST_BE_BAREWORD_AT_HERE, $_)) {
            if (wantarray) {
                my @stat = CORE::stat MUST_BE_BAREWORD_AT_HERE;
                close(MUST_BE_BAREWORD_AT_HERE) or die "Can't close file: $_: $!";
                return @stat;
            }

lib/Ehp15.pm  view on Meta::CPAN

5091
5092
5093
5094
5095
5096
5097
5098
5099
5100
5101
5102
5103
5104
5105
5106
5107
5108
5109
5110
5111
5112
5113
}
else {
    $realfilename = "$prefix/$filename";
}
 
if (Ehp15::f($realfilename)) {
 
    my $script = '';
 
    if (Ehp15::e("$realfilename.e")) {
        my $e_mtime      = (Ehp15::stat("$realfilename.e"))[9];
        my $mtime        = (Ehp15::stat($realfilename))[9];
        my $module_mtime = (Ehp15::stat(__FILE__))[9];
        if (($e_mtime < $mtime) or ($mtime < $module_mtime)) {
            Ehp15::unlink "$realfilename.e";
        }
    }
 
    if (Ehp15::e("$realfilename.e")) {
        my $fh = gensym();
        if (_open_r($fh, "$realfilename.e")) {
            if ($^O eq 'MacOS') {
                CORE::eval q{

lib/Ehp15.pm  view on Meta::CPAN

5323
5324
5325
5326
5327
5328
5329
5330
5331
5332
5333
5334
5335
5336
5337
5338
5339
5340
5341
5342
5343
5344
5345
else {
    $realfilename = "$prefix/$_";
}
 
if (Ehp15::f($realfilename)) {
    $INC{$_} = $realfilename;
 
    my $script = '';
 
    if (Ehp15::e("$realfilename.e")) {
        my $e_mtime      = (Ehp15::stat("$realfilename.e"))[9];
        my $mtime        = (Ehp15::stat($realfilename))[9];
        my $module_mtime = (Ehp15::stat(__FILE__))[9];
        if (($e_mtime < $mtime) or ($mtime < $module_mtime)) {
            Ehp15::unlink "$realfilename.e";
        }
    }
 
    if (Ehp15::e("$realfilename.e")) {
        my $fh = gensym();
        _open_r($fh, "$realfilename.e") or croak "Can't open file: $realfilename.e";
        if ($^O eq 'MacOS') {
            CORE::eval q{

lib/Ehp15.pm  view on Meta::CPAN

11376
11377
11378
11379
11380
11381
11382
11383
11384
11385
11386
11387
11388
11389
11390
11391
11392
11393
11394
11395
11396
11397
11398
11399
    Ehp15::fc(...);
    Ehp15::fc_;
    Ehp15::ignorecase(...);
    Ehp15::capture(...);
    Ehp15::chr(...);
    Ehp15::chr_;
    Ehp15::X ...;
    Ehp15::X_;
    Ehp15::glob(...);
    Ehp15::glob_;
    Ehp15::lstat(...);
    Ehp15::lstat_;
    Ehp15::opendir(...);
    Ehp15::stat(...);
    Ehp15::stat_;
    Ehp15::unlink(...);
    Ehp15::chdir(...);
    Ehp15::do(...);
    Ehp15::require(...);
    Ehp15::telldir(...);
 
  # "no Ehp15;" not supported
 
=head1 ABSTRACT

lib/Ehp15.pm  view on Meta::CPAN

11995
11996
11997
11998
11999
12000
12001
12002
12003
12004
12005
12006
12007
12008
12009
12010
12011
12012
12013
12014
  # absolute path
  @abspath_file = split(/\n/,`dir /s /b wildcard\\here*.txt 2>NUL`);
 
  # on COMMAND.COM
  @relpath_file = split(/\n/,`dir /b wildcard\\here*.txt`);
  @abspath_file = split(/\n/,`dir /s /b wildcard\\here*.txt`);
 
=item * Statistics about link
 
  @lstat = Ehp15::lstat($file);
  @lstat = Ehp15::lstat_;
 
  Like Ehp15::stat, returns information on file, except that if file is a symbolic
  link, Ehp15::lstat returns information about the link; Ehp15::stat returns
  information about the file pointed to by the link. If symbolic links are
  unimplemented on your system, a normal Ehp15::stat is done instead. If file is
  omitted, returns information on file given in $_. Returns values (especially
  device and inode) may be bogus.
  This subroutine function when the filename ends with chr(0x5C) on MSWin32.

lib/Ehp15.pm  view on Meta::CPAN

12017
12018
12019
12020
12021
12022
12023
12024
12025
12026
12027
12028
12029
12030
12031
12032
12033
12034
12035
12036
12037
12038
12039
12040
12041
12042
12043
12044
12045
12046
12047
12048
12049
12050
12051
12052
  $rc = Ehp15::opendir(DIR,$dir);
 
  This subroutine opens a directory named $dir for processing by readdir, telldir,
  seekdir, rewinddir, and closedir. The subroutine returns true if successful.
  Directory handles have their own namespace from filehandles.
  This subroutine function when the directory name ends with chr(0x5C) on MSWin32.
 
=item * Statistics about file
 
  $stat = Ehp15::stat(FILEHANDLE);
  $stat = Ehp15::stat(DIRHANDLE);
  $stat = Ehp15::stat($expr);
  $stat = Ehp15::stat_;
  @stat = Ehp15::stat(FILEHANDLE);
  @stat = Ehp15::stat(DIRHANDLE);
  @stat = Ehp15::stat($expr);
  @stat = Ehp15::stat_;
 
  In scalar context, this subroutine returns a Boolean value that indicates whether
  the call succeeded. In list context, it returns a 13-element list giving the
  statistics for a file, either the file opened via FILEHANDLE or DIRHANDLE, or
  named by $expr. It's typically used as followes:
 
  ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
      $atime,$mtime,$ctime,$blksize,$blocks) = Ehp15::stat($expr);
 
  Not all fields are supported on all filesystem types; unsupported fields return
  0. Here are the meanings of the fields:
 
  -------------------------------------------------------------------------
  Index  Field      Meaning
  -------------------------------------------------------------------------
    0    $dev       Device number of filesystem
                    drive number for MSWin32
                    vRefnum for MacOS

lib/Ehp15.pm  view on Meta::CPAN

12082
12083
12084
12085
12086
12087
12088
12089
12090
12091
12092
12093
12094
12095
12096
12097
12098
12099
12100
12101
12102
12103
12104
12105
12106
12107
12108
12109
12110
                    int(($size + $blksize-1) / $blksize) for MacOS
  -------------------------------------------------------------------------
 
  $dev and $ino, token together, uniquely identify a file on the same system.
  The $blksize and $blocks are likely defined only on BSD-derived filesystems.
  The $blocks field (if defined) is reported in 512-byte blocks. The value of
  $blocks * 512 can differ greatly from $size for files containing unallocated
  blocks, or "hole", which aren't counted in $blocks.
 
  If Ehp15::stat is passed the special filehandle consisting of an underline, no
  actual stat(2) is done, but the current contents of the stat structure from
  the last Ehp15::stat, Ehp15::lstat, or Ehp15::stat-based file test subroutine
  (such as Ehp15::r, Ehp15::w, and Ehp15::x) are returned.
 
  Because the mode contains both the file type and its permissions, you should
  mask off the file type portion and printf or sprintf using a "%o" if you want
  to see the real permissions:
 
  $mode = (Ehp15::stat($expr))[2];
  printf "Permissions are %04o\n", $mode & 07777;
 
  If $expr is omitted, returns information on file given in $_.
  This subroutine function when the filename ends with chr(0x5C) on MSWin32.
 
=item * Deletes a list of files.
 
  $unlink = Ehp15::unlink(@list);
  $unlink = Ehp15::unlink($file);
  $unlink = Ehp15::unlink;

lib/HP15.pm  view on Meta::CPAN

166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
        #
        # Filter >
        # Source >>>
        # Escape >>>>> executable without re-escape
        #
        # Filter >>>
        # Source >
        # Escape >>>>> executable without re-escape
        #----------------------------------------------------
 
        my $mtime_filter = (Ehp15::stat(__FILE__     ))[9];
        my $mtime_source = (Ehp15::stat($filename    ))[9];
        my $mtime_escape = (Ehp15::stat("$filename.e"))[9];
        if (($mtime_escape < $mtime_source) or ($mtime_escape < $mtime_filter)) {
            Ehp15::unlink "$filename.e";
        }
    }
}
 
if (not Ehp15::e("$filename.e")) {
    my $fh = gensym();
    Ehp15::_open_a($fh, "$filename.e") or die __FILE__, ": Can't write open file: $filename.e\n";

lib/HP15.pm  view on Meta::CPAN

222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
    else {
        CORE::eval q{ flock($fh, LOCK_EX) };
    }
 
    CORE::eval q{ truncate($fh, 0) };
    seek($fh, 0, 0) or die __FILE__, ": Can't seek file: $filename.e\n";
 
    my $e_script = HP15::escape_script($filename);
    print {$fh} $e_script;
 
    my $mode = (Ehp15::stat($filename))[2] & 0777;
    chmod $mode, "$filename.e";
 
    close($fh) or die "Can't close file: $filename.e: $!";
}
 
my $fh = gensym();
Ehp15::_open_r($fh, "$filename.e") or die __FILE__, ": Can't read open file: $filename.e\n";
 
if (0) {
}

lib/HP15.pm  view on Meta::CPAN

2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
=item * Unicode Properties (aka Character Properties) of Regular Expression
 
Unicode properties (aka character properties) of regexp are not available.
Also (?[]) in regexp of Perl 5.18 is not available. There is no plans to currently
support these.
 
=item * ${^WIN32_SLOPPY_STAT} is ignored
 
Even if ${^WIN32_SLOPPY_STAT} is set to a true value, file test functions Ehp15::*(),
Ehp15::lstat(), and Ehp15::stat() on Microsoft Windows open the file for the path
which has chr(0x5c) at end.
 
=item * Delimiter of String and Regexp
 
qq//, q//, qw//, qx//, qr//, m//, s///, tr///, and y/// can't use a wide character
as the delimiter.
 
=item * \b{...} Boundaries in Regular Expressions
 
Following \b{...} available starting in v5.22 are not supported.

t/HP15/207_stat.t  view on Meta::CPAN

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
close(FILE);
open(FILE,'>D‹@”\/c.txt') || die "Can't open file: D‹@”\/c.txt\n";
print FILE "1\n";
close(FILE);
open(FILE,'>D‹@”\/F‹@”\') || die "Can't open file: D‹@”\/F‹@”\\n";
print FILE "1\n";
close(FILE);
mkdir('D‹@”\/D‹@”\', 0777);
 
$_ = 'F‹@”\';
if (@_ = stat($_)) {
    print "ok - 1 $^X $__FILE__\n";
}
else{
    print "not ok - 1 $^X $__FILE__\n";
}
 
$_ = 'D‹@”\';
if (@_ = stat($_)) {
    print "not ok - 2 $^X $__FILE__\n";
}
else{
    print "ok - 2 $^X $__FILE__\n";
}
 
unlink('F‹@”\');
rmdir('D‹@”\/D‹@”\');
unlink('D‹@”\/a.txt');
unlink('D‹@”\/b.txt');
unlink('D‹@”\/c.txt');
unlink('D‹@”\/F‹@”\');
rmdir('D‹@”\');
 
__END__
 
Perlƒƒ‚/Windows‚ł̃tƒ@ƒCƒ‹ƒpƒX
 
ƒtƒ@ƒCƒ‹ŠÖ˜AƒRƒ}ƒ“ƒh‚Ì“®ìŠm”F
u‹@”\v‚Æ‚¢‚¤•¶Žš—ñ‚ð•ϐ”$_‚É“ü‚êAstat($_)‚Æ‚µ‚Ä‚à•Ô‚è’l‚ª‚È‚¢

t/HP15/215_lstat.t  view on Meta::CPAN

14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
if ($chcp !~ /932/oxms) {
    print "ok - 1 # SKIP $^X $0\n";
    exit;
}
 
open(FILE,'>F‹@”\') || die "Can't open file: F‹@”\\n";
print FILE "1\n";
close(FILE);
 
# lstat
if (lstat('F‹@”\')) {
    print "ok - 1 lstat $^X $__FILE__\n";
}
else {
    print "not ok - 1 lstat: $! $^X $__FILE__\n";
}
 
unlink('F‹@”\');
 
__END__

t/HP15/220_stat.t  view on Meta::CPAN

14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
if ($chcp !~ /932/oxms) {
    print "ok - 1 # SKIP $^X $0\n";
    exit;
}
 
open(FILE,'>F‹@”\') || die "Can't open file: F‹@”\\n";
print FILE "1\n";
close(FILE);
 
# stat
if (stat('F‹@”\')) {
    print "ok - 1 stat $^X $__FILE__\n";
}
else {
    print "not ok - 1 stat: $! $^X $__FILE__\n";
}
 
unlink('F‹@”\');
 
__END__



( run in 1.522 second using v1.01-cache-2.11-cpan-49f99fa48dc )