App-Manager

 view release on metacpan or  search on metacpan

Manager.pm  view on Meta::CPAN

   @EXPORT_OK = (@EXPORT,qw(slog S_ISLNK S_ISREG S_ISDIR S_IFMT));
   $VERSION = '0.03';
}

bootstrap App::Manager $VERSION;

$verbose=0;

$unix_path = (eval { File::Spec->tmpdir } || "/tmp")."/installtracer_socket$$~";

sub slog($@) {
   (print STDERR "APPMAN: ",@_,"\n") if $verbose => shift;
}

my $sizeof_int = length pack "i",0;

my $unix;	# unix listening socket
my $fh;		# the filehandle
my $change_cb;	# call before every change

sub xread($) {
   my $len=shift;
   my $buff;
   while ($len) {
      my $read = sysread $fh,$buff,$len,length($buff);
      redo if !$read && $! == EAGAIN;
      $read>0 or die "\n";
      $len -= $read;
   }
   $buff;
}

sub get_char() { xread 1 }
sub get_int() { unpack "i", xread $sizeof_int }
sub get_str() { xread get_int }

# read cwd, pathname and canonicalize it
sub get_abspath() {
   my $path = File::Spec->catdir(get_str,get_str);
   my($base,$dir)=fileparse($path);
   
   $abspath{$dir} = Cwd::abs_path($dir) unless defined $abspath{$dir};
   File::Spec->canonpath("$abspath{$dir}/$base$suffix");
}

sub handle_msg {
   my $type = get_char;

Manager.pm  view on Meta::CPAN

      my $pid = get_int;
      # process $pid just connected.. fine
   } else {
      die "illegal message received: MSG $type, pid $pid\n";
   }
   1;
}

END { unlink $unix_path }

sub init_tracer() {
   $unix = new IO::Socket::UNIX Local => $unix_path, Listen => 1;
   $unix or die "Unable to create unix domain socket '$unix_path' for listening: $!\n";

   -x LIBTRACER_SO
      or die "FATAL: tracer helper object '".LIBTRACER_SO."' not executable!\n";
}

sub stop_tracer() {
   unlink $unix_path; undef $unix_path;
}

sub run_tracer() {
   my($rm,$r,$handles);

   vec($rm,fileno($unix),1)=1;

   while(!$server_quit) {
      if(select($r=$rm,undef,undef,undef)>0) {
         if ($unix && vec($r,fileno($unix),1)) {
            $fh = $unix->accept;
            $handles{fileno $fh} = $fh;
            vec($rm,fileno($fh),1)=1;

Manager.pm  view on Meta::CPAN

                  undef $fh;
                  die $@ if $@ && $@ ne "\n";
               }
            }
         }
      }
   }
}

# launch a single program and update %before hashes.
sub trace_program($@) {
   $change_cb = shift;
   
   init_tracer;
   
   $server_quit = 0;
   local $SIG{CHLD} = sub { $server_quit = 1 };

   if (fork == 0) {
      $ENV{LD_PRELOAD}=join(":",LIBTRACER_SO,split /:/,$ENV{LD_PRELOAD});
      $ENV{INSTALLTRACER_SOCKET}=$unix_path;

Manager.pm  view on Meta::CPAN

   system 'rm','-rf',$self->{path};
   mkdir $self->{path},0777
      or die "Unable to create database '$self->{path}': $!\n";
   $self->{genfile} = 'Xaaaaaa';
   $self->{ctime} = time; # now this really is the _creation_ time
   $self->{version}=$VERSION;
   $self->dirty;
   $self;
}

sub xlstat($) {
   my @stat = lstat $_[0];
   @stat ?
      {
         path		=> $_[0],
         dev		=> $stat[ 0],
         ino		=> $stat[ 1],
         mode		=> $stat[ 2],
         nlink		=> $stat[ 3],
         uid		=> $stat[ 4],
         gid		=> $stat[ 5],

Manager.pm  view on Meta::CPAN

         ctime		=> $stat[10],
         blksize	=> $stat[11],
         blocks		=> $stat[12],
      }
   :
      {
         path	=> $_[0],
      }
}

sub ci($$) {
   my $self=shift;
   my $stat=xlstat shift;
   my $gen = $self->{genfile}++;

   $stat->{id} = $gen;

   $self->{storage}{$gen}=
   $self->{source}{$stat->{path}}=$stat;

   if (defined $stat->{mode}) {

Manager.pm  view on Meta::CPAN

            or die "Unable to read symlink '$stat->{path}': $!\n";
      } elsif (App::Manager::S_ISDIR $stat->{mode}) {
         # nothing to do
      } else {
         die "FATAL: Don't know how to check in $stat->{path}.\n";
      }
   }
   $self->dirty;
}

sub optimize($$) {
   my $self=shift;
   my $level=shift;
   slog 1,"checking for differences between database and filesystem";
   for my $stat (values (%{$self->{storage}})) {
      my $msg;
      my $nstat = xlstat $stat->{path};
      if (defined $stat->{mode} || defined $nstat->{mode}) {
         if (($stat->{mode} ^ $nstat->{mode}) & App::Manager::S_IFMT
             || defined $stat->{mode} ^ defined $nstat->{mode}) {
            $msg = "type changed";

Manager.pm  view on Meta::CPAN

      }
   }
   $self->dirty;
}

sub storage {
   my $self=shift;
   $self->{storage};
}

sub remove($) {
   my $path=shift;
   lstat $path;
   if (-e _) {
      if (-d _) {
         rmdir $path
            or warn "WARNING: Unable to remove existing directory '$path': $!\n";
      } else {
         unlink $path
            or die "Unable to remove existing object '$path': $!\n";
      }
   }
}

sub recreate($) {
   my $stat = shift;
   if (defined $stat->{mode}) {
      if (S_ISREG $stat->{mode}) {
         if (exists $stat->{savepath}) {
            remove $stat->{path};
            $stat->{savetype} == 1
               or die "Unknown savetype for file\n";
            copy $stat->{savepath},$stat->{path}
               or die "Unable to recreate file '$stat->{path}': $!\n";
         }

appman  view on Meta::CPAN

         }
      }, @cmd)
   };
   $db->optimize(0);
   if ($@) {
      $db->rollback;
      die $@;
   }
}

sub ltime($) {
   strftime "%Y-%m-%d %H:%M:%S",localtime shift;
}

sub cmd_info {
   die "no database specified\n" unless @ARGV; my $db = App::Manager::DB->open(shift @ARGV);

   print "database path: $db->{path}\n";
   print "creation time: ".(ltime $db->{ctime})."\n";
   print "modification time: ".(ltime $db->{mtime})."\n";
   while (my ($id,$stat) = each %{$db->storage}) {