Tuesday, 13 August 2013

A Look at Touching Files

Last time, I created a function to determine if a target file was out of date with respect to its sources. Now I want a function similar to UNIX' touch(1) that will update the atime and mtime of a file. And, like touch(1), it should be able to create empty files. The way to do this is to use Perl's utime function, which is based on UNIX' utime(2) function.

Coding touch()

In UNIX, there are 3 times associated with a file. The atime which is the access time; the mtime which is the data modification time; and the ctime which is the i-node change time. The atime changes whenever the file is opened. The mtime changes whenever the file's data is changed.

The ctime is changed when the file is created or when its permissions, owner, or group is changed. It cannot be directly changed by a process; only the FS (file system) can change it. Therefore, we need not concern ourselves about it.

UNIX FSes usually have a resolution to 1 second. That is, they only round off the time to the last full second, like that given by Perl's time function.

Again, I shall place the function in MyUtils.pm. Starting with the header:

  # --------------------------------------
  #       Name: touch
  #      Usage: touch( ?%options, @files );
  #    Purpose: Updates the atime & mtime of the files.
  # Parameters: \%options -- optional options
  #                @files -- paths to files
  #    Returns: (none)
  #

  # create a block to limit scoping
  {
      my %default_options = (
          -atime  => undef,  # undef will use system time
          -mtime  => undef,  # undef will use system time
          -create => 0,      # create file if it doesn't exist
          -set    => '',     # set atime & mtime to "now" or "system",
                             #   overrides -atime, -mtime options
      );

      sub touch {

The -set option is a shortcut to set the atime and mtime to the current time or the system default. Setting the file's time to the system time means the current time for the computer where the FS is. If the FS is remotely mounted, this time may be different from the computer that issued the command.

The next step is to get the optional options.

          # Start with defaults
          my %options = %default_options;

          # look for developer's options
          if( ref( $_[0] ) && ref( $_[0] ) eq 'HASH' ){
              my %given_options = %{ shift @_ };

              # use a slice to copy
              @options{ keys %given_options } = values %given_options;

          } # end if

This can be done because all of the sub's arguments are expected to be scalars except the optional options, which are a hash reference.

Now, check for the -set option:

          # check for set, overrides -atime & -mtime options
          if( $options{-set} eq 'now' ){
              $options{-atime} = $options{-mtime} = time;

          }elsif( $options{-set} eq 'system' ){
              $options{-atime} = $options{-mtime} = undef;

          } # end if

Now, there's a bug in utime that doesn't allow undef to be passed. So, the times have to be changed to now or there will be an uninitiated warning and the times will be set to zero.

          # because of a bug in utime,
          # set undef times to now
          my $now = time;
          if( ! defined $options{-atime} ){
              $options{-atime} = $now;
          } # end if
          if( ! defined $options{-mtime} ){
              $options{-mtime} = $now;
          } # end if

Now, the working part of the sub:

          # check files one at a time
          for my $file ( @_ ){

Check to see if the programmer wants the file created and that it does not exists.

              # create missing file?
              if( $options{-create} && ! -e $file ){

                  # create via append, which does not destroy existing file
                  open  my $fh, '>>', $file or croak "touch(): could not create $file: $OS_ERROR\n";
                  close    $fh              or croak "touch(): could not create $file: $OS_ERROR\n";

              } # end if

Note the use of open-to-append mode. This does not destroy an existing file. This should not matter since the existence of the file was checked before, but paranoia is a healthy sign of defensive programming.

Change the file's times.

              if( ! utime( $options{-atime}, $options{-mtime}, $file )){
                  croak "touch(): could not touch $file\n";
              }

The utime function returns the number of files changed. Since it is given only one file, a zero returned means it failed. The uninitialized warnings are turned off so that the time options may have undef as a value.

Now finish up.

          } # end for file

          return;

      } # end sub touch
  } # end isolation block

Tests for touch()

