~fredg/twapake

6c3bd65dec579b9a664a1fa4b616e99ae85f33b5 — Fred. Galusik 1 year, 3 months ago b68c722
mv to Twapake dir
2 files changed, 0 insertions(+), 302 deletions(-)

D Twacurse.pm
D Twapake.pm
D Twacurse.pm => Twacurse.pm +0 -119
@@ 1,119 0,0 @@
package Twacurse;

#       Twacurse.pm
#
#       This file is part of twapake
#
#       Copyright 2010-2017 Frédéric Galusik <slack~at~galusik~~dot~xyz>
#       License: BSD Revised
#
###############################################################################

use strict;
use warnings;

use Curses::UI;
use Twapake::Twapake;

our $cui;
our $listpkgbox;

#
# make da User Interface
#
sub uic {
    $cui = new Curses::UI ( -clear_on_exit => 1,
                            -color_support => 1,
                            -mouse_support => 0,
                            );
    my $win1 = $cui->add(
       'win1', 'Window',
       -title           =>
        'Twapake - Select packages for removal (^X for Menu)',
       -titlereverse    => 0,
       -padtop          => 1,
       -border          => 1,
       -ipad            => 1,
       -bold            => 0,
       -y               => 1,
       -bfg             => 'red',
    );

    my @menu = (
        { -label => 'Menu',
          -submenu => [
            { -label => 'Remove selected packages   ^R',
              -value => \&remove_pkg },
            { -label => 'Unselect All packages      ^U',
              -value => \&unselect_all },
            { -label => 'Exit                       ^Q',
              -value => \&exit_dialog }
            ]
        },
    );

    my $menu = $cui->add(
        'menu','Menubar',
        -menu => \@menu,
    );

    $cui->set_binding(sub {$menu->focus()}, "\cX");
    $cui->set_binding( \&exit_dialog , "\cQ");
    $cui->set_binding( \&remove_pkg , "\cR");
    $cui->set_binding( \&unselect_all , "\cU");

    $listpkgbox = $win1->add(
       'listpkgbox', 'Listbox',
       -width     => 50,
       -y         => 1,
       -x         => 10,
       -values    => \@Twapake::sortfiles,
       -multi     => 1,
       -intellidraw => 1,
    );

    $listpkgbox->focus();

    $cui->mainloop();
}

sub unselect_all {
    $listpkgbox->clear_selection();
    $listpkgbox->draw();
    return;
}

sub remove_pkg {
    my $yesrm = $cui->dialog(
        -message   => "Do you really want to remove ?",
        -title     => "Are you sure?",
        -bfg             => 'red',
        -buttons   => ['yes', 'no'],
    );
    if ($yesrm) {
        my @selected = $listpkgbox->get();
        foreach (@selected) {
            $cui->status("Removing $_");
            system ("$Twapake::rm_command $_ > /dev/null");
            }
        sleep(1);
        $cui->nostatus;
        # update the packages list
        Twapake->get_files();
        Twapake->sortfiles();
        unselect_all();
        return;
        }
    }

sub exit_dialog {
    my $return = $cui->dialog(
        -message   => "Do you really want to quit?",
        -title     => "Are you sure???",
        -bfg             => 'red',
        -buttons   => ['yes', 'no'],
    );
    exit(0) if $return;
}

1;

D Twapake.pm => Twapake.pm +0 -183
@@ 1,183 0,0 @@
package Twapake;

#       Twapake.pm
#
#       This file is part of twapake
#
#       Copyright 2010-2023 Frédéric Galusik <f~at~galusik~dot~fr>
#       License: BSD Revised
#
###############################################################################

use strict;
use warnings;
use POSIX;
use File::stat;
use File::Path;

#
# The place where Slackware store installed and removed packages log files
#
our $pkgdir = "/var/lib/pkgtools/packages";
our $rmpkgdir = "/var/log/removed_packages";

our $rm_command;
our $removepkg = "/sbin/removepkg";

our $file;
our @files;
our @sortfiles;
our ( $a, $b );
our $now = localtime;
our $nowfile = strftime("%Y-%m-%d-%H-%M-%S", localtime(time));

# the place to store twapake log files
our $twa_path = "/var/log/twapake";
mkpath $twa_path, 1, 0755;

