Revert "Embed Safe 2.07 into Vend::Safe to avoid various problems with recent version...
[interchange.git] / code / UI_Tag / traffic_report.coretag
1 # Copyright 2002-2007 Interchange Development Group and others
2
3 # This program is free software; you can redistribute it and/or modify
4 # it under the terms of the GNU General Public License as published by
5 # the Free Software Foundation; either version 2 of the License, or
6 # (at your option) any later version.  See the LICENSE file for details.
7
8 # $Id: traffic_report.coretag,v 1.6 2007-03-30 23:40:54 pajamian Exp $
9
10 UserTag traffic-report Order   save
11 UserTag traffic-report addAttr
12 UserTag traffic-report Version $Revision: 1.6 $
13 UserTag traffic-report Routine <<EOR
14 sub {
15         my ($save, $opt) = @_;
16
17         use Search::Dict;
18
19         my %header = (
20                 date    => errmsg('Date'),
21                 affiliate       => errmsg('Affiliate'),
22                 campaign        => errmsg('Campaign'),
23                 visits  => errmsg('Visits'),
24                 hits    => errmsg('Hits'),
25                 pages   => errmsg('Pages'),
26                 views   => errmsg('Prod. views'),
27                 incart  => errmsg('Items in cart'),
28                 orders  => errmsg('Orders'),
29         );
30
31         my %hmap = qw/
32                 VIEWPAGE pages
33                 VIEWPROD views
34                 ADDITEM  incart
35                 ORDER    orders
36         /;
37
38         if(ref $opt->{header}) {
39                 for(keys %{$opt->{header}}) {
40                         $header{$_} = errmsg($opt->{header}{$_});
41                 }
42         }
43
44         my $cols = $opt->{show} || 'date affiliate visits hits pages views incart orders';
45         my @cols = grep /\w/, split /[\0,\s]+/, $cols;
46         my $numcols = scalar(@cols);
47
48         my @out = <<EOF;
49 <TABLE width="90%" border=0 cellpadding=0 cellspacing=0>
50 <tr class=rborder height=1><td colspan=8></td></tr>
51 <TR class=rmarq>
52 EOF
53         for(@cols) {
54                 push @out, "<TD VALIGN=top>$header{$_}</td>";
55         }
56
57         push @out, <<EOF;
58 </TR>
59 <tr class=rborder height=1><td colspan=8></td></tr>
60 EOF
61
62         my $file = $Vend::Cfg->{TrackFile};
63         unless (-f $file) {
64                 push @out, "<tr><td colspan=$numcols class=error>No traffic statistics found</td></tr></table>";
65                 return;
66         }
67
68         unless(open REPORT, "< $file") {
69                 push @out, "<tr><td colspan=$numcols class=error>Cannot open file $file</td></tr></table>";
70                 return;
71         }
72
73         my $affiliate = $opt->{affiliate} || $CGI::values{affiliate};
74         my $begin_date = $opt->{begin_date} || $CGI::values{ui_begin_date};
75         my $end_date = $opt->{end_date} || $CGI::values{ui_end_date};
76         my $Tag = new Vend::Tags;
77
78         if($begin_date) {
79                 $begin_date = filter_value('date_change', $begin_date);
80                 look(\*REPORT, $begin_date) if $begin_date;
81         }
82
83         $end_date = filter_value('date_change', $end_date)
84                 if $end_date;
85
86         my %names = qw/
87                  01 January
88                  02 February
89                  03 March
90                  04 April
91                  05 May
92                  06 June
93                  07 July
94                  08 August
95                  09 September
96                  10 October
97                  11 November
98                  12 December
99         /;
100
101     my $timeout = $::Variable->{VISIT_TIMEOUT} || (30 * 10);
102
103         my $by_day = $opt->{by_day} || $CGI::values{ui_by_day};
104         my $len;
105         $len = $by_day ? 8 : 6;
106
107         my $done;
108         my $prev;
109         my $break_check = sub {
110                 if(! defined($prev)) {
111                         $prev = $_[0];
112                         return;
113                 }
114                 if ($end_date and $_[0] gt $end_date) {
115                         $done = 1;
116                         return 1;
117                 }
118                 return if $_[0] eq $prev;
119                 $prev = $_[0];
120                 return 1;
121         };
122
123
124   BREAK: {
125     my $hits;
126     my $interval_count = 0;
127     my $interval_total = 0;
128     my $max_interval = 0;
129     my $min_interval = 9999999;
130     my $out = '';
131     my $visits;
132     my $visit_number;
133     my %action_by_aff;
134     my %action_by_day;
135     my %action_by_period;
136     my %action_by_tag;
137     my %action_by_visit;
138     my %action_by_visit_number;
139     my %actions_per_visit_boolean;
140     my %hits_by_day;
141     my %hits_by_item;
142     my %hits_by_page;
143     my %hits_by_period;
144     my %hits_by_session;
145     my %last_access;
146     my %session_by_order;
147     my %session_by_page;
148     my %visit_by_aff;
149     my %visit_by_aff_by_day;
150     my %visit_by_aff_by_period;
151     my %visit_by_day;
152     my %visit_by_ip;
153     my %visit_by_period;
154     my %visit_by_session;
155     my %visit_by_user;
156     my %visit_number;
157
158
159
160         my $donelines = 0;
161
162         ## To fudge around break
163         my $saved_line;
164         my $recall;
165
166         COUNT:
167         while (<REPORT>) {
168                 chop;
169
170                 ## To fudge around break, so that we can break then recall
171                 ## the line where we broke
172                 if($recall) {
173                         $saved_line = $_;
174                         $_ = $recall;
175                         undef $recall;
176                 }
177                 my $line = [ split /\t/, $_ , 7];
178
179                 my $per = substr($line->[0], 0, $len);
180                 $break_check->($per)
181                         and do {
182                                 $recall = $_;
183                                 last COUNT;
184                         };
185                 next if $affiliate and $line->[5] ne $affiliate;
186                 my $update_visit;
187                 my $interval;
188                 $hits++;
189                 $hits_by_period{$per}++;
190                 $hits_by_day{$line->[0]}++;
191                 $hits_by_session{$line->[1]}++
192                         or $update_visit = 1;
193                 
194                 $interval = $line->[4] - $last_access{$line->[1]}
195                         if  $last_access{$line->[1]};
196                 if($interval) {
197                         $max_interval = $interval 
198                                 if $interval > $max_interval;
199                         $min_interval = $interval 
200                                 if $interval < $min_interval;
201                         $interval_total += $interval;
202                         $interval_count++;
203                         $update_visit = 1 if $interval > $timeout;
204                 }
205                 $last_access{$line->[1]} = $line->[4];
206
207                 if($update_visit) {
208                         $visits++;
209                         $visit_number = "$line->[1]:" . $visit_by_session{$line->[1]}++;
210                         $visit_by_period{$per}++;
211                         $visit_by_day{$line->[0]}++;
212                         $visit_by_user{$line->[2]}++;
213                         $visit_by_ip{$line->[3]}++;
214                         $visit_by_aff{$line->[5]}++;
215                         $visit_by_aff_by_period{$per}{$line->[5]}++;
216                         $visit_by_aff_by_day{$line->[0]}{$line->[5]}++;
217                 }
218
219                 # Leave this at & instead of UrlJoiner because of Vend::Track
220                 my (@items) = split /(?:^|&)([A-Z]+)=/, $line->[6];
221                 shift @items;
222 #::logDebug("items = " . ::uneval(\@items)) if $line->[6] =~ / \& /;
223                 while (@items) {
224                         my($tag, $val) = splice(@items, 0, 2);
225                         $action_by_visit{$tag}++
226                                 unless $action_by_visit_number{$visit_number}{$tag}++;
227                         $action_by_tag{$tag}{$val}++;
228                         $action_by_aff{$line->[5]}{$tag}++;
229                         $action_by_period{$per}{$tag}++;
230                         $action_by_day{$line->[0]}{$tag}++;
231                 }
232
233                 ## To fudge around break
234                 if($saved_line) {
235                         $_ = $saved_line;
236                         undef $saved_line;
237                         redo COUNT;
238                 }
239         }
240 #::logDebug("action_by_visit=" . ::uneval(\%action_by_visit));
241         foreach my $one (sort keys %visit_by_period) {
242                 my ($yr, $mon, $day) = $one =~ /(\d\d\d\d)(\d\d)(\d\d)?/;
243                 my $date;
244                 my %output;
245                 push @out, "<TR class=rnorm>\n";
246                 $date = $day ? "$names{$mon} $day, $yr" : "$names{$mon} $yr";
247                 $output{date} = <<EOF;
248 <TD VALIGN="top">
249 $date
250 </TD>
251 EOF
252                 my (@number) = grep /\S/, keys %{ $visit_by_aff_by_period{$one} };
253                 my $count = scalar(@number);
254                 $output{affiliate} = <<EOF;
255 <TD VALIGN="top" ALIGN=CENTER>
256 $count
257 </TD>
258 EOF
259
260                 $output{visits} = <<EOF;
261 <TD VALIGN="top" ALIGN=CENTER>
262 $visit_by_period{$one}
263 </TD>
264 EOF
265
266                 $output{hits} = <<EOF;
267 <TD VALIGN="top" ALIGN=CENTER>
268 $hits_by_period{$one}
269 </TD>
270 EOF
271                 for(qw/ VIEWPAGE VIEWPROD ADDITEM ORDER /) {
272                         $count = $action_by_period{$one}{$_} || 0;
273                         my $pct = '';
274                         $pct = $action_by_visit{$_} / $visit_by_period{$one} * 100
275                                 if $visit_by_period{$one};
276                         $pct = $pct <= 0 ? '' : sprintf( "<FONT SIZE=1><BR>%.2f%%</FONT>", $pct);
277                         $output{$hmap{$_}} = <<EOF;
278 <TD VALIGN="top" ALIGN=CENTER>
279 $count$pct
280 </TD>
281 EOF
282                 }
283                 for(@cols) {
284                         push @out, $output{$_};
285                 }
286                 push @out, '</TR>';
287         }
288         
289         redo BREAK unless $done or eof(REPORT);
290   }
291   push @out, <<EOF;
292 <tr class=rborder height=1><td colspan=8></td></tr>
293 </TABLE>
294 EOF
295   return join "\n", @out;
296 }
297 EOR