File Coverage

blib/lib/Sys/Trace.pm

Criterion	Covered	Total	%
statement	6	32	18.7
branch	0	16	0.0
condition			n/a
subroutine	2	6	33.3
pod	4	4	100.0
total	12	58	20.6

package Sys::Trace;
use strict;
use Sys::Trace::Results;

our $VERSION = "0.03";

=head1 NAME

Sys::Trace - Interface to system call tracing interfaces

=head1 SYNOPSIS

  use Sys::Trace;

  my $trace = Sys::Trace->new(exec => [qw(ls foo)]);

  $trace->start; # Returns a PID which you can watch
  $trace->wait;  # Alternatively call this to wait on the PID

  my $result = $trace->results; # Returns a Sys::Trace::Results object

  use Cwd;
  print $result->files(getcwd . "/"); # Should show an attempt to look at "foo"
                                      # in the current directory (i.e. "ls
                                      # foo", above)

=head1 DESCRIPTION

Provides a way to programmatically run or trace a program and see the system
calls it makes.

This can be useful during testing as a way to ensure a particular file is
actually opened, or another hard to test interaction actually occurs.

Currently supported tracing mechanisms are ktrace, strace and truss.

=head1 METHODS

=cut

our @INTERFACES = qw(
  Sys::Trace::Impl::Strace
  Sys::Trace::Impl::Ktrace
  Sys::Trace::Impl::Truss
);

our @ISA;

my $interface_class = "";

=head2 new(%args)

Keys in C<%args> can be:

=over 4

=item *

B: Program and arguments to execute

=item *

B: PID of program to trace

=item *

B: Follow child processes too (default is 1, set to 0 to disable)

=back

Only one of exec or pid must be provided.

=cut

sub new {
  my($class, %args) = @_;

  if(!$interface_class) {
    for my $interface(@INTERFACES) {
      my $file = $interface;
      $file  =~ s{::}{/}g;
      $file .= ".pm";
      eval { require $file } or next;

      if($interface->usable) {
        $interface_class = $interface;
        @ISA = $interface_class;
        last;
      }
    }
  }

  if(!$interface_class) {
    require Carp;
    Carp::croak("No interface for system call tracing is available on this platform");
  }

  # Default to following forks
  $args{follow_forks} = 1 unless exists $args{follow_forks};

  return $class->SUPER::new(%args);
}

=head2 start

Start running the trace.

=cut

sub start {
  my($self) = @_;

  if(!defined $self->pid(fork)) {
    die "Unable to fork: $!";
  }

  return $self->pid if $self->pid; # parent
  $self->run;
}

=head2 wait

Wait for the trace to finish

=cut

sub wait {
  my($self) = @_;

  $? if waitpid $self->pid, 0;
}

=head2 results

Return a L object populated with the results of the trace.

=cut

sub results {
  my($self) = @_;

  return Sys::Trace::Results->new($self);
}

1;

__END__