#!/usr/bin/perl
#
# Jim Pitkow 	March 1998
# Xerox PARC	pitkow@parc.xerox.com
#
# @(#) $Id: dist_crunch.pl,v 1.1 1999/04/23 21:10:51 frystyk Exp $
#
# Code to extract distribtuions for HTTP-NG-WCG scenarios.  Works
# on proxy logs, but has a few bugs.  Extracts the following distributions:
#
#    Size		WWW pages with embedded media (base)
#			   Output file: base_with_
#    Size		WWW pages without embedded media (loner)
#			   Output file: base_wo_
#    Size		Embedded media
#			   Output file: embed_size_
#    Frequency		Embedded media per WWW page
#			   Output file: embed_freq_
#    Frequency		Number of page requests per site
#			   Output file: clicks_
#    Time (sec)		Reading time per WWW page
#			   Output file: reading_time_
#    Time (sec)		Total visit time per site
#			   Output file: site_time_
#    Multi		Total number & unqiue number of pages, 
#			sites visited per user
#			   Output file: user_
#
# Look for SETME: comments to locate where changes may need to
# be made to customize the routines for your system.  This code was
# written in straight forward perl to faciliate easy customization 
# at the cost of performance and compactness.
#
# This code contains the parse subroutine from Roy Fielding's 
# wwwurl package in libwwwperl in order to be self contained.
#
#
$DEBUG = 0; 

# SETME: set to the location and base filename for proxy traces
#        and the start and end time in YYMM format of traces
$base = "./log_original/log."; 
$start_time = $today = "971205"; $end_time = "971206";

%NON_HTML = ('jpg',1,'jpeg',1,'gif',1,'png',1,);
&wwwurl_init;

while ($today ne $end_time) {

   # SETME: change outfile to location & naming if you so desire
   $outfile = "processed/log_" . $today . ".dat";
   open(LOG,"> $outfile") || die "Could not open: $outfile\n";

   $outfile = "processed/clicks_" . $today . ".dat";
   open(CLICKS,"> $outfile") || die "Could not open: $outfile\n";
   $outfile = "processed/reading_" . $today . ".dat";
   open(READING,"> $outfile") || die "Could not open: $outfile\n";
   $outfile = "processed/user_" . $today . ".dat";
   open(USER,"> $outfile") || die "Could not open: $outfile\n";
   $outfile = "processed/base_with_eo_" . $today . ".dat";
   open(BASE_WITH,"> $outfile") || die "Could not open: $outfile\n";
   $outfile = "processed/base_wo_eo_" . $today . ".dat";
   open(BASE_WO,"> $outfile") || die "Could not open: $outfile\n";
   $outfile = "processed/embed_size_" . $today . ".dat";
   open(EO_SIZE,"> $outfile") || die "Could not open: $outfile\n";
   $outfile = "processed/embed_freq_" . $today . ".dat";
   open(EO_FREQ,"> $outfile") || die "Could not open: $outfile\n";
   $outfile = "processed/site_time_" . $today . ".dat";
   open(SITE_TIME,"> $outfile") || die "Could not open: $outfile\n";

   # SETME: comment these lines if you do not want headers in data files
   print CLICKS "USER\tCLICKS\n"; print READING "READING\n"; 
   print USER "USER\tTPAGES\tUPAGES\tTMEDIA\tUMEDIA\tTSITES\tUSITES\n";
   print BASE_WITH "SIZE\n"; print BASE_WO "SIZE\n"; 
   print EO_SIZE "SIZE\n"; print EO_FREQ "FREQ\n"; 
   print SITE_TIME "TIME\n"; 

   # SETME: use when there are multiple trace files per day to be 
   #        processed.  may need to add own iterator.  if one trace
   #        file per day, comment below lines and uncomment next section
   for ($inc = 0; $inc < 40; $inc++) {
      $here_file = $base . $today . "." . $inc . ".gz";
      &process_log($here_file); 
   }

   # SETME: if one trace file per day, uncomment this line
   # &process_log($here_file); 

   &get_nextday(*today); 
}

exit;

