Apache::Keywords - Store keywords as a personal profile in a cookie.

Apache-Keywords documentation Contained in the Apache-Keywords distribution.

Index

Code Index:

NAME

Top

Apache::Keywords - Store keywords as a personal profile in a cookie.

CONTENTS

Top

The package Apache::Keywords contains:

    Makefile.PL
    lib/Apache/Keywords.pm
    README
    MANIFEST

PREREQUISITES

Top

You need Apache::Constants and Apache::Cookie to use Apache::Keywords.

INSTALLATION

Top

    tar zxf Apache-Keywords-0.1.tar.gz
    perl Makefile.PL
    make
    make install

SYNOPSIS

Top

In a dynamic mod_perl source-file:

    use Apache::Keywords;

    # Create a keywords object
    $k = new Apache::Keywords;

    # Set different parameters
    $k->name('PersonalProfile');
    $k->expires('+1M');
    $k->path("/");
    $k->domain('xxx.com');

    # Get parameters
    print $k->expires;
    print $k->path;
    ...

    # Add new keywords to the profile
    $k->new_keywords($r,"horse, dog");
    # Special version for Apache::ASP
    $k->new_keywords_asp($Request,"cars, motorcycles");

    # Return the content of the cookie profile
    $hashref = $k->profile($r);
    print $hashref->{'horse'};
    %hash = %$hashref;
    # Special version for Apache::ASP
    $k->profile_asp($Request);

In a the .htaccess for apache static-files, e.g. .html-files: <Files ~ (\.html)> SetHandler perl-script PerlFixupHandler Apache::Keywords PerlSetVar KeywordsName "PersonalProfile" PerlSetVar KeywordsExpires "+1M" PerlSetVar KeywordsPath "/" PerlSetVar KeywordsDomain "xxx.com" </Files>

DESCRIPTION

Top

An Apache::Keywords class object will generate/update a cookie. The cookie contains a personal profile, e.g. counts the different keywords that are added to it. The module could be configured as a "PerlFixupHandler" for a static file in mod_perl, e.g. HTML-files. It could also be used in web scripts, like mod_perl scripts that uses Apache::ASP or Apache::Registry. In the static version, Apache::Keywords fetches the keywords from phrases like <META NAME="keywords" CONTENT="cars, motorcycles">.

METHODS

Top

The following methods could be use in dynamic web scripts:

$k = new Apache::Keywords;

Make a new Apache::Keywords object and return it.

$k->name(<name>);

Sets the name of the cookie that is used for the personal profile. Without argument, the function returns the name of the cookie.

$k->expires(<expiration time>);

Sets the cookie parameter for expiration. Without argument, the function returns the expiration time already set.

$k->path(<path>);

Sets the path to be associated with the cookie. Without argument, the function returns the path already set.

$k->domain(<domain name>);

Sets the domain name to be associated with the cookie. Without argument, the function returns the domain name already set.

$k->new_keywords($r,<string with keywords>);

Add the new keywords of this HTTP-call. The argument is a string with the different words separated with space. $r is the Apache mod_perl request object.

$k->new_keywords_asp($Request,<string with keywords>);

A special version of new_keywords() suited for Apache::ASP. The $Request object is special for Apache::ASP.

$k->profile;

Return the profile in a hash reference, e.g. profile->{'horse'} == 3, profile->{'dog'} == 2.

$k->profile_asp

A special version of profile() suited for Apache::ASP. The $Request is special for Apache::ASP.

AUTHOR

Top

Copyright 2000 Magnus Cedergren, mace@lysator.liu.se

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

Apache-Keywords documentation Contained in the Apache-Keywords distribution. 
package Apache::Keywords;
    
# Copyright 2000 Magnus Cedergren, mace@lysator.liu.se
#
# This library is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

use Apache::Constants qw(:common);
use Apache::Cookie;

use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

require Exporter;
require AutoLoader;

#Items to export to callers namespace
@EXPORT = qw();

$VERSION = '0.1';


sub new {
    my $self = {};
    $self->{EXPIRES} = undef;
    $self->{PATH} = undef;
    $self->{DOMAIN} = undef;
    bless($self);
    return $self;
}


sub name {
    my $self = shift;
    if (@_) { $self->{NAME} = shift }
    return $self->{NAME};
}


sub expires {
    my $self = shift;
    if (@_) { $self->{EXPIRES} = shift }
    return $self->{EXPIRES};
}


sub path {
    my $self = shift;
    if (@_) { $self->{PATH} = shift }
    return $self->{PATH};
}


sub domain {
    my $self = shift;
    if (@_) { $self->{DOMAIN} = shift }
    return $self->{DOMAIN};
}

# Handler be configured as a "PerlFixupHandler" in the Apache configuration.
# Automates the handling of keywords from a static file, e.g. <META KEYWORDS...
# from normal HTML-files.
sub handler {
    my ($r) = @_;
    local (*FILE,$keywords,$new_keywords);
    $new_keywords = "";
    return DECLINED if
	!$r->is_main
	    || $r->content_type ne "text/html"
		|| !open(FILE,$r->filename);
    # If it is possible, fetch the keywords for the Meta-tag of the
    # document
    my $expires = $r->dir_config('KeywordsExpires');
    my $domain = $r->dir_config('KeywordsDomain');
    my $path = $r->dir_config('KeywordsPath');
    my $name = $r->dir_config('KeywordsName');
    while(<FILE>) {
	last if m!<BODY>|</HEAD>!i;
	if (m/META\s+(NAME|HTTP-EQUIV)="Keywords"\s+CONTENT="([^"]+)"/i) {
	    $new_keywords = $2;
	}
    }
    close(FILE);
    # "Touch" the file, so that the ContentHandler really sends the file
    # (including the updated cookie)
    my $now = time;
    utime $now,$now,$r->filename;
    # If there are any new keywords from this document, update the user's
    # profile and re-store it in the cookie
    # Get old "keywords" cookie
    if (!defined($name) || $name eq "") {
        $name = "Keywords";
    }
    my $cookie = Apache::Cookie->new($r);
    $keywords = $cookie->get($name);
    # Make profile
    $keywords = make_profile($keywords,$new_keywords);
    if (defined($expires)) {
	$cookie->set(-expires => $expires);
    }
    if (defined($domain)) {
	$cookie->set(-domain => $domain);
    }
    if (defined($path)) {
        $cookie->set(-path => $path);
    }
    $cookie->set(-name => $name, -value => $keywords);
    return OK;
}