Create a script in ~/perl5/lib/t/MyUtils to test touch().

  $ cd ~/perl5/lib/t/MyUtils
  $ >03-touch.t
  $ chmod a+X 03-touch.t

Now open the script in your favourite editor and add:

  #!/usr/bin/env perl

  use strict;
  use warnings;

  use English qw( -no_match_vars );  # Avoids regex performance penalty

  use Test::More;
  BEGIN{ use_ok( 'MyUtils' ); }  # test #1: check to see if module can be compiled
  my $test_count = 1;            # 1 for the use_ok() in BEGIN

  use MyUtils qw( touch );       # import the touch() function

Now, we're going to need some file names for testing. We'll use some of the standard modules to create unique names.

  use File::Basename;
  ( my $self = basename( $0 )) =~ s{ \. .* \z }{}msx;

  use File::Spec;
  my $tmp_dir = File::Spec->tmpdir();

  my $file_1 = "$tmp_dir/${self}_file_1_$PID.tmp";
  my $dir_1  = "$tmp_dir/${self}_dir_1_$PID.tmp";

  # remove the files when done
  END {
      unlink $file_1;
  }

The END block will remove them when the script finishes.

Test 1: Touching a Non-existing File

This test expects an exception as its result, so it is isolated within a block so that the use of Perl's special variable, $EVAL_ERROR, will not interfere with other uses. This is not required in this script, but isolation of special variables is a good habit to get into.

  # Test 1: touch a non-existing file
  # isolate the localization of the special variables
  {
      local $EVAL_ERROR;

      my $expected = "touch(): could not touch $file_1\n";
      eval {
          touch( $file_1 )
      };
      my $actual = substr( $EVAL_ERROR, 0, length( $expected ));

      is( $actual, $expected, 'test non-existing file' );
      $test_count ++;
  }

The actual variable is the first part of the eval error because croak() adds the path to the test script to it. This means it may have different values on different machines. So, that part is removed for the test.

Test 2: Creating a Non-existing File

This test has two parts. First, create the file. Second, make sure it has been created.

  # Test 2: Creating a non-existing file
  # isolate the localization of the special variables
  {
      local $EVAL_ERROR;

      my $expected = '';
      eval {
          touch( { -create => 1, }, $file_1 )
      };
      my $actual = $EVAL_ERROR;

      is( $actual, $expected, 'create non-existing file, part 1' );
      $test_count ++;

      $expected = 1;
      $actual   = -f $file_1;
      is( $actual, $expected, 'create non-existing file, part 2' );
      $test_count ++;
  }

Since the $EVAL_ERROR is expected to be empty, the substr has to be removed. The file test, -f, checks to see if the file is a regular file. It returns 1 if it is, else undef.

Test 3: Attempting to Create an Invalid File

This test attempts to create a file in a non-existent directory.

  # Test 3: Attempting to Create an Invalid File
  # isolate the localization of the special variables
  {
      local $EVAL_ERROR;

      my $file = "$dir_1/tmp.tmp";

      my $expected = "touch(): could not create $file";
      eval {
          touch( { -create => 1, }, $file )
      };
      my $actual = substr( $EVAL_ERROR, 0, length( $expected ));

      is( $actual, $expected, 'creating an invalid file' );
      $test_count ++;
  }

Test 4: Test Set to Now

Now that we're fairly sure that touch() throws its exceptions correctly, it is time to test it's ability to change the time of the files. I shall put only one test here since the remaining are all similar.

  # Test 4: test set to now
  my $old_mtime = (stat( $file_1 ))[9];
  sleep 2;
  touch( $file_1 );
  my $new_mtime = (stat( $file_1 ))[9];

  isnt( $old_mtime, $new_mtime, "test changing mtime: $old_mtime, $new_mtime" );
  $test_count ++;

First, the file time(s) are recorded. Then, touch() is called and the new time(s) are compared to the previous.