Changeset 39168

Show
Ignore:
Timestamp:
08/20/12 01:04:25 (9 months ago)
Author:
dankogai
Message:

VERSION 1.31

Location:
lang/perl/BSD-stat/trunk
Files:
1 added
14 modified

Legend:

Unmodified
Added
Removed

  • lang/perl/BSD-stat/trunk/Changes

    r31714 r39168  
    11# 
    2 # $Id: Changes,v 1.21 2002/01/28 15:54:38 dankogai Exp dankogai $ 
     2# $Id: Changes,v 1.31 2012/08/19 15:46:15 dankogai Exp dankogai $ 
    33# 
    44# Revision history for Perl extension BSD::stat. 
    5 $Revision: 2.33 $ $Date: 2009/03/25 07:55:57 $ 
    6 ! stat.pm 
    7   POD fixes 
     5$Revision: 1.31 $ $Date: 2012/08/19 15:46:15 $ 
     6! stat.pm README 
     7  Document fixes 
     8 
     91.30 2012/08/19 15:36:31 
     10! stat.pm stat.xs 
     11+ t/utimes.t 
     12  utimes() and lutimes() added 
     13! Makefile.PL 
     14  LICENSE => 'perl', # explicitly stated 
    815 
    9161.21 2001.01.29 

  • lang/perl/BSD-stat/trunk/MANIFEST

    r31712 r39168  
    1313t/statcache.t 
    1414t/underscore.t 
     15t/utimes.t 

  • lang/perl/BSD-stat/trunk/Makefile.PL

    r31712 r39168  
    1 # $Id: Makefile.PL,v 1.20 2002/01/26 04:17:06 dankogai Exp $ 
     1# $Id: Makefile.PL,v 1.30 2012/08/19 15:36:31 dankogai Exp $ 
    22use ExtUtils::MakeMaker; 
    33# See lib/ExtUtils/MakeMaker.pm for details of how to influence 
    … …  
    1616        # Un-comment this if you add C files to link with later: 
    1717    # 'OBJECT'          => '$(O_FILES)', # link all the C files too 
     18    LICENSE       => 'perl', 
    1819); 

  • lang/perl/BSD-stat/trunk/README

    r31712 r39168  
    11# 
    2 # $Id: README,v 1.20 2002/01/26 04:17:06 dankogai Exp $ 
     2# $Id: README,v 1.22 2012/08/19 15:46:15 dankogai Exp dankogai $ 
    33# 
    44 
    … …  
    2727COPYRIGHT AND LICENCE 
    2828 
    29 Copyright (C) 2001 Dan Kogai 
     29Copyright (C) 2001-2012 Dan Kogai 
    3030 
    3131This library is free software; you can redistribute it 

  • lang/perl/BSD-stat/trunk/stat.pm

    r31715 r39168  
    1 #$Id: stat.pm,v 1.21 2002/01/28 15:54:24 dankogai Exp dankogai $ 
     1#$Id: stat.pm,v 1.31 2012/08/19 15:46:15 dankogai Exp dankogai $ 
    22 
    33package BSD::stat; 
    … …  
    55use 5.00503; 
    66use strict; 
    7 # use warnings; 
     7use warnings; 
    88use Carp; 
    99 
    … …  
    1212use AutoLoader; 
    1313 
    14 use vars qw($RCSID $VERSION $DEBUG); 
    15  
    16 $RCSID = q$Id: stat.pm,v 1.21 2002/01/28 15:54:24 dankogai Exp dankogai $; 
    17 $VERSION = do { my @r = (q$Revision: 1.21 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; 
     14use vars qw($VERSION $DEBUG); 
     15 
     16$VERSION = sprintf "%d.%02d", q$Revision: 1.31 $ =~ /(\d+)/g; 
    1817 
    1918# In favor of speed, especially when $st_ series variables are exported, 
    … …  
    3736       lstat 
    3837       chflags 
     38       utimes 
     39       lutimes 
    3940       UF_SETTABLE 
    4041       UF_NODUMP 
    … …  
    6869        } 
    6970    for my $sym (@_) { 
    70         local $^W = 0; 
     71        no warnings 'uninitialized'; 
    7172        $sym =~ s/^([\$\@\%\*\&])//o; 
    7273        *{"$callpkg\::$sym"} =  
    … …  
    121122}; 
    122123 
    123  
    124124sub DESTROY{ 
    125125    $DEBUG or return; 
    … …  
    147147    return wantarray ? @$self : bless $self; 
    148148} 
    149  
    150149 
    151150# chflag implementation 
    … …  
    173172} 
    174173 
     174sub utimes { 
     175    my $atime = shift; 
     176    my $mtime = shift; 
     177    my $count = 0; 
     178    for my $f (@_) { 
     179        ( 
     180         ref \$f eq 'SCALAR' 
     181         ? xs_utimes( $atime, $mtime, $f ) 
     182         : xs_futimes( $atime, $mtime, fileno($f) ) 
     183        ) == 0 and $count++; 
     184    } 
     185    $count; 
     186} 
     187 
     188sub lutimes { 
     189    my $atime = shift; 
     190    my $mtime = shift; 
     191    my $count = 0; 
     192    for my $f (@_) { 
     193        xs_lutimes( $atime, $mtime, $f ) == 0 and $count++; 
     194    } 
     195    $count; 
     196} 
     197 
    175198# Autoload methods go after =cut, and are processed by the autosplit program. 
    176199 
    … …  
    225248 
    226249  chflags(UF_IMMUTABLE, @files) 
     250 
     251  # utimes, lutimes 
     252  my $when = 1234567890.987654; 
     253  utimes $when, $when, @files; 
     254  lutimes $when, $when, @links; 
    227255 
    228256=head1 DESCRIPTION 
    … …  
    310338  chflags 0, @files; 
    311339 
     340=head1 utimes and lutimes 
     341 
     342C<utimes()> is identical to C<utime()> except fractional time is accepted. 
     343 
     344C<lutimes()> is identical to C<utimes()> except when the path is 
     345symbolic link, in which case it changes the time stamp of the symlink 
     346link instead of the file it links to. 
     347 
    312348=head1 PERFORMANCE 
    313349 

  • lang/perl/BSD-stat/trunk/stat.xs

    r31712 r39168  
    11/* 
    2  * $Id: stat.xs,v 1.21 2002/01/28 15:54:38 dankogai Exp dankogai $ 
     2 * $Id: stat.xs,v 1.30 2012/08/19 15:36:31 dankogai Exp $ 
    33 */ 
    44 
    … …  
    99#include <sys/stat.h> 
    1010#include <unistd.h> 
     11#include <sys/time.h> 
    1112 
    1213/* 
    … …  
    124125} 
    125126 
     127static int 
     128xs_utimes(double atime, double mtime, char *path){ 
     129    struct timeval times[2]; 
     130    times[0].tv_sec = (int)atime; 
     131    times[0].tv_usec = (int)((atime - times[0].tv_sec) * 1e6); 
     132    times[1].tv_sec = (int)mtime; 
     133    times[1].tv_usec = (int)((mtime - times[1].tv_sec) * 1e6); 
     134    int err = utimes(path, times); 
     135    return setbang(err); 
     136} 
     137 
     138static int 
     139xs_lutimes(double atime, double mtime, char *path){ 
     140    struct timeval times[2]; 
     141    times[0].tv_sec = (int)atime; 
     142    times[0].tv_usec = (int)((atime - times[0].tv_sec) * 1e6); 
     143    times[1].tv_sec = (int)mtime; 
     144    times[1].tv_usec = (int)((mtime - times[1].tv_sec) * 1e6); 
     145    int err = lutimes(path, times); 
     146    return setbang(err); 
     147} 
     148 
     149static int 
     150xs_futimes(double atime, double mtime, int fd){ 
     151    struct timeval times[2]; 
     152    times[0].tv_sec = (int)atime; 
     153    times[0].tv_usec = (int)((atime - times[0].tv_sec) * 1e6); 
     154    times[1].tv_sec = (int)mtime; 
     155    times[1].tv_usec = (int)((mtime - times[1].tv_sec) * 1e6); 
     156    int err = futimes(fd, times); 
     157    return setbang(err); 
     158} 
     159 
    126160/* */ 
    127161 
    … …  
    163197    OUTPUT: 
    164198        RETVAL 
     199 
     200int 
     201xs_utimes(atime, mtime, path) 
     202    double atime; 
     203    double mtime; 
     204    char * path; 
     205    CODE: 
     206        RETVAL = xs_utimes(atime, mtime, path); 
     207    OUTPUT: 
     208        RETVAL 
     209 
     210int 
     211xs_lutimes(atime, mtime, path) 
     212    double atime; 
     213    double mtime; 
     214    char * path; 
     215    CODE: 
     216        RETVAL = xs_lutimes(atime, mtime, path); 
     217    OUTPUT: 
     218        RETVAL 
     219 
     220int 
     221xs_futimes(atime, mtime, fd) 
     222    double atime; 
     223    double mtime; 
     224    int fd; 
     225    CODE: 
     226        RETVAL = xs_futimes(atime, mtime, fd); 
     227    OUTPUT: 
     228        RETVAL 

  • lang/perl/BSD-stat/trunk/t/basic.t

    r31712 r39168  
    11# 
    2 # $Id: basic.t,v 1.20 2002/01/26 04:17:06 dankogai Exp $ 
     2# $Id: basic.t,v 1.21 2012/08/19 13:29:26 dankogai Exp $ 
    33# 
    44# Before `make install' is performed this script should be runnable with 

  • lang/perl/BSD-stat/trunk/t/benchmark.pl

    r31712 r39168  
    11#!/usr/local/bin/perl 
    22# 
    3 # $Id: benchmark.pl,v 1.20 2002/01/26 04:17:06 dankogai Exp $ 
     3# $Id: benchmark.pl,v 1.21 2012/08/19 13:29:26 dankogai Exp $ 
    44# 
    55 

  • lang/perl/BSD-stat/trunk/t/chflags.t

    r31712 r39168  
    11# 
    2 # $Id: chflags.t,v 1.20 2002/01/26 04:17:06 dankogai Exp $ 
     2# $Id: chflags.t,v 1.21 2012/08/19 13:29:26 dankogai Exp $ 
    33# 
    44# Before `make install' is performed this script should be runnable with 

  • lang/perl/BSD-stat/trunk/t/fields.t

    r31712 r39168  
    11# 
    2 # $Id: fields.t,v 1.20 2002/01/26 04:17:06 dankogai Exp $ 
     2# $Id: fields.t,v 1.21 2012/08/19 13:29:26 dankogai Exp $ 
    33# 
    44# Before `make install' is performed this script should be runnable with 

  • lang/perl/BSD-stat/trunk/t/filehandle.t

    r31712 r39168  
    11# 
    2 # $Id: filehandle.t,v 1.20 2002/01/26 04:17:06 dankogai Exp $ 
     2# $Id: filehandle.t,v 1.21 2012/08/19 13:29:26 dankogai Exp $ 
    33# 
    44# Before `make install' is performed this script should be runnable with 

  • lang/perl/BSD-stat/trunk/t/object.t

    r31712 r39168  
    11# 
    2 # $Id: object.t,v 1.20 2002/01/26 04:17:06 dankogai Exp $ 
     2# $Id: object.t,v 1.21 2012/08/19 13:29:26 dankogai Exp $ 
    33# 
    44# Before `make install' is performed this script should be runnable with 

  • lang/perl/BSD-stat/trunk/t/statcache.t

    r31712 r39168  
    11# 
    2 # $Id: statcache.t,v 1.20 2002/01/26 04:17:06 dankogai Exp $ 
     2# $Id: statcache.t,v 1.21 2012/08/19 13:29:26 dankogai Exp $ 
    33# 
    44# Before `make install' is performed this script should be runnable with 

  • lang/perl/BSD-stat/trunk/t/underscore.t

    r31712 r39168  
    11# 
    2 # $Id: underscore.t,v 1.20 2002/01/26 04:17:06 dankogai Exp $ 
     2# $Id: underscore.t,v 1.21 2012/08/19 13:29:26 dankogai Exp $ 
    33# 
    44# Before `make install' is performed this script should be runnable with