# Must be called instead of the automated handler if your webpage is delivered
# dynamically. 
sub new_keywords {
    my ($self,$r,$new_keywords) = @_;
    my ($expires,$domain,$path,$name,$keywords);
    if (length($new_keywords) > 1) {
	if (defined($self->{NAME})) {
	    $name = $self->{NAME};
	} elsif ($r) {
	    $name = $r->dir_config('KeywordsName');
	} else {
	    $name = "Keywords";
	}
	if (defined($self->{EXPIRES})) {
	    $expires = $self->{EXPIRES};
	} elsif ($r) {
	    $expires = $r->dir_config('KeywordsExpires');
	}
	if (defined($self->{DOMAIN})) {
	    $domain = $self->{DOMAIN};
	} elsif ($r) {
	    $domain = $r->dir_config('KeywordsDomain');
	}
	if (defined($self->{PATH})) {
	    $path = $self->{PATH};
	} elsif ($r) {
	    $path = $r->dir_config('KeywordsPath');
	}
        # Get old "keywords" cookie
	my $cookie = Apache::Cookie->new($r);
	$keywords = $cookie->get($name);
        # Make profile
        $keywords = make_profile($keywords,$new_keywords);
        # Replace the old cookie with a new one
	if (!defined($expires) || length($expires) <= 0) {
	    $expires = undef;
	}
	if (!defined($domain) || length($domain) <= 0) {
	    $domain = undef;
	}
	if (!defined($path) || length($path) <= 0) {
	    $path = "/";
	}
	$cookie->set(-name => $name, -value => $keywords);
	if (defined($expires)) {
	    $cookie->set(-expires => $expires);
	}
	if (defined($domain)) {
	    $cookie->set(-domain => $domain);
	}
	if (defined($path)) {
	    $cookie->set(-path => $path);
	}
	return $keywords;
   }
}


# Version of new_keywords for use with "Apache::ASP"
sub new_keywords_asp {
    my ($self,$Request,$new_keywords) = @_;
    new_keywords($self,$Request->{r},$new_keywords);
}

# Take a content profile e.g. from a page, and updated the profile from
# fetched from a users profile (stored in a cookie)
sub make_profile
{
    # Two arguments:
    my ($keywords, # e.g. "football: 3, hockey: 2"
	$new_keywords) # e.g. "fotball, swimming"
	= @_;
    local (%keywords,@keywords,@new_keywords,$i,
	   $key,$value,$row,@pair,$mx);
    $new_keywords = lc($new_keywords); # All keywords lower case
    $new_keywords =~ tr [ÅÄÖÜÉÆØ] [åäöüéæø]; # Special for Scandinavian
    # Store keywords as a hash
    @new_keywords = split(/\, */,$new_keywords);
    @keywords = split(/\, */,$keywords);
    %keywords = ();
    foreach $keyword (@keywords) {
	@pair = split(/: */,$keyword);
	if ($pair[0]) {
	    if (length($pair[1]) < 1) {	
		$pair[1] = 1;
	    }
	    $keywords{$pair[0]} = $pair[1];
	}
    }
    # Update profile with the new data
    foreach $new_keyword (@new_keywords) {
	$keywords{$new_keyword}++;
    }
    # Sort
    @keywords = ();
    while (($key,$value) = each %keywords) {
	$row = sprintf "%06d %s",$value,$key;
	@keywords = (@keywords,$row);
    }
    $keywords = "";
    @keywords = sort {$b cmp $a} @keywords;
    # Build the new profile (to be stored as a cookie)
    if ($#keywords > 200) {
	$mx = 200;
    } else {
	$mx = $#keywords;
    }
    for ($i=0;$i<=$mx;$i++) {
	$keywords[$i] = substr($keywords[$i],7);
	$keywords .= $keywords[$i].": ".$keywords{$keywords[$i]};
	if ($i < $mx) {
	    $keywords .= ", ";
	}
    }
    return $keywords;
}


# Return the profile in a hash
sub profile {
    my ($self,$r) = @_;
    my ($keywords,$cookie,@k,@item,$i);
    my %ret = ();
    my $cookie = Apache::Cookie->new($r);
    my $name = $self->name;
    if (!defined($name) || $name eq "") {
        $name = "Keywords";
    }
    $cookie = Apache::Cookie->new($r);
    $keywords = $cookie->get($name);
    @k = split(/\,\s*/,$keywords);
    for ($i=0;$i<=$#k;$i++) {
	@item = split(/\:\s*/,$k[$i]);
	$ret{$item[0]} = $item[1];
    }
    return \%ret;
}


# Version of profile for use with "Apache::ASP"
sub profile_asp {
    my ($self,$Request) = @_;
    return profile($self,$Request->{r});
}

1;


__END__