view release on metacpan or  search on metacpan

bin/rm_package  view on Meta::CPAN

        say STDERR YELLOW, "INFO:", RESET, " The following paths will be removed from PATH: ", join(", ", @paths_to_delete);
    } else {
        say STDERR YELLOW, "INFO:", RESET, " No paths found in $package_bin, defaulting to $package_path";
        @paths_to_delete = [$package_path];
    }
} else {
    say STDERR timelog("rm_package"), RED, "WARNING:", RESET, " Package binary not found at $package_bin";
}

# remove duplicates from @paths_to_delete
my %seen = ();
@paths_to_delete = grep { !$seen{$_}++ } @paths_to_delete;  

for my $package_path (sort @paths_to_delete) {
    if (-d $package_path) {
        my $all_files = `find $package_path -type f`;
        my $all_dirs  = `find $package_path -depth -type d `;
        push @files_to_delete, split /\n/, $all_files;
        push @files_to_delete, split /\n/, $all_dirs;
        push @files_to_delete, $package_path;
    } else {
        say STDERR timelog(), RED, "WARNING:", RESET, " Package path not found at $package_path";
    }
}
if (@files_to_delete == 0) {
    say "No files found for package '$package'. Nothing to delete.";
    exit 0;
}

# Sort files_to_delete so that deeper paths come first
@files_to_delete = sort { length($b) <=> length($a) } @files_to_delete;

# Print files to be deleted
say STDERR timelog("rm_package"), "The following files/directories will be deleted:";
my @images = ();
foreach my $file (@files_to_delete) {
    say "$file";
    push @images, getimage($file) if -f "$file";
}
foreach my $image (@images) {
    say "$image";
}

# Check file ownership
my $current_user = $ENV{USER};
my $current_uid = getpwnam($current_user);
my @unauthorized_files = ();

foreach my $file (@files_to_delete) {
    if (-e $file) {
        my $file_uid = (stat($file))[4];
        if ($file_uid != $current_uid) {
            push @unauthorized_files, $file;
        }
    }
}

if (@unauthorized_files > 0) {
    say STDERR RED, "ERROR:", RESET, " The following files/directories are not owned by $current_user:";
    foreach my $file (@unauthorized_files) {
        my $owner = getpwuid((stat($file))[4]) || "unknown";
        say STDERR "  $file (owner: $owner)";
    }
    say STDERR RED, "ERROR:", RESET, " For security reasons, you can only delete files owned by your user.";
    exit 1;
}

# In default mode (dry run), just exit unless --remove is specified
if (!$remove) {
    say STDERR timelog("rm_package"), "Dry run completed. No files were deleted.";
    say STDERR YELLOW, "INFO:", RESET, " Use --remove to actually delete these files.";
    exit 0;
}

# Ask for confirmation if not forced
if (!$force) {
    print STDERR BOLD, "Proceed with deletion? [y/N] ", RESET;
    my $answer = <STDIN>;
    chomp $answer;
    if (lc($answer) ne 'y') {
        say "Deletion cancelled.";
        exit 0;
    }
}

# Perform deletion
my $success = 1;
foreach my $file (@files_to_delete) {
    if (-f $file) {
        if (unlink $file) {
            say STDERR "Deleted file: $file";
        } else {
            say STDERR "ERROR: Failed to delete file $file: $!";
            $success = 0;
        }
    } elsif (-d $file) {
        if (remove_tree($file, {verbose => 1, safe => 1})) {
            say STDERR "Deleted directory: $file";
        } else {
            say STDERR "ERROR: Failed to delete directory $file: $!";
            $success = 0;
        }
    }
}

if ($opt_del_image)  {
    foreach my $image (@images) {
        if (-f $image) {
            # Check image ownership
            my $image_uid = (stat($image))[4];
            if ($image_uid != $current_uid) {
                my $owner = getpwuid($image_uid) || "unknown";
                say STDERR RED, "ERROR:", RESET, " Cannot delete image $image: owned by $owner, not $current_user";
                $success = 0;
                next;
            }
            
            if (unlink $image) {
                say STDERR "Deleted image: $image";
            } else {
                say STDERR "ERROR: Failed to delete image $image: $!";
                $success = 0;
            }
        }
    }
}

if ($success) {
    say "Package '$package' successfully removed.";
} else {
    say STDERR "WARNING: Some errors occurred during removal.";
    exit 1;
}

sub usage {
    say STDERR <<END;
rm_package PACKAGE_NAME [--remove] [--force]

Type --help for more information.
END
}

sub getpaths {
    my $file = shift;
    my @paths = ();
    
    # Check if file exists and is readable
    unless (-e $file && -r $file) {
        warn "Cannot read file: $file\n";
        return @paths;
    }
    
    # Open the file
    open(my $fh, '<', $file) or do {
        warn "Could not open file '$file': $!\n";
        return @paths;
    };
    
    # Read line by line
    while (my $line = <$fh>) {
        chomp $line;
        
        # Skip comments and empty lines
        next if $line =~ /^\s*#/ or $line =~ /^\s*$/;
        
        # Look for export PATH= statements
        if ($line =~ /^\s*export\s+PATH=([^:]+)(?::.*)?$/) {
            push @paths, $1;
        }
        # Also match PATH=$PATH:new_path format
        elsif ($line =~ /^\s*export\s+PATH=.*:([^:]+)(?::.*)?$/) {
            push @paths, $1;