view release on metacpan or  search on metacpan

Manager.pm  view on Meta::CPAN

sub new {
   my $self = bless {},shift;
   $self->{path} = shift;
   $self;
}

sub sync {
   my $self=shift;
   if ($self->{dirty}) {
      my @unlink = @{delete $self->{unlink}};
      $self->{dirty}=0;
      nstore $self,$self->{path}."/db"
         or die "Unable to freeze into $self->{path}/db: $!\n";
      unlink @unlink;
   }
}

sub dirty {
   my $self=shift;
   $self->{mtime}=time;
   $self->{dirty}++;
}

sub DESTROY {
   my $self=shift;
   $self->sync;
}

sub open {
   shift;
   my $path=App::Manager::LIBDIR."/".shift;
   slog 1,"opening db $path";
   retrieve $path."/db";
}

sub creat {
   my $self = bless {}, shift;
   $self->{path} = App::Manager::LIBDIR."/".shift;
   slog 1,"creating db $self->{path}";
   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],
         rdev		=> $stat[ 6],
         size		=> $stat[ 7],
         atime		=> $stat[ 8],
         mtime		=> $stat[ 9],
         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}) {
      if (S_ISREG $stat->{mode}) {
         $stat->{savetype} = 1; # none, stored
         $stat->{savepath} = $self->{path}."/".$gen;
         copy $stat->{path},$stat->{savepath}
            or die "Unable to save away file '$stat->{path}': $!\n";
      } elsif (App::Manager::S_ISLNK $stat->{mode}) {
         $stat->{symlink}=readlink $stat->{path}
            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";
         } else {
            my $samecontent;
            $msg = "content changed";
            if (S_ISREG $stat->{mode}) {
               $samecontent = !compare ($stat->{path}, $stat->{savepath});
               if ($samecontent) {
                  unlink delete $stat->{savepath};
                  $stat->{savetype} = 0;
               }
            } elsif (S_ISDIR $stat->{mode}) {
               $samecontent = 1;
            } elsif (S_ISLNK $stat->{mode}) {
               $samecontent = $stat->{symlink} eq readlink $stat->{path};
            }
            $msg = "attributes changed" if $samecontent;
            if ($samecontent
                && $stat->{uid} eq $nstat->{uid}
                && $stat->{gid} eq $nstat->{gid}
                && $stat->{size} eq $nstat->{size}
                && ($level > 0 || $stat->{mtime} eq $nstat->{mtime})) {
               $msg = "no change";
               delete $self->{storage}{$stat->{id}};
               delete $self->{source}{$stat->{path}};
            }
         }
         slog 3,"$stat->{path}: $msg";
         $stat->{ctype} = $msg;
      } else {
         delete $self->{storage}{$stat->{id}};
         delete $self->{source}{$stat->{path}};
      }
   }
   $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";
         }
      } elsif (S_ISLNK $stat->{mode}) {
         remove $stat->{path};
         symlink $stat->{symlink},$stat->{path}
            or die "Unable to recreate symbolic link '$stat->{path}' => '$stat->{symlink}': $!\n";
      } elsif (S_ISDIR $stat->{mode}) {
         remove $stat->{path};
         mkdir $stat->{path},$stat->{mode} & 07777
            or die "Unable to recreate directory '$stat->{path}': $!\n";
      } else {
         die "FATAL: don't know how to check in $stat->{path}.\n";
      }
      unless (S_ISLNK $stat->{mode}) {
         chmod $stat->{mode} & 07777,$stat->{path}
            or die "Unable to change mode for '$stat->{path}': $!\n";
         chown $stat->{uid},$stat->{gid},$stat->{path}
            or warn "Unable to change user and group id for '$stat->{path}': $!\n";
         utime $stat->{atime},$stat->{mtime},$stat->{path}
            or warn "Unable to change atime and mtime for '$stat->{path}': $!\n";
      }
   }
}

# this is safe as long as we don't sync too early
sub swap {
   my $self=shift;
   slog 1,"swapping all changes";
   for my $stat (reverse sort values %{$self->{storage}}) {
      slog 2,"swapping $stat->{path}";
      # saving old version
      $self->ci($stat->{path});
      recreate $stat;
      push @{$self->{unlink}},$stat->{savepath} if exists $stat->{savepath};
      delete $self->{storage}{$stat->{id}};
   }
   slog 2,"syncing database";
   $self->dirty;
   $self->sync;
   slog 2,"optimizing database";
   $App::Manager::verbose=0;
   local $App::Manager::verbose=0;
   $self->optimize(0);
}

1;

__END__

=head1 NAME

App::Manager - Perl module for installing, managing and uninstalling software packages.

=head1 SYNOPSIS

  use App::Manager; # use appman instead

=head1 DESCRIPTION

Oh well ;) Not written yet! The manager program (appman) has documented commandlien switches, though.

=head1 AUTHOR

Marc Lehmann <pcg@goof.com>.

=head1 SEE ALSO

perl(1).

=cut