sub new {
    my $self = {};
    bless ($self);
    return $self;
}

#
# check removepkg
#
sub checkrm {
    if ( -e $removepkg ) {
        $rm_command = $removepkg;
        } else {
            die "pkgtool is not installed, aborting...\n";
        }
}

#
# get the packages list
#
sub get_files {
    opendir(DIR, $pkgdir) or die "Cannot open '$pkgdir' : $!\n";
    @files = grep !/^\./, readdir(DIR);
    closedir(DIR);
    return @files;
}
get_files();

#
# get the total of installed packages
#
sub nbpkg {
    our $npkg = @files;
    return $npkg;
}

#
# build a hash with key = pkg name and value = last time modification
#
keys our %hache = @files;
foreach $file (@files) {
    our $stpkg = stat("$pkgdir/$file");
    $hache{$file} = $stpkg->mtime;
}

#
# sort hash by descending value date
#
sub sortfiles {
    @sortfiles = sort { $hache{$b} <=> $hache{$a} } @files;
    return @sortfiles;
}
sortfiles();

#
# make the twapake snapshot:
# installed date - package name
#
sub twalog {
    open(TWAFILE, ">$twa_path/${nowfile}_twapake.log");
    print TWAFILE "\nTwapake snapshot on $now\n";
    print TWAFILE '='x72 ."\n\n";
    print TWAFILE "Installed dates\t\tPackages (total: ", nbpkg(), ")\n";
    print TWAFILE '-'x19 ."\t" . '-'x45 ."\n";
    for $file (@sortfiles) {
        printf TWAFILE "%s\t%s\n",
        strftime("%Y-%m-%d %H:%M:%S", localtime($hache{$file})), $file;
    }
    close(TWAFILE);
}

#
# make a less detailed list
# give the choice of number of packages
#
our $nlpkg;
$nlpkg = nbpkg() unless defined($nlpkg);
sub checknpkg {
    if ($nlpkg > nbpkg()) {
        die "Error: only ", nbpkg(), " packages are installed.\n";
    }
}

sub sortmtimelist {
    checknpkg();
    foreach $file ( 0..($nlpkg - 1) ) {
        print "$sortfiles[$file]\n";
    }
}

#
# remove last installed packages
#
sub rmpkg {
    checknpkg();
    checkrm();
    print "Do you wish to remove all these packages ?\n";
    foreach $file ( 0..($nlpkg - 1) ) {
        print "$sortfiles[$file]\n";
    }
    print "(y)es or (n)o ? ";
    if ((my $answer = <STDIN>) =~ /^y$/i) {
        foreach $file ( 0..($nlpkg - 1) ) {
            system ("$rm_command $sortfiles[$file]");
        }
    } elsif ($answer =~ /^n$/i) {
        die "aborting ...\n";
    } else {
        chomp $answer;
        die "'$answer' is neither 'y' for 'yes' nor 'n' for 'no'\n";
    }
}

#
# show installed packages since a choosen date
#
our $choosedate;
sub userdate_default {
    my $today = strftime("%Y-%m-%d", localtime(time));
    return $today;
}
$choosedate = userdate_default() unless defined($choosedate);
sub checkdate {
    if ($choosedate =~ m!^((?:19|20)\d\d)[- /.](0[1-9]|1[012])[- /.](0[1-9]|[12][0-9]|3[01])$!) {
    # $1 year $2 month $3 day
    if ($3 == 31 and ($2 == 4 or $2 == 6 or $2 == 9 or $2 == 11)) {
      die "Sorry but this month has not 31 days!\n";
    } elsif ($3 >= 30 and $2 == 2) {
      die "Sorry but February has not as much days!\n";
    } elsif ($2 == 2 and $3 == 29 and not ($1 % 4 == 0 and ($1 % 100 != 0 or $1 % 400 == 0))) {
      die "Sorry but it is not a leap year\n";
    }
  } else {
    die "Sorry but date format must be YYYY-mm-dd!\n";
  }
}

sub installedsince {
    for $file (@sortfiles) {
        if (strftime("%Y-%m-%d %H:%M:%S", localtime($hache{$file})) gt $choosedate) {
            print "$file\n";
        }
    }
}

1;