#!/bin/bash
# vim: set et sw=4 sts=4 tw=80:
# Copyright 2005-2009 Gentoo Foundation
# Distributed under the terms of the GNU General Public License v2

# Version 1.4
#- patches from Wade Fitzpatrick for equery and fgrep suggestions (bug 125674),
#- patches from Joerge Plate for grep being called with too many arguments (bug 114155)
#- finally updated emerge syntax, brought up by nyhm (with some input from cab) in bug 128130.
# Version 1.3
# sort of a changelog if you want to call it that...
# grep -E '/usr/lib*/perl5/' */*/CONTENTS > to make my list :)
# version 1.2 - swtaylor gave some good pointers on making the tmp files, as well as reminding me of grep's -f functionality :)
# version 1.1 - Mr. Bones gave a lot of good input on cleaning up the script
# Version 1 - stuff

PERL_CLEANER_VERSION="2.7"

SUPPORTED_PMS="portage pkgcore paludis"
PMS_COMMAND=( "emerge" "pmerge" "paludis" )
PMS_OPTIONS=( "-vD1" "-Do" "-i1" )
CUSTOM_PMS_COMMAND=""

PKGS_TO_REMERGE=""

PKGS_EXCEPTIONS="dev-lang/perl sys-devel/libperl app-emulation/emul-linux-x86-baselibs"
PKGS_MANUAL=""

PKG_DBDIR=/var/db/pkg

. /etc/init.d/functions.sh || {
    echo "$0: Could not source /etc/init.d/functions.sh!"
    exit 1
}

# First and foremost - make sure we have a perl to work with...
if ! type -P perl >/dev/null 2>&1 ; then
    ewarn "NO PERL INSTALLED! (at least not in your path)"
    exit 1
fi

veinfo() {
    if [[ VERBOSE -ge $1 ]] ; then
        shift
        einfo "$@"
    fi
}

outdated_path(){
    local path="$1"

    eindent && eindent
    veinfo 3 "Check: ${path}"

    if [[ ${path} == ${path/${version}} ]] ; then
        eindent
        veinfo 3 "Found different version"
        eoutdent
        eoutdent && eoutdent
        return 0
    elif [[ ${path/${version}\/${archname%%-*}-${osname}} != ${path} && ${path} == ${path/${archname}\/} ]] ; then
        eindent
        veinfo 3 "Found different archname"
        eoutdent
        eoutdent && eoutdent
        return 0
    fi
    eoutdent && eoutdent
    return 1
}

# This is to clean out the old .ph files generated in our last perl install
ph_clean() {
    local file i
    echo
    einfo "Beginning a clean up of .ph files"
    einfo "Excluding files for ${version} and ${version}/${archname} from cleaning"
    echo

    einfo "Locating ph files for removal"
    eindent ""
    for i in /usr/lib64/perl5 /usr/lib/perl5 ; do
        [[ ! -d ${i} ]] && continue
        veinfo 3 "...in ${i}"
        while IFS= read -r -d $'\0' file ; do
             if outdated_path "${file}" ; then
                veinfo 1 "Removing: '${file}'"
                ${PRETEND} || rm "${file}"
            fi
        done < <( find ${i} -name "*.ph" -type f -print0 2>/dev/null | sort -zu )
        # Silently remove those dirs that we just emptied
        find "${i}" -depth -type d 2>/dev/null | grep -v "${gversion}" | xargs -r rmdir 2>/dev/null
    done
    eoutdent
}

