<?php // a PHP port of Porter's stemming algorithm

function stem($word) {
 	$w = strtolower(ereg_replace("'s$","",$word));
	$w = ereg_replace("[^a-z]","",$w);
	if(strlen($w)==0) return $word; // not a word to stem

	// step1a_rules
	if(ereg("[^s]s$",$w) {
		$w = ereg_replace("sses$","ss",$w);
		$w = ereg_replace("ies$","i",$w);
		$w = ereg_replace("s$","",$w);
       
	# step1b_rules. The business with rule==106 is embedded in the
	# boolean expressions here.

	if ( (ereg("[aeiouy][^aeiouy].*eed$",$w) && $w = ereg_replace("eed$","ee",$w )) || 
	    ( $w = ereg_replace("([aeiou].*)ed$","\\1",$w) || $w = ereg_replace("([aeiouy].*)ing$","\\1",$w))
		 &&  // step1b1_rules
START HERE	    ( 
		s/at$/ate/	|| s/bl$/ble/	|| s/iz$/ize/	|| s/bb$/b/	||
		s/dd$/d/	|| s/ff$/f/	|| s/gg$/g/	|| s/mm$/m/	||
		s/nn$/n/	|| s/pp$/p/	|| s/rr$/r/	|| s/tt$/t/	||
		s/ww$/w/	|| s/xx$/x/	||
		// This is wordsize==1 && CVC...addanE...
		$w = ereg_replace("^[^aeiouy]+[aeiouy][^aeiouy]$","$&e",$w);
	    )
	    ;
	# step1c_rules
#DEBUG	warn "step1c: $_\n" if
	s/([aeiouy].*)y$/$1i/;

	# step2_rules

	if (	s/ational$/ate/	|| s/tional$/tion/	|| s/enci$/ence/	||
		s/anci$/ance/	|| s/izer$/ize/		|| s/iser$/ise/		||
		s/abli$/able/	|| s/alli$/al/		|| s/entli$/ent/	||
		s/eli$/e/	|| s/ousli$/ous/	|| s/ization$/ize/	||
		s/isation$/ise/	|| s/ation$/ate/	|| s/ator$/ate/		||
		s/alism$/al/	|| s/iveness$/ive/	|| s/fulnes$/ful/	||
		s/ousness$/ous/	|| s/aliti$/al/		|| s/iviti$/ive/	||
		s/biliti$/ble/
	    ) {
	    my ($l,$m) = ($`,$&);
#DEBUG	    warn "step 2: l=$l m=$m\n";
	    $_ = $l.$m unless $l =~ /[^aeiou][aeiouy]/;
	}
	# step3_rules
	if (	s/icate$/ic/	|| s/ative$//	|| s/alize$/al/	||
		s/iciti$/ic/	|| s/ical$/ic/	|| s/ful$//	||
		s/ness$//
	    ) {
	    my ($l,$m) = ($`,$&);
#DEBUG	    warn "step 3: l=$l m=$m\n";
	    $_ = $l.$m unless $l =~ /[^aeiou][aeiouy]/;
	}

	# step4_rules
	if (	s/al$//		|| s/ance$//	|| s/ence$//	|| s/er$//	||
		s/ic$//		|| s/able$//	|| s/ible$//	|| s/ant$//	||
		s/ement$//	|| s/ment$//	|| s/ent$//	|| s/sion$/s/	||
		s/tion$/t/	|| s/ou$//	|| s/ism$//	|| s/ate$//	||
		s/iti$//	|| s/ous$//	|| s/ive$//	|| s/ize$//	||
		s/ise$//
	    ) {
	    my ($l,$m) = ($`,$&);
	# Look for two consonant/vowel transitions
	# NB simplified...
#DEBUG	    warn "step 4: l=$l m=$m\n";
	    $_ = $l.$m unless $l =~ /[^aeiou][aeiouy].*[^aeiou][aeiouy]/;
	}

	# step5a_rules
#DEBUG	warn("step 5a: $_\n") &&
	s/e$// if ( /[^aeiou][aeiouy].*[^aeiou][aeiouy].*e$/ ||
		( /[aeiou][^aeiouy].*e/ && ! /[^aeiou][aeiouy][^aeiouwxy]e$/) );

	# step5b_rules
#DEBUG	warn("step 5b: $_\n") &&
	s/ll$/l/ if /[^aeiou][aeiouy].*[^aeiou][aeiouy].*ll$/;

	# Cosmetic step 
	s/(.)i$/$1y/;
    }
    @parms;
}

1;
