/
Referrer.pm
118 lines (83 loc) · 2.52 KB
/
Referrer.pm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
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->{host} = $self->{session}->config( "securehost" ) unless EPrints::Utils::is_set( $self->{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 )
{
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( defined $self->{host} && $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;