Skip to content
Permalink
master
Switch branches/tags

Name already in use

A tag already exists with the provided branch name. Many Git commands accept both tag and branch names, so creating this branch may cause unexpected behavior. Are you sure you want to create this branch?
Go to file
 
 
Cannot retrieve contributors at this time
package EPrints::Plugin::Stats::Processor::Access::Referrer;
our @ISA = qw/ EPrints::Plugin::Stats::Processor::Access /;
use strict;
# Processor::Access::Referrer
#
# Processes the Referrer from Access records. Provides the 'eprint_referrer' datatype
#
# Note that it is possible to define local domains e.g. your local Uni intranet.
#
sub new
{
my( $class, %params ) = @_;
my $self = $class->SUPER::new( %params );
$self->{provides} = [ "referrer" ];
$self->{disable} = 0;
$self->{cache} = {};
if( defined $self->{session} )
{
$self->{host} = $self->{session}->config( "host" );
$self->{domains} = $self->{session}->config( "irstats2", "local_domains" );
}
$self->{domains} ||= {};
$self->{conf} = {
fields => [ 'value' ],
render => 'string',
};
return $self;
}
sub process_record
{
my ($self, $record, $is_download) = @_;
my $epid = $record->{referent_id};
return unless( defined $epid );
my $ref = $record->{referring_entity_id};
return unless( EPrints::Utils::is_set( $ref ) );
# and unescaping the %XX characters:
$ref =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
my $referrer = $self->get_referrer( $ref );
return unless( defined $referrer );
my $date = $record->{datestamp}->{cache};
$self->{cache}->{"$date"}->{$epid}->{$referrer}++;
}
sub get_referrer
{
my( $self, $ref ) = @_;
my( $protocol, $hostname, $uri ) = EPrints::Plugin::Stats::Utils::parse_url( $ref );
unless( defined $hostname )
{
## print STDERR "\nReferrer improvement? Failed to parse '$ref'";
return undef;
}
# Internal hit
if( $hostname eq 'localhost' )
{
return 'Internal (Abstract page)'; # if( $uri =~ /^\/\d+$/ );
}
# Internal hit via OAI
if( $protocol eq 'info:oai' )
{
return 'Internal (OAI-PMH)';
}
if( $hostname eq $self->{host} )
{
return 'Internal (Abstract page)' if( $uri =~ /^\/\d+$/ );
return 'Internal (Search)' if( $uri =~ m#^/cgi/search/# );
return 'Internal (Browse view)' if( $uri =~ m#^/view/# );
return 'Internal (Latest Additions)' if( $uri =~ m#^/cgi/latest# );
return 'Internal (MePrints Profile Page)' if( $uri =~ m#^/profile/# );
return 'Internal';
}
return 'Google' if( $hostname =~ /google\./ );
return 'Yahoo' if( $hostname =~ /yahoo\./ );
return 'MSN/Bing' if( $hostname =~ /(msn|bing)\./ );
return 'Facebook' if( $hostname =~ /facebook\./ );
# could have some local definitions
while( my($k,$v) = each %{$self->{domains}} )
{
return $k if( $hostname =~ /$v/ );
}
# unknown
return $hostname;
}
1;