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