#!/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_pre091219"

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 INC
    echo
    einfo "Beginning a clean up of .ph files"
    einfo "Excluding files for ${version} and ${version}/${archname} from cleaning"
    echo

    INC=$(perl -e 'for $line (@INC) { next if $line eq "."; next if $line =~ m/'${gversion}'(\/'${archname}')?$/; print "$line\n" }' )
    if [[ -n "${INC}" ]]; then
        einfo "Locating ph files for removal"
        eindent ""
        veinfo 3 "...in ${INC}"
        for file in $(find ${INC} -name "*.ph" -type f 2>/dev/null | sort | uniq ); do
             if outdated_path "${file}" ; then
                veinfo 1 "Removing: ${file}"
                ${PRETEND} || rm "${file}"
            fi
        done
        eoutdent
    fi

    # Silently remove those dirs that we just emptied
    find "${INC}" -depth -type d 2>/dev/null | grep -v "${gversion}" | xargs -r rmdir 2>/dev/null
}

# 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"
    if ${PRETEND} ; then
        einfo "Pretend. Nothing to do."
        return
    fi
    cd /usr/include
    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
}

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
    for content in $(find ${PKG_DBDIR} -name CONTENTS ) ; do
        # extract the category, package name and package version
        CPV=$(echo ${content} | sed "s:${PKG_DBDIR}/\(.*\)/CONTENTS:\1:" )
        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
            for file in $(grep -Ee "^obj /usr/lib(32|64)?/perl5/" ${content} | cut -d' ' -f2 ) ; do
                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 missmatch too often.
                    # Some perl-core packages do not have a virtual
                    if [[ ${CATPKGVER} == perl-core/* ]] ; then
                        if [[ -d ${PKG_DBDIR}/${CPV/perl-core\//virtual/perl-} ]] ; 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
                    fi
                    eindent
                    veinfo 1 "check: module ${file}"
                    eoutdent
                    eoutdent
                    break
                fi
            done
        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)/{ print $2 }' ${content} ) | grep -o 'libperl\.so\.[0-9.]*' | sort | uniq )"
            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
    # 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 packages needs to be remerged."
    fi
}

# Assuming a successful module run, look to see whats left over
leftovers() {
    local inc path INC
    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

    INC=$(perl -e 'for $line (@INC) { next if $line =~ m/\.$|'${version}'(\/'${archname}')?$/; print "$line\n" }')

    for inc in ${INC} ; do
        for path in $(find $inc -mindepth 2 -maxdepth 2 -type d  2>/dev/null ) ; do
             if outdated_path "${path}/" ; then
                find ${path} -type f
            fi
        done
    done | sort -u
}

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 rebuild
  -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

# 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//./\\\.}

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

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

exit 0