sub process_log {
   local($infile) = $_[0]; local(@in) = split(/\./,$infile);

   # SETME: if you use another compression program to compact the 
   #        traces, you may need to change the extension and 
   #        program invoked below
   $infile =~ s/97//;
   if ($in[$#in] eq "gz" && -e $infile) { `gunzip $infile`;} $infile =~ s/\.gz//; 
   if (!-e $infile) { print " WARNING: Could not access $infile\n"; return;}

   print LOG "Processing $infile\n"; 

   # SETME: to simplify tabulating each user, sort the trace file by user id
   #        followed by the time of each WWW request.  you may need to change
   #        this section to conform to your sort program
   $sorted = $infile . ".sorted"; 
   if (!-e $sorted) { `sort +1 -n $infile > $sorted`;}
   open(IN,$sorted) || die "Could not open: $sorted\n"; 

   $all = 0; $first_page = 1;

   while(<IN>) {
      # SETME: customize to the format of the proxy trace, but make sure to use
      #        the same variable names 1) $xfer is the transfer time per request
      #        and is not used curently used, but could be used to get more
      #        acccurate reading times  2) $time refers to the time of the request
      chop; ($time,$user,$http_status,$size,$xfer,$method,$url) = split(/, /);

      # SETME: add any fixes here that repair inconsistent trace file format
      if ($url eq "Hidden_Site") { $url = "http://www.private.aol.com"; $method = GET; $status = 200;}
      if ($url eq "HTTP/1.0") { $url = $method; $method = "GET"; $status = 200;}

      ($scheme,$host,$port,$path,$query,$frag) = &parse($url);
      $all++; print LOG "Processing line: $all\n" if $all % 5000 == 0;

      # collapse subdomains of a hostname into the highest domain.  this is not
      # perfect, but should be good enough for this analysis
      @dots = split(/\./,$host); 
      if ($host =~ m/\d+\.\d+\.\d+\.\d+/) {
         pop(@dots); $new_host = join(".",@dots);
      } else {
         $tail = $dots[$#dots];
         if ($tail ne "com" && $tail ne "edu" && $tail ne "gov" && 
             $tail ne "net" && $tail ne "org") {
            $new_host = $dots[$#dots-2] . "." . $dots[$#dots-1] . "." . $dots[$#dots]; 
         } else { $new_host = $dots[$#dots-1] . "." . $dots[$#dots];}
      }
 
      @suffix = split(/\./,$path); $suffix = $suffix[$#suffix]; $suffix =~ tr/A-Z/a-z/; 

      # dump user specific characterizations
      if ($old_user ne $user && $all != 1) { 
         print LOG "Switching user: $old_user --> $user\n" if $DEBUG > 3;

         # tabulate total and unique statistics for pages, media, and sites
         while (($key,$value) = each %PAGES) { $total_pages += $value;}
         while (($key,$value) = each %MEDIA) { $total_media += $value;} 
         while (($key,$value) = each %SITES) { $total_sites += $value;} 

         $uniq_pages = scalar keys %PAGES; $uniq_media = scalar keys %MEDIA;
         $uniq_sites = scalar keys %SITES;

         print USER "$user\t$total_pages\t$uniq_pages\t$total_media\t$uniq_media\t";
         print USER "$total_sites\t$uniq_sites\n";
    
         undef %PAGES; undef %MEDIA; undef %SITES;
         $total_pages = $total_media = $total_sites = 0;

         # determine the total site visit time using the last request time 
         # if the user actually visited a page, otherwise ignore
         if ($last_request_time > 0) {
            $site_time = $last_request_time - $site_start;
            print SITE_TIME "$site_time\n" if $site_time > 0;
         }

         $first_page = 1; $last_reading_time = 0;
      }
      $old_user = $user;

      # if the suffix of the page is not a recognized media type, then assume it is
      # a WWW page.  this assumption is probably better than only looking for "htm"
      # suffixes as this would miss a lot of dynamically generated content
      if (!defined $NON_HTML{$suffix}) {

         $PAGES{$url}++;

         # determine reading time per page.  $first_page flag is used
         # since the first page a user sees has no prior reading time.
         # gathers times regardless of sessions, sinces session timeouts
         # will be determined statistically in post-procesing
         if (!$first_page) {
            $reading_time = $time - $last_reading_time; 
            print READING "$reading_time\n";
         } $last_reading_time = $time;

         # page sizes are for the previous page.  pages without embedded 
         # objects are treated separately from pages with embedded objects
         if (!$first_page) {
            if ($embed > 0) {
               print BASE_WITH "$last_page_size\n"; print EO_FREQ "$embed\n";
            } else { print BASE_WO "$last_page_size\n";}
         } $last_page_size = $size; $embed = 0;

         # when a user surfs to another www site, tabulate the number of pages
         # visited in the site and the total time spent in the site
         if ($old_host ne $new_host && !$first_page) { 
            print CLICKS "$user\t$clicks\n";
            $site_time = $time - $site_start;
            print SITE_TIME "$site_time\n" if $site_time > 0;
            $site_start = $time; $clicks = 0;
            print LOG "User $user for $stop_time now surfing at $host\n" if $DEBUG > 3;
         } elsif ($first_page) { $site_start = $time;}
         $old_host = $new_host; $clicks++;

         $first_page = 0;

      } else { $embed++; $MEDIA{$url}++; print EO_SIZE "$size\n";}

      $SITES{$new_host}++; $last_request_time = $time;
   } 
   print "DONE\n"; `gzip $infile`; `rm $sorted`;
}

sub get_nextday {
   local(*date) = @_; local($y) = substr($date,0,2);
   local($m) = substr($date,2,2); local($d) = substr($date,4,2);

   if ($m == 9 || $m == 4 || $m == 6 || $m == 11) { 
      if ($d == 30) { $d = 1; $m++} else {$d++;}} 
   elsif ($m == 12) { 
      if ($d == 31) { $d = $m = 1; $y++;} else {$d++;}
      if ($y == 100) {$y = "0";}} 
   elsif ($m == 2) { 
      # not even close 
      if ($y == 96 || $y % 4 == 0) { if ($d == 29) { $d = 1; $m++} else { $d++};} 
      else { if ($d == 28) { $d = 1; $m++} else { $d++};}} 
   else { if ($d == 31) { $d = 1; $m++;} else {$d++;}}
   $date = &make_time($y,$m,$d);
}

sub make_time {
   local($y,$m,$d) = @_; local($t) = 0; $y -= 0; $m -= 0; $d -= 0;
   if ($y < 10) {$t = "0" . $y;} else { $t = $y;}
   if ($m < 10) {$t .= "0" . $m;} else { $t .= $m;}
   if ($d < 10) {$t .= "0" . $d;} else { $t .= $d;}
   return $t;
}

# $Id: dist_crunch.pl,v 1.1 1999/04/23 21:10:51 frystyk Exp $
# ---------------------------------------------------------------------------
# wwwurl: A package for parsing and manipulating World-Wide Web
#         Uniform Resource Locators (URL).
#
# This package has been developed by Roy Fielding <fielding@ics.uci.edu>
# as part of the Arcadia project at the University of California, Irvine.
# It is distributed under the Artistic License (included with your Perl
# distribution files).
#
# 13 Jun 1994 (RTF): Initial version
# 17 Jun 1994 (RTF): Fixed double-relative URL handling (e.g. ../../)
# 06 Jul 1994 (RTF): Fixed bug parsing URLs with an empty path and added
#                    fallback code for undefined associative array entries.
#                    Replaced complicated unescape loop with a simple
#                    substitute (from Steven E. Brenner via Brooks Cutter).
#                    Added escape() routine (w/mods) from Brooks Cutter.
# 16 Jul 1994 (RTF): Added get_site() routine.
# 27 Jul 1994 (RTF): Firmed-up algorithm for parsing relative URLs, fixing
#                    several potential (but unlikely) bugs in the process.
#                    Removed any hint of "URL:" prefix.
# 17 Sep 1994 (RTF): Renamed parsing sets to match IETF draft and changed
#                    how they are tested to use bitmap masks;
#                    Modified parsing algorithm to use new sets;
#                    Parser now handles URLs like http://host:/ and uses
#                    the leftmost "?" as the start of query info;
#                    Added caching of base URL components so that they don't
#                    get re-parsed for every URL in a document.
#                    Allowed lowercase hex digits in unescape.
#
# If you have any suggestions, bug reports, fixes, or enhancements,
# send them to the libwww-perl mailing list at <libwww-perl@ics.uci.edu>.
# ---------------------------------------------------------------------------

sub wwwurl_init {
%DefPort = (             # Define the default ports for major net services
    'ftp',        21,
    'file',        0,    # note: non-local file URLs are changed to ftp URLs
    'telnet',     23,
    'whois',      43,
    'gopher',     70,
    'finger',     79,
    'http',       80,
    'nntp',      119,
    'news',      119,
    'wais',      210,
    'webster',   765,
    'prospero', 1525,    # I thought it was 191, but IETF differs
);

# ===========================================================================
# The following six categories are bitmap masks for determining membership
# in the corresponding URL syntactic set, as per the IETF/URI working group
# draft specification for Relative URLs <draft-ietf-uri-relative-url-00.txt>.

$UsesRelative    = 1;
$UsesNetloc      = 2;
$NonHierarchical = 4;
$UsesParams      = 8;
$UsesQuery       = 16;
$UsesFragment    = 32;

%InSet = (      # Define scheme membership in each category
    '',         ($UsesRelative | $UsesNetloc | $UsesFragment | $UsesQuery),
    'http',     ($UsesRelative | $UsesNetloc | $UsesFragment | $UsesQuery),
    'file',     ($UsesRelative | $UsesNetloc | $UsesFragment),
    'ftp',      ($UsesRelative | $UsesNetloc | $UsesFragment | $UsesParams),
    'prospero', ($UsesRelative | $UsesNetloc | $UsesFragment | $UsesParams),
    'nntp',     ($UsesRelative | $UsesNetloc | $UsesFragment),
    'gopher',   ($UsesRelative | $UsesNetloc | $NonHierarchical |
                 $UsesFragment),
    'wais',     ($UsesRelative | $UsesNetloc | $NonHierarchical | $UsesQuery | 
                 $UsesFragment),
    'mailto',   ($NonHierarchical),
    'news',     ($NonHierarchical | $UsesFragment),
    'finger',   ($UsesNetloc | $NonHierarchical | $UsesFragment),
    'whois',    ($UsesNetloc | $NonHierarchical | $UsesFragment),
    'webster',  ($UsesNetloc | $NonHierarchical | $UsesFragment),
    'telnet',   ($UsesNetloc | $NonHierarchical),
    'rlogin',   ($UsesNetloc | $NonHierarchical),
    'tn3270',   ($UsesNetloc | $NonHierarchical),
);

# ===========================================================================
# The following package globals are used to cache the last Base URL parsed.

$Burl   = '';
$Bsch   = '';
$Baddr  = '';
$Bport  = '';
$Bpath  = '';
$Bquery = '';
$Bfrag  = '';
$Bmem   = 0;
}

# ===========================================================================
# ===========================================================================
# parse(): Parse the given URL into its component parts according to
#          WWW URI rules, returning '' for those that are not present. 
#          If no scheme is given, the URL is parsed according to HTTP rules,
#          so schemes which use different rules may have to recombine parts.
#
#     Returns the folowing in order:
#
#             $scheme : The access scheme (converted to lower case);
#             $address: The login or hostname/IP address (if appropriate);
#             $port   : The TCP port (if appropriate);
#             $path   : The object path (plus any params);
#             $query  : The post-'?' search info (if scheme uses queries);
#             $frag   : The post-'#' fragment identifier (if uses fragments).
#             
sub parse
{
    local($url)     = @_;
    local($scheme)  = '';
    local($address) = '';
    local($port)    = '';
    local($path)    = '';
    local($query)   = '';
    local($frag)    = '';

    if ($url =~ s#^([.+\-\w]+):##)
    {
        $scheme = $1;
        $scheme =~ tr/A-Z/a-z/;
    }

    local($member) = $InSet{$scheme} || 0;

    if ($member & $UsesFragment)
    {
        if ($url =~ s/#([^#]*)$//) { $frag = $1; }
    }

    if (($member & $UsesNetloc) && ($url =~ m#^//#o))
    {
        $url =~ s#^//([^/]*)##;
        $address = $1;
        if ($address =~ s/:(\d*)$//)
        {
            $port = $1;
        }
    }

    if ($member & $UsesQuery)
    {
        if ($url =~ s/\?(.*)$//) { $query = $1; }
    }

    $path = $url;

    return ($scheme, $address, $port, $path, $query, $frag);
}


# ===========================================================================
# compose(): Recombine the given component parts into a URL string.
#
#     The following in components may be passed in:
#
#             $scheme : The access scheme;
#             $address: The hostname/IP address;
#             $port   : The TCP port;
#             $path   : The object path (plus any params);
#             $query  : The post-? search info
#             $frag   : The post-'#' fragment identifier
#             
sub compose
{
    local($scheme, $address, $port, $path, $query, $frag) = @_;
    local($url) = '';

    if ($scheme) { $url = $scheme . ':'; }

    if ($address)
    {
        $url .= "//$address";
        if ($port) { $url .= ":$port"; }
    }

    if ($path) { $url .= $path;     }
    if ($query)
    {
        if (!$path) { $url .= '/';  }  # Avoid mistaking query as being
        $url .= "?$query";             # part of the address
    }
    if ($frag) { $url .= "#$frag";  }

    return $url;
}


# ===========================================================================
# unescape(): Return the passed URL after replacing all %NN escaped chars
#             with their actual character equivalents.
#
sub unescape
{
    local($url) = @_;

    $url =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack("C",hex($1))/ge;
    return $url;
}

# ===========================================================================
# escape(): Return the passed string after replacing all characters matching
#           the passed pattern with their %XX hex escape chars.  Note that
#           the caller must be sure not to escape reserved URL characters
#           (e.g. / in pathnames, ':' between address and port, etc.) and thus
#           this routine can only be applied to each URL part separately. E.g.
#
#           $escname = &escape($name,'[\x00-\x20"#%/;<>?\x7F-\xFF]');
#
sub escape
{
    local($str, $pat) = @_;
         
    $str =~ s/($pat)/sprintf("%%%02lx",unpack('C',$1))/ge;
    return($str);
}


# ===========================================================================
# absolute(): Return the absolute URL given a (possibly relative) URL
#             and the document's absolute base URL.  Uses the $B* variables
#             to cache the last Base URL parsed.
#
sub absolute
{
    local($base, $url) = @_;

    $url =~ s/^\s+//;  # Remove any preceding whitespace
    $url =~ s/\s.*//;  # Remove anything after first word

    local($scheme, $addr, $port, $path, $query, $frag) = &parse($url);

    local($member) = $InSet{$scheme} || 0;


    RELATED: {

        if (!$base)          # If no base was given then it can't be relative
        {
            if (!$scheme) { $scheme = 'file' }   # Default to a file URL
            last RELATED;
        }

        if ($base ne $Burl)  # Check the Base URL cache
        {
            $Burl = $base;
            ($Bsch,$Baddr,$Bport,$Bpath,$Bquery,$Bfrag) = &parse($Burl);
            $Bmem = $InSet{$Bsch} || 0;
        }

        if (!$scheme)
        {
            $scheme = $Bsch;
            $member = $Bmem;
            if ($query && !($Bmem & $UsesQuery))  # Restore mistaken queries
            {
                $path .= '?'. $query;
                $query = '';
            }
        }
        else { last RELATED if ($scheme ne $Bsch); }

        last RELATED unless ($member & $UsesRelative);

        last RELATED if ($addr || $port);    # Child must have used '//'

        $addr = $Baddr;                      # else it inherits base netloc
        $port = $Bport;

        if (!$path)
        {
            $path = $Bpath;
            if (!$query) { $query = $Bquery; }
        }
        elsif ($member & $NonHierarchical)
        {;} # Do nothing
        elsif ($path !~ m|^/|o)     # If the child URL does not begin with '/'
        {
            local($ppath);
            if ($Bpath)
            {
                $ppath = $Bpath;
                if ($Bmem & $UsesParams)
                {
                    $ppath =~ s#;.*##;       # Trim off any base parameters
                }
                $ppath =~ s#/[^/]*$#/#;      # Trim off any base filename
            }
            else { $ppath = '/'; }

            $path = $ppath . $path;
            #
            # The order in which we remove the relative "/." and "xxx/.."
            # path segment components is extremely important.
            #
            while ($path  =~ s#/\./#/#) {;}
            $path  =~ s#/\.$#/#;
            while ($path  =~ s#/[^/]*/\.\./#/#) {;}
            $path  =~ s#/[^/]*/\.\.$#/#;
        }
    }

    if ($scheme eq 'file')
    {
        if (!$addr)                  { $addr   = 'localhost'; }
        elsif ($addr ne 'localhost') { $scheme = 'ftp';       }
        #
        # The above line will have to be deleted once people stop using
        # file: as an alias for ftp: (i.e. when the IETF standard is done).
        #
    }
    elsif ($scheme eq 'http')        { $path  =~ s#^/\%7E#/~#io; }

    # NOTE: Fanatical spec-followers should reverse the above substitution
    #       because it improperly prefers the tilde character over %7E (:-b)

    if ($port && ($port == $DefPort{$scheme})) { $port = ''; }

    if (!$path) { $path = '/'; }

    return &compose($scheme, $addr, $port, $path, $query, $frag);
}


# ===========================================================================
# get_site(): Return the site part of the passed-in absolute URL
#             (i.e. the hostname:port) replacing any missing port with
#             the default.  If the URL scheme does not allow hostport,
#             then we return '';
#
sub get_site
{
    local($scheme, $site, $port, $path, $query, $frag) = &parse($_[0]);

    return '' unless (defined($DefPort{$scheme}));

    if (!$port) { $port = $DefPort{$scheme}; }

    if ($port)  { $site .= ":$port"; }

    return $site;
}

# ===========================================================================