# Generate ph files; this is useful if we've upgraded packages with headers so that perl knows the new info
ph_update() {
    local option dir
    [[ VERBOSE -le 1 ]] && option="-Q"
    echo
    einfo "Updating ph files."
    einfo "Ignore all \"No such file...\" messages!"
    if ${PRETEND} ; then
        einfo "Pretend. Nothing to do."
        return
    fi
    pushd /usr/include > /dev/null
    if [[ ${version} =~ ^5.(8|10) ]] ; then
        eindent
        veinfo 1 "...in /usr/include"
        h2ph ${option} * 2>/dev/null
        for dir in sys arpa netinet bits security asm gnu linux ; do
            veinfo 1 "...in /usr/include/$dir/"
            h2ph ${option} -r $dir/*
        done
        eoutdent
    else
        h2ph ${option} -a -d ${archlibexp} \
            asm/termios.h \
            syscall.h     \
            syslimits.h   \
            syslog.h      \
            sys/ioctl.h   \
            sys/socket.h  \
            sys/time.h    \
            wait.h        \
            sysexits.h
    fi
    popd > /dev/null

}

update_packages(){
    local content exp lib broken_libs

    echo
    if ${MODULES} ; then
        einfo "Locating packages for an update"
    fi
    if ${LIBPERL} ; then
        einfo "Locating ebuilds linked against libperl"
    fi

    if ${LIBPERL} ; then
        if ! type -P scanelf >/dev/null 2>&1; then
            ewarn "scanelf not found! Install app-misc/pax-utils."
            ewarn "--libperl is disbled."
            LIBPERL=false
        else
            SONAME="$(scanelf -qBS "$(readlink -f /usr/lib/libperl.so )" | awk '{ print $1 }')"
            veinfo 3 SONAME="${SONAME}"
        fi
    fi

    # iterate thru all the installed package's contents
    while IFS= read -r -d $'\0' content; do
        # extract the category, package name and package version
        #CPV=$(sed "s:${PKG_DBDIR}/\(.*\)/CONTENTS:\1:" <<< ${content} )
        CPV=${content#${PKG_DBDIR}/}
        CPV=${CPV%/CONTENTS}
        CATPKG="${CPV%-[0-9]*}"
        veinfo 3 "Checking ${CPV}"

        # exclude packages that are an exception
        exception=0
        for exp in ${PKGS_EXCEPTIONS} ; do
            if [[ -z "${CATPKG##${exp}}" ]]; then
                veinfo 2 "Skipping ${CATPKG}, reason: exception"
                exception=1
                break
            fi
        done

        [[ ${exception} == 1 ]] && continue

#        # Check if package is in PKGS_MANUAL
#        if [[ CHECK_MANUAL -ne 0 ]] ; then
#            for pkg in ${PKGS_MANUAL} ; do
#                if [ -z "${CATPKG##${pkg}}" ] ; then
#                    exception=2
#                    break;
#                fi
#            done
#        fi
        # Replace SLOT by version number when REINSTALL_IDENTICAL_VERSIONS == 1
        # Reinstall identical versions when SLOT doesn't exist, bug #201848
        if ${REINSTALL_IDENTICAL_VERSIONS} || [[ ! -f ${content/CONTENTS/SLOT} ]] ; then
                CATPKGVER="=${CPV}"
        else
                SLOT=$(< ${content/CONTENTS/SLOT})
                CATPKGVER="${CATPKG}:${SLOT}"
        fi

#        if [[ ${exception} = 2 ]] ; then
#            PKGS_TO_REMERGE="${PKGS_TO_REMERGE} ${CATPKGVER}"
#            eindent
#            einfo "Adding to list: ${CATPKGVER}"
#            eindent
#            einfo "check: manual [Added to list manually, see CHECKS in manpage for more information.]"
#            eoutdent && eoutdent
#            continue
#        fi

        if ${MODULES} ; then
            while read -r type file ; do
                shopt -s extglob
                [[ ${type} == obj ]] || continue
                [[ ${file} =~ ^/usr/(share|lib(32|64)?)/perl5 ]] || continue
                file=${file% +(!([[:space:]])) +([[:digit:]])}
                shopt -u extglob
                if ${FORCE} || outdated_path "${file}" ; then
                    PKGS_TO_REMERGE+=" ${CATPKGVER}"
                    exception=3
                    eindent
                    einfo "Adding to list: ${CATPKGVER}"
                    # Reinstall the virtual for non-identical packages too
                    # else ~cpv results in mismatches too often.
                    # Some perl-core packages do not have a virtual
                    if [[ ${CATPKGVER} == perl-core/* ]] ; then
                        for virtual in "${PKG_DBDIR}"/${CATPKG/perl-core\//virtual/perl-}-[0-9]* ; do
                            if [[ -d ${virtual} ]] ; then
                                PKGS_TO_REMERGE+=" ${CATPKGVER/perl-core\//virtual/perl-}"
                                einfo "                ${CATPKGVER/perl-core\//virtual/perl-}"
                            else
                                veinfo 1 "No virtual: ${CATPKGVER/perl-core\//virtual/perl-}"
                            fi
                        done
                    fi
                    eindent
                    veinfo 1 "check: module ${file}"
                    eoutdent
                    eoutdent
                    break
                fi
            done < "${content}"
        fi

        [[ ${exception} == 3 ]] && continue

        if ${LIBPERL} ; then
            # We assume the broken libs have all bin or lib in their path
            broken_libs="$(scanelf -qBn < <(awk '/^obj [^ ]*\/(s?bin|lib(32|64)?)\// && ! /^obj [^ ]*\/usr\/lib\/debug\//{ print $2 }' ${content} ) | grep -o 'libperl\.so\.[0-9.]*' | sort -u )"
            if [[ -n "${broken_libs}" ]] ; then
                if ${FORCE} || [[ ${broken_libs} != ${SONAME} ]] ; then
                    PKGS_TO_REMERGE+=" ${CATPKGVER}"
                    eindent
                    einfo "Adding to list: ${CATPKGVER}"
                    eindent
                    veinfo 1 "check: libperl ${broken_libs}"
                    eoutdent
                    eoutdent
                else
                    eindent
                    veinfo 2 "Not adding: ${CATPKGVER} because it should be uptodate."
                    veinfo 2 "check: libperl ${broken_libs}"
                    eoutdent
                fi
            fi
        fi
    done < <( find -L ${PKG_DBDIR} -path "*/-MERGING-*" -prune -o -name CONTENTS -print0 )
    # Pipe to command if we have one
    if [[ -n ${PIPE_COMMAND} ]] ; then
        echo "${PKGS_TO_REMERGE}" | ${PIPE_COMMAND}
        exit $?
    fi

    if [[ ${PMS_COMMAND[${PMS_INDEX}]} == emerge && -x /usr/bin/portageq ]] ; then
        # Filter out --getbinpkg, --getbinpkgonly, --usepkg and --usepkgonly options in EMERGE_DEFAULT_OPTS
        emerge_default_opts=""
        for option in $(portageq envvar EMERGE_DEFAULT_OPTS ) ; do
            if [[ "${option}" == -[[:alnum:]]* ]]; then
                [[ ${option//[gGkK]/} != - ]] && emerge_default_opts+=" ${option//[gGkK]/}"
            elif [[ "${option}" != "--getbinpkg" && "${option}" != "--getbinpkgonly" && "${option}" != "--usepkg" && "${option}" != "--usepkgonly" ]]; then
                emerge_default_opts+=" ${option}"
            fi
        done
        export EMERGE_DEFAULT_OPTS="${emerge_default_opts# }"
    fi

    # only pretending?
    ${PRETEND} && PMS_OPTIONS[${PMS_INDEX}]="${PMS_OPTIONS[${PMS_INDEX}]}p"

    # (Pretend to) remerge packages
    if [[ -n ${PKGS_TO_REMERGE} ]] ; then
        pmscmd="${CUSTOM_PMS_COMMAND}"
        [[ -z ${pmscmd} ]] && pmscmd="${PMS_COMMAND[${PMS_INDEX}]}"
        cmd="${pmscmd} ${PMS_OPTIONS[${PMS_INDEX}]} ${ADDITIONAL_OPTIONS} ${PKGS_TO_REMERGE}"
        einfo ${cmd}
        if ! ${cmd} ; then
            einfo "perl-cleaner is stopping here:"
            einfo "Fix the problem and start perl-cleaner again."
            exit 1
        fi
    else
        einfo "No package needs to be reinstalled."
    fi
}

# Assuming a successful module run, look to see whats left over
leftovers() {
    local path i perlpath=()
    echo
    einfo "Finding left over modules and header"
    echo
    einfo "The following files remain. These were either installed by hand"
    einfo "or edited. This script cannot deal with them."
    echo

    for i in /usr/{share,lib{,32,64}}/perl5 ; do
        [[ -d $i ]] && perlpath[${#perlpath[*]}]="$(readlink -f $i)"
    done
    [[ ${#perlpath[*]} == 0 ]] && return
    while IFS= read -r -d $'\0' path ; do
        if outdated_path "${path}/" ; then
            find "${path}" -type f
        fi
    done <  <( find $( for (( i=0 ; i < ${#perlpath[*]} ; i++ )) do echo ${perlpath[$i]} ; done | sort -u ) -mindepth 2 -maxdepth 2 -type d -print0 2>/dev/null )
}

usage() {
    cat << EOF_USAGE
${0##*/} -- Find & rebuild packages and Perl header files broken due to a perl upgrade

Usage: $0 [OPTION]

Options:
  -h, --help     Print usage
  -V, --version  Print version
  -p, --pretend  Pretend (don't do anything)
  -v, --verbose  Increase verbosity (may be specified multiple times)
  --modules      Rebuild perl modules for old installs of perl
  --allmodules   Rebuild all perl modules
  --libperl      Rebuild anything linked against libperl
  --ph-clean     Clean out old ph files from a previous perl
  --phupdate     Update existing ph files, useful after an upgrade to system parts like the kernel
  --phall        Short for --ph-clean --phupdate
  --all          Short for --modules --libperl --phall
  --reallyall    Short for --allmodules --libperl --phall
  --leftovers    Shows all files that were not rebuilt
  -P PM, --package-manager PM
                 Use package manager PM, where PM can be one of:
$(for p in ${SUPPORTED_PMS} ; do
echo -ne $'\t\t  '\* ${p}
if [[ ${p} == portage ]] ; then
    echo ' (Default)'
else
    echo
fi
done )
  -- OPTIONS     Pass additional options to package manager
EOF_USAGE
exit 0
}

if [[ -z "$1" ]] ; then
    usage
fi

ADDITIONAL_OPTIONS=""
REINSTALL_IDENTICAL_VERSIONS=false
ASK=false
MODULES=false
LIBPERL=false
PHCLEAN=false
PHUPDATE=false
FORCE=false
LEFTOVERS=false
PRETEND=false
VERBOSE=0

while [[ -n "$1" ]] ; do
    case "$1" in
        help|--help|-h)
            usage
            ;;
        version|--version|-V)
            echo "${PERL_CLEANER_VERSION}"
            exit 0
            ;;
        -p|--pretend|--dry-run)
            PRETEND=true
            ;;
        -v|--verbose)
            VERBOSE=$(( ${VERBOSE} + 1 ))
            ;;
        -P|--package-manager)
            shift
            PACKAGE_MANAGER="$1"
            case "${PACKAGE_MANAGER}" in
                portage|pkgcore|paludis)
                    ;;
                *)
                    echo "unrecognised package manager selected. please select between ${SUPPORTED_PMS}"
                    exit
                    ;;
            esac

            # PMS_INDEX is used to select the right commands and options for the selected package manager
            PMS_INDEX=0
            for PM in ${SUPPORTED_PMS} ; do
                [[ ${PM} == ${PACKAGE_MANAGER} ]] && break
                PMS_INDEX=$((${PMS_INDEX} + 1))
            done
            ;;
        --package-manager-command)
            shift
            CUSTOM_PMS_COMMAND="$1"
            ;;
        --reinstall-identical-versions)
            REINSTALL_IDENTICAL_VERSIONS=true
            ;;
        --leftovers|leftovers)
            LEFTOVERS=true
            ;;
        --modules|modules)
            MODULES=true
#           LEFTOVERS=true
            ;;
        --allmodules|allmodules)
            MODULES=true
            FORCE=true
            ;;
        --libperl|libperl)
            LIBPERL=true
            ;;
        --ph-clean|ph-clean)
            PHCLEAN=true
            ;;
        --phupdate|phupdate)
            PHUPDATE=true
            ;;
        --phall|phall)
            PHCLEAN=true
            PHUPDATE=true
            ;;
        --all|all)
            MODULES=true
            LIBPERL=true
            PHCLEAN=true
            PHUPDATE=true
            LEFTOVERS=true
            ;;
        --reallyall|reallyall)
            MODULES=true
            LIBPERL=true
            PHCLEAN=true
            PHUPDATE=true
            FORCE=true
            ;;
        --force|force)
            FORCE=true
            ;;
        --)
            shift
            ADDITIONAL_OPTIONS="${ADDITIONAL_OPTIONS} $*"
            break
            ;;
        *)
            usage
            echo "unrecognised option: $1"
            exit 0
            ;;
    esac
    shift
done

# version=
eval $(perl -V:version )
veinfo 2 "Installed perl version: ${version}"
# archname=
eval $(perl -V:archname )
veinfo 2 "Installed perl archname: ${archname}"
# osname=
eval $(perl -V:osname )
veinfo 2 "Installed perl osname: ${osname}"
gversion=${version//./\\\.}
# archlibexp=
# vendorarchexp=
# vendorlibexp=
eval $(perl -V:{archlib,vendorlib,vendorarch}exp )
veinfo 2 "archlibexp path: ${archlibexp}"
veinfo 2 "vendorarchexp path: ${vendorarchexp}"
veinfo 2 "vendorlibexp path: ${vendorlibexp}"

${FORCE} && version="0.0.0" && gversion="0\.0\.0"
${PHCLEAN} && ph_clean
${PHUPDATE} && ph_update
(${MODULES} || ${LIBPERL}) && update_packages
${LEFTOVERS} && leftovers

exit 0
