package SGI::FAM; use strict; use Carp; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD); require Exporter; require DynaLoader; require AutoLoader; @ISA = qw(Exporter DynaLoader); @EXPORT_OK = qw( FAM_DEBUG_OFF FAM_DEBUG_ON FAM_DEBUG_VERBOSE ); # $Format: "$\VERSION='$ProjectRelease$';"$ $VERSION='1.002'; sub AUTOLOAD { my $constname; ($constname = $AUTOLOAD) =~ s/.*:://; my $val = constant($constname); if ($! != 0) { if ($! =~ /Invalid/) { $AutoLoader::AUTOLOAD = $AUTOLOAD; goto &AutoLoader::AUTOLOAD; } else { croak "Your vendor has not defined SGI::FAM macro $constname"; } } eval "sub $AUTOLOAD { $val }"; goto &$AUTOLOAD; } sub DESTROY {} # Bypass AUTOLOAD bootstrap SGI::FAM $VERSION; sub err(;$) { return $_[0] if @_ and $_[0] != -1; my $err=famerror(); croak 'SGI::FAM: ' . ($err ? $err : $! ? "$!" : 'unknown error'); } { my %mapping=( FAMChanged() => 'change', FAMDeleted() => 'delete', FAMStartExecuting() => 'start_exec', FAMStopExecuting() => 'stop_exec', FAMCreated() => 'create', FAMMoved() => 'move', FAMAcknowledge() => 'ack', FAMExists() => 'exist', FAMEndExist() => 'end_exist', ); sub FAMEventPtr::type { my ($self)=@_; my $code=err $self->code; $mapping{$code} or die "SGI::FAM: Unknown event code $code"; } } use vars qw($reqcnt); $reqcnt=0; use File::PathConvert (); sub abspath($;) { my ($path)=@_; File::PathConvert::realpath($path) or die "SGI::FAM: could not resolve path $path due to component $File::PathConvert::resolved"; } 1; __END__ =head1 NAME B - Perl interface to SGI/Irix File Access Monitor =head1 SYNOPSIS use SGI::FAM; my $fam=new SGI::FAM; $fam->monitor('/foo'); $fam->monitor('/foo/bar.txt'); while (1) { my $event=$fam->next_event; # Blocks print "Pathname: ", $event->filename, " Event: ", $event->type, "\n"; } Asynchronous mode: while ($fam->pending) { my $event=$fam->next_event; # Immediate ... } # Do something else =head1 DESCRIPTION Provides a somewhat higher-level and friendlier interface to the SGI/Irix File Access Monitor API. This allows one to monitor both local and remote (NFS-mounted) files and directories for common filesystem events. To do so, you must register "monitors" on specified pathnames and wait for events to arrive pertaining to them. To get a full description of the API, you should see L. Since FAM only deals with absolute pathnames, all paths are canonicalized internally and monitors are held on canonical paths. Whenever a path is returned from this module, howvever, via B or B with no arguments, the originally specified path is given for convenience. =head1 MAIN METHODS =head2 B [ I ] Create a new FAM connection. An application name may be given. =cut sub new { my ($class, $appname)=@_; my $rawconn=new FAMConnectionPtr; err $rawconn->Open2($appname or $0); bless {conn => $rawconn, monitors => {}, debug => FAM_DEBUG_OFF(), suspended => {}, reqnums => {}}, $class; } =head2 B True if there is an event waiting. Returns immediately. =cut sub pending { my ($self)=@_; err $self->{conn}->Pending; } =head2 B [ I ] Set or query debug level. Values are B, B, and B (you should ask to import these). =cut sub debug_level { my ($self, $lvl)=@_; if (defined $lvl) { my $old=$self->{debug}; $self->{debug}=$lvl; err $self->{conn}->DebugLevel($lvl); $old; } else { $self->{debug}; } } =head2 B Returns next event in queue, as an event object. Blocks if necessary until one is available. =cut sub next_event { my ($self)=@_; my $rawev=new FAMEventPtr; err $self->{conn}->NextEvent($rawev); $rawev; } =head2 B I [ I [ I [ I I ] ] ] Monitor the specified file or directory. Expect a slew of events immediately (B and B) which may not interest you. I, if specified and true, will produce a warning if the monitored path is not unique among those already being monitored. This can be helpful for debugging, but normally this is harmless. I may be B, B or B; it defaults to B or B according to an I filesystem entry. If you specify B (collection), pass additional depth and mask arguments, if you ever figure out what that does (SGI does not say). =cut sub monitor { my ($self, $_path, $unique, $type, $depth, $mask)=@_; my $path=abspath($_path); die "SGI::FAM: `$_path' does not currently exist" unless $type or -e $_path; if (exists $self->{monitors}{$path}) { warn "SGI::FAM: attempt to re-monitor $_path (canon. $path)" if $unique; return; } my $conn=$self->{conn}; $type=(-d $path ? 'dir' : 'file') unless $type; my $rawreq=new FAMRequestPtr; $rawreq->setreqnum(++$reqcnt); $self->{monitors}{$path}=$rawreq; if ($type eq 'file') { err $conn->MonitorFile2($path, $rawreq); } elsif ($type eq 'dir') { err $conn->MonitorDirectory2($path, $rawreq); } elsif ($type eq 'coll') { err $conn->MonitorCollection($path, $rawreq, undef, $depth, $mask); } else { die "SGI::FAM: unknown monitor style $type"; } my $reqnum=$rawreq->reqnum; my $orig=$self->{reqnums}{$reqnum}; die "SGI::FAM: attempt to reuse request numbers from $orig to $_path" if $orig; $self->{reqnums}{$reqnum}=$_path; } =head2 B I Stop monitoring this path. =cut sub check_monitored { my ($self, $path)=@_; die "SGI::FAM: `$path' is not monitored" unless exists $self->{monitors}{abspath($path)}; } sub cancel { my ($self, $_path)=@_; my $path=abspath($_path); $self->check_monitored($path); err $self->{conn}->CancelMonitor($self->{monitors}{$path}); delete $self->{monitors}{$path}; } =head2 B [ I ] List all currently monitored paths, or check if a specific one is being monitored. Does not check if a monitor is suspended. =cut sub monitored { my ($self, $_path)=@_; if ($_path) { exists $self->{monitors}{abspath($_path)}; } else { my $reqnums=$self->{reqnums}; sort map {$reqnums->{$_->reqnum}} values %{$self->{monitors}}; } } =head2 B I True if the specified monitor is suspended. =cut sub suspended { my ($self, $_path)=@_; my $path=abspath($_path); $self->check_monitored($path); $self->{suspended}{$path}; } =head2 B [ I ] Suspend monitoring of a path, or all paths if unspecified. =cut sub suspend { my ($self, $_path)=@_; if ($_path) { my $path=abspath($_path); $self->check_monitored($path); return if $self->{suspended}{$path}; err $self->{conn}->SuspendMonitor($self->{monitors}{$path}); $self->{suspended}{$path}=1; } else { foreach (keys %{$self->{monitors}}) { unless ($self->{suspended}{$_}) { err $self->{conn}->SuspendMonitor($self->{monitors}{$_}); $self->{suspended}{$_}=1; } } } } =head2 B [ I ] Resume monitoring of a path, or all paths if unspecified. =cut sub resume { my ($self, $_path)=@_; if ($_path) { my $path=abspath($_path); $self->check_monitored($path); return unless $self->{suspended}{$path}; err $self->{conn}->ResumeMonitor($self->{monitors}{$path}); delete $self->{suspended}{$path}; } else { foreach (keys %{$self->{suspended}}) { err $self->{conn}->ResumeMonitor($self->{monitors}{$path}); delete $self->{suspended}{$_}; } } } =head2 B I Gives the pathname for the monitor generating this event. Often this will be the same as C<$event-Efilename>, but will differ in some cases, e.g. in B events where B will yield the basename of the new file while the B method must be invoked to determine the directory of creation, if more than one is being monitored. =cut sub which { my ($self, $event)=@_; my $reqnum=$event->fr->reqnum; $self->{reqnums}{$reqnum} or die "SGI::FAM: Monitor \x23$reqnum not found for this connection"; } =head1 EVENT METHODS =head2 B Host of event. Does not seem to work, actually. =head2 B Path of event, according to FAM. =head2 B Type of event; one of the following strings: B, B, B, B, B, B, B, B, B. =head1 BUGS Most of these can be observed with F. =over 4 =item Hostnames Do not seem to be supplied at all. =item Timing Is somewhat erratic. For example, creating a file that had been monitored and deleted will signal a B event on it, after about a second pause. =item Execute Events Are not sent, as far as the author can determine. =back =head1 SEE ALSO For the raw SGI interface (rather poorly documented), see L. =head1 AUTHORS J. Glick B. =head1 REVISION X<$Format: "F<$Source$> last modified $Date$ release $ProjectRelease$. $Copyright$"$> F last modified Thu, 25 Sep 1997 22:56:42 -0400 release 1.002. Copyright (c) 1997 Strategic Interactive Group. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut