view release on metacpan or  search on metacpan

Manager.pm  view on Meta::CPAN

                && ($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