sitesampler-submitinfo Mailing List for SiteSampler Click-Stream Analyzer
Brought to you by:
alfarid23,
shanehill00
Menu
▾
▴
sitesampler-submitinfo
You can subscribe to this list here.
| 2005 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
(43) |
Aug
(7) |
Sep
|
Oct
|
Nov
|
Dec
(1) |
|---|
|
From: Shane H. <sha...@us...> - 2005-12-24 02:45:08
|
Update of /cvsroot/sitesampler/sitesampler In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4950 Modified Files: SiteSampler.pm Log Message: testing the new cvs root for sourceforge Index: SiteSampler.pm =================================================================== RCS file: /cvsroot/sitesampler/sitesampler/SiteSampler.pm,v retrieving revision 1.1.1.1 retrieving revision 1.2 diff -C2 -d -r1.1.1.1 -r1.2 *** SiteSampler.pm 22 Jun 2005 01:38:21 -0000 1.1.1.1 --- SiteSampler.pm 24 Dec 2005 02:45:00 -0000 1.2 *************** *** 1,3 **** --- 1,4 ---- package SiteSampler; + # this is sitesampler use strict; use CGI; |
|
From: Shane H. <sha...@us...> - 2005-08-31 01:59:51
|
Update of /cvsroot/sitesampler/sitesampler/SiteSampler/Report In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17312/SiteSampler/Report Modified Files: Base.pm Urls.pm Viewer.pm Log Message: committing what is very close to another rendition of the web stats report Index: Viewer.pm =================================================================== RCS file: /cvsroot/sitesampler/sitesampler/SiteSampler/Report/Viewer.pm,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** Viewer.pm 28 Aug 2005 18:46:59 -0000 1.6 --- Viewer.pm 31 Aug 2005 01:59:44 -0000 1.7 *************** *** 56,63 **** $self->report_section('daysofweek',$report->hits->weekdays,'Days of Week','Weekday'); $self->report_section('hoursofday',$report->hits->hourly,'Hourly','Hour of Day'); ! $self->report_section('urls',$report->urls,'Requested Pages','URL'); # $self->report_section('internal_referers',$report->referers->internal); $self->report_section('direct_referers',$report->referers->direct,'Referring Pages - Direct','URL'); ! $self->report_section('search_referers',$report->referers->search_engine,'Referring Pages - Search Engine',''); $self->report_section('solicitations',$report->solicitations,'Points of Solicitation','URL'); --- 56,63 ---- $self->report_section('daysofweek',$report->hits->weekdays,'Days of Week','Weekday'); $self->report_section('hoursofday',$report->hits->hourly,'Hourly','Hour of Day'); ! $self->url_report_section('urls',$report->urls,'Requested Pages'); # $self->report_section('internal_referers',$report->referers->internal); $self->report_section('direct_referers',$report->referers->direct,'Referring Pages - Direct','URL'); ! $self->report_section('search_referers',$report->referers->search_engine,'Referring Pages - Search Engine','URL'); $self->report_section('solicitations',$report->solicitations,'Points of Solicitation','URL'); *************** *** 95,98 **** --- 95,106 ---- } + sub url_report_section{ + my $self = shift; + my($anchor_label,$obj,$table_heading) = @_; + $self->a_name($anchor_label); + $self->draw_url_table($obj,$table_heading); + $self->section_footer; + } + sub report_section{ my $self = shift; *************** *** 105,108 **** --- 113,132 ---- ##### standard stats table ######## + + sub draw_url_table{ + my $self = shift; + my($url_obj,$table_heading) = @_; + push(@{$self->out},$self->url_table_header($table_heading)); + + for my $collection ($url_obj->get_collections){ + my $template = HTML::Template->new(scalarref => \$self->url_table_template); + $template->param($self->url_report_data($collection,$collection->url_root)); + + push(@{$self->out},$template->output); + } + + push(@{$self->out},$self->url_table_footer); + } + sub draw_table{ my $self = shift; *************** *** 115,130 **** } sub report_data{ my $self = shift; my($obj,$table_heading,$table_item_title) = @_; my $report_data = {}; - $report_data->{table_heading} = $table_heading; $report_data->{table_item_title} = $table_item_title; my @obj_ids = $obj->obj_ids_max_hits; my $tuu = $obj->report->users->total_unique_users; my $total_hits = $obj->report->hits->total_hits; ! my $object_rows = []; for my $obj_id (@obj_ids){ --- 139,168 ---- } + sub url_report_data{ + my $self = shift; + my($obj,$url_root) = @_; + my $report_data = {}; + $report_data->{url_root} = $url_root; + $report_data->{OBJECT_ROWS} = _object_rows($obj,1);# pass self as the second param cause this is a private method + return($report_data); + } + sub report_data{ my $self = shift; my($obj,$table_heading,$table_item_title) = @_; my $report_data = {}; $report_data->{table_heading} = $table_heading; $report_data->{table_item_title} = $table_item_title; + $report_data->{OBJECT_ROWS} = _object_rows($obj); # pass self as the second param cause this is a private method + return($report_data); + } + + sub _object_rows{ + my($obj,$is_url) = @_; my @obj_ids = $obj->obj_ids_max_hits; my $tuu = $obj->report->users->total_unique_users; my $total_hits = $obj->report->hits->total_hits; ! my $object_rows = []; for my $obj_id (@obj_ids){ *************** *** 137,153 **** $obj_data->{percent_unique_users} = sprintf("%.3f",($tuu ? ($obj_data->{unique_users}/$tuu) * 100 : 0)); # we hyperlink the object if it is a url ! $obj_data->{obj_name} = _link_it($obj->name); push(@$object_rows,$obj_data); } ! $report_data->{OBJECT_ROWS} = $object_rows; ! return($report_data); } sub _link_it{ ! my($str) = @_; ! if(_is_uri($str)){ ! $str = qq|<a href="$str" target="urlwin">$str</a>|; } ! return($str); } --- 175,196 ---- $obj_data->{percent_unique_users} = sprintf("%.3f",($tuu ? ($obj_data->{unique_users}/$tuu) * 100 : 0)); # we hyperlink the object if it is a url ! $obj_data->{obj_name} = $is_url ? _link_it($obj) : $obj->name; push(@$object_rows,$obj_data); } ! return($object_rows); } sub _link_it{ ! my($qstr_obj) = @_; ! my $url_root = $qstr_obj->parent->url_root; ! my $qstr = $qstr_obj->name; ! my $qstr_display = $qstr; ! if(defined($qstr) && length($qstr) > 0){ ! $qstr_display = substr($qstr,0,49) if(length($qstr) > 50); ! $qstr = '?'.$qstr; } ! my $url = $url_root.$qstr; ! my $link = qq|\n<a href="$url" target="urlwin" title="$url">$qstr_display</a>\n|; ! return($link); } *************** *** 160,163 **** --- 203,251 ---- } + sub url_table_header{ + my $self = shift; + my($table_heading) = @_; + return(qq| + <table class="blank2"> + <tr> + <th>$table_heading</th> + <td class="th2" width="15%" bgcolor="#FFB055">Unique Visitors</td> + <td class="th2" width="15%" bgcolor="#FFB055">% Unique Visitors</td> + <td class="th2" width="15%" bgcolor="#66F0FF">Page Views</td> + <td class="th2" width="15%" bgcolor="#66F0FF">% Page Views</td> + </tr> + |); + } + + sub url_table_footer{"\n</table>\n"} + + sub url_table_template{ + my $self = shift; + + my $template = qq| + <tr> + <td class="th2" width="100%" bgcolor="#7EACD3" align="left" colspan="5"><TMPL_VAR name=URL_ROOT></td> + <!-- + <td class="th2" width="15%" bgcolor="#FFB055">Unique Visitors</td> + <td class="th2" width="15%" bgcolor="#FFB055">% Unique Visitors</td> + <td class="th2" width="15%" bgcolor="#66F0FF">Page Views</td> + <td class="th2" width="15%" bgcolor="#66F0FF">% Page Views</td> + --> + </tr> + + <TMPL_LOOP NAME=OBJECT_ROWS> + <tr class="th5"> + <td class="th2" align="left"><TMPL_VAR name=OBJ_NAME></td> + <td><TMPL_VAR name=UNIQUE_USERS></td> + <td><TMPL_VAR name=PERCENT_UNIQUE_USERS></td> + <td><TMPL_VAR name=OBJ_HITS></td> + <td><TMPL_VAR name=PERCENT_HITS></td> + </tr> + </TMPL_LOOP> + |; + return($template); + + } + sub table_template{ my $self = shift; Index: Base.pm =================================================================== RCS file: /cvsroot/sitesampler/sitesampler/SiteSampler/Report/Base.pm,v retrieving revision 1.9 retrieving revision 1.10 diff -C2 -d -r1.9 -r1.10 *** Base.pm 22 Jul 2005 03:42:17 -0000 1.9 --- Base.pm 31 Aug 2005 01:59:44 -0000 1.10 *************** *** 81,85 **** sub add_obj{ my $self = shift; ! my($obj_id) = @_; unless(exists $self->{$obj_id}){ --- 81,86 ---- sub add_obj{ my $self = shift; ! my($obj_id) = @_; ! $obj_id = '' unless defined($obj_id); unless(exists $self->{$obj_id}){ *************** *** 88,92 **** $self->{$obj_id} = $self->fetch_obj($obj_id) ! or die(qq|cannot fetch object for obj_id: $obj_id|); } --- 89,93 ---- $self->{$obj_id} = $self->fetch_obj($obj_id) ! or die(qq|cannot fetch object for obj_id: $obj_id : |.ref($self)); } *************** *** 109,113 **** sub obj_ids_max_hits{ my $self = shift; ! return(sort {$self->obj_count_hash->{$b} <=> $self->obj_count_hash->{$a}} keys %{$self->obj_count_hash}); } --- 110,117 ---- sub obj_ids_max_hits{ my $self = shift; ! return(sort {$self->obj_count_hash->{$b} ! <=> $self->obj_count_hash->{$a}} ! keys %{$self->obj_count_hash} ! ); } Index: Urls.pm =================================================================== RCS file: /cvsroot/sitesampler/sitesampler/SiteSampler/Report/Urls.pm,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** Urls.pm 28 Aug 2005 18:46:59 -0000 1.6 --- Urls.pm 31 Aug 2005 01:59:44 -0000 1.7 *************** *** 3,7 **** use Data::Dumper; use File::Path; ! use SiteSampler::Urls::Collection; use SiteSampler::Report::Urls::Url; use SiteSampler::Report::Base; --- 3,7 ---- use Data::Dumper; use File::Path; ! use SiteSampler::Report::Urls::Collection; use SiteSampler::Report::Urls::Url; use SiteSampler::Report::Base; *************** *** 51,58 **** my $self = shift; my($log_entry) = @_; my($url_path,$qstr) = split(/\?/,$url,2); ! my $collection = $self->add_collection($log_entry->client_url); ! my $url_obj = $collection->add_obj($qstr); ! $url_obj->add_user($log_entry->user_id); } --- 51,59 ---- my $self = shift; my($log_entry) = @_; + my $url = $log_entry->client_url; my($url_path,$qstr) = split(/\?/,$url,2); ! my $collection = $self->add_collection($url_path); ! my $qstr_obj = $collection->add_obj($qstr); ! $qstr_obj->add_user($log_entry->user_id); } *************** *** 62,70 **** sub add_collection{ my $self = shift; ! my($url_path) = @_; my($url_path,$qstr) = split(/\?/,$url,2); unless($self->collection($url_path)){ ! $collection_class = ref($self).'::'.$self->collection_class_suffix ! $self->{$url_path} = $collection_class->new($url_path); } return $self->collection($url_path); --- 63,70 ---- sub add_collection{ my $self = shift; ! my($url) = @_; my($url_path,$qstr) = split(/\?/,$url,2); unless($self->collection($url_path)){ ! $self->obj_count_hash->{$url_path} = SiteSampler::Report::Urls::Collection->new($url_path,$self->report); } return $self->collection($url_path); *************** *** 73,97 **** sub collection{ my $self = shift; ! my($url_path) = @_; my $collection; ! if($url_path && exists($self->{$url_path})){ ! $collection = $self->{$url_path}; } return $collection; } ! sub get_obj{ my $self = shift; ! my($obj_id) = @_; ! my($url,$qstr) = split(/\?/,$obj_id,2); ! ! return( ! (my $collection = $self->collection($url)) ! ? $collection->get_obj($qstr); ! : undef ! ); } ! sub obj_count_hash_key{'urls'} sub base_class_suffix{'Url'} sub collection_class_suffix{'Collection'}; --- 73,93 ---- sub collection{ my $self = shift; ! my($url) = @_; ! my($url_path,$qstr) = split(/\?/,$url,2); my $collection; ! if($url_path && exists($self->obj_count_hash->{$url_path})){ ! $collection = $self->obj_count_hash->{$url_path}; } return $collection; } ! sub get_collections{ my $self = shift; ! return(values %{$self->obj_count_hash}); } ! sub get_obj{ collection(@_); } ! ! sub obj_count_hash_key{'collections'} sub base_class_suffix{'Url'} sub collection_class_suffix{'Collection'}; |
|
From: Shane H. <sha...@us...> - 2005-08-31 01:59:51
|
Update of /cvsroot/sitesampler/sitesampler/SiteSampler/Report/Urls In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17312/SiteSampler/Report/Urls Modified Files: Collection.pm Log Message: committing what is very close to another rendition of the web stats report Index: Collection.pm =================================================================== RCS file: /cvsroot/sitesampler/sitesampler/SiteSampler/Report/Urls/Collection.pm,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** Collection.pm 28 Aug 2005 18:47:00 -0000 1.1 --- Collection.pm 31 Aug 2005 01:59:44 -0000 1.2 *************** *** 7,9 **** --- 7,31 ---- sub base_class_suffix{'Url'} + sub new{ + my $class = shift; + my($root_url,@params) = @_; + my $self = $class->SUPER::new(@params); + $self->url_root($root_url); + return($self); + } + + sub fetch_obj{ + my $self = shift; + my($obj_id) = @_; + return undef unless(defined($obj_id) && exists($self->obj_count_hash->{$obj_id})); + my $class = ref($self); + $class =~ s/Collection$//; + $class .= $self->base_class_suffix; + return $class->new($obj_id,$self->report,$self); + } + sub url_root{ + my $self = shift; + return($self->get_set('url_root',@_)); + } + 1; \ No newline at end of file |
|
From: Shane H. <sha...@us...> - 2005-08-31 01:59:51
|
Update of /cvsroot/sitesampler/sitesampler/SiteSampler In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17312/SiteSampler Modified Files: AddProject.pm Agent.pm Data.pm Object.pm RemoveProjects.pm Log Message: committing what is very close to another rendition of the web stats report Index: RemoveProjects.pm =================================================================== RCS file: /cvsroot/sitesampler/sitesampler/SiteSampler/RemoveProjects.pm,v retrieving revision 1.1.1.1 retrieving revision 1.2 diff -C2 -d -r1.1.1.1 -r1.2 *** RemoveProjects.pm 22 Jun 2005 01:38:22 -0000 1.1.1.1 --- RemoveProjects.pm 31 Aug 2005 01:59:43 -0000 1.2 *************** *** 31,34 **** --- 31,37 ---- my @rem_projs; for my $projectid ($cgi->param){ + $projectid =~ s/^\s*//; + $projectid =~ s/\s*$//; + next unless $projectid; my $project = SiteSampler::Project->new($projectid); push(@rem_projs,$project->name); *************** *** 45,48 **** --- 48,52 ---- my($project) = @_; my $agent_objs = $project->agent_objs; + for my $agentid (keys %$agent_objs){ my $agent = $agent_objs->{$agentid}; Index: Agent.pm =================================================================== RCS file: /cvsroot/sitesampler/sitesampler/SiteSampler/Agent.pm,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** Agent.pm 22 Jul 2005 03:42:16 -0000 1.8 --- Agent.pm 31 Aug 2005 01:59:43 -0000 1.9 *************** *** 423,427 **** # this copies the data that is the perl script # that produces the javascript that is the agent ! # which collects stats # therefore if the perl representation of # the agent is large we could end up using a lot memory --- 423,428 ---- # this copies the data that is the perl script # that produces the javascript that is the agent ! # which collects stats. ! # # therefore if the perl representation of # the agent is large we could end up using a lot memory Index: Data.pm =================================================================== RCS file: /cvsroot/sitesampler/sitesampler/SiteSampler/Data.pm,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** Data.pm 31 Jul 2005 02:44:13 -0000 1.2 --- Data.pm 31 Aug 2005 01:59:43 -0000 1.3 *************** *** 287,292 **** --- 287,295 ---- my $objectClass = shift; my $tableName = $self->_getTableName($objectClass); + $self->debug("getting the db_object<hr>"); my $dbObject = $self->db; + $self->debug("got the db_object<hr>"); my $res = $dbObject->objectExists($objectName,$tableName); + $self->debug("$res<hr>"); return($res); } Index: Object.pm =================================================================== RCS file: /cvsroot/sitesampler/sitesampler/SiteSampler/Object.pm,v retrieving revision 1.1.1.1 retrieving revision 1.2 diff -C2 -d -r1.1.1.1 -r1.2 *** Object.pm 22 Jun 2005 01:38:22 -0000 1.1.1.1 --- Object.pm 31 Aug 2005 01:59:43 -0000 1.2 *************** *** 13,16 **** --- 13,31 ---- } + sub debug{ + return(undef); + my $self = shift; + my $debug_header_printed = ref($self); + $debug_header_printed .= '::debug_header'; + no strict; + unless($$debug_header_printed){ + $$debug_header_printed = 1; + use strict; + print $self->cgi->header; + } + use strict; + print "@_"; + } + sub init{ my $self = shift; Index: AddProject.pm =================================================================== RCS file: /cvsroot/sitesampler/sitesampler/SiteSampler/AddProject.pm,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** AddProject.pm 31 Jul 2005 02:44:13 -0000 1.2 --- AddProject.pm 31 Aug 2005 01:59:43 -0000 1.3 *************** *** 32,35 **** --- 32,36 ---- my $account = $self->account; my $project_added; + if($self->data->objectExists($projectname,'SiteSampler::Project')){ # if an account with the same name exists, throw an error |
|
From: Shane H. <sha...@us...> - 2005-08-31 01:59:51
|
Update of /cvsroot/sitesampler/sitesampler/SiteSampler/Data In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17312/SiteSampler/Data Modified Files: PostgreSQL.pm Log Message: committing what is very close to another rendition of the web stats report Index: PostgreSQL.pm =================================================================== RCS file: /cvsroot/sitesampler/sitesampler/SiteSampler/Data/PostgreSQL.pm,v retrieving revision 1.1.1.1 retrieving revision 1.2 diff -C2 -d -r1.1.1.1 -r1.2 *** PostgreSQL.pm 22 Jun 2005 01:38:28 -0000 1.1.1.1 --- PostgreSQL.pm 31 Aug 2005 01:59:43 -0000 1.2 *************** *** 189,194 **** my $self = shift; my $sql = $self->getSQL('ObjectExists',@_); ! my $res = $self->connection->selectrow_hashref($sql) ! or $self->send_err($sql); $res = $res ? 1 : 0; return($res); --- 189,195 ---- my $self = shift; my $sql = $self->getSQL('ObjectExists',@_); ! $self->debug('going for it<hr>'); ! my $res = $self->connection->selectrow_hashref($sql); ! #or $self->send_err($sql); $res = $res ? 1 : 0; return($res); *************** *** 214,218 **** my $obj_ids = join(",",@obj_ids); my $sql = qq|DELETE FROM $tablename WHERE $fieldname IN ($obj_ids)|; - my $sth = $self->connection->prepare($sql) or $self->send_err($sql); --- 215,218 ---- |
|
From: Shane H. <sha...@us...> - 2005-08-28 18:47:13
|
Update of /cvsroot/sitesampler/sitesampler/SiteSampler/Report/Urls In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16322/SiteSampler/Report/Urls Modified Files: Url.pm Added Files: Collection.pm Log Message: committing the diffs thatI found on the laptop. I am sure that this will make the tip very unstable - so be sure to check it out and wreck your currently runnning good system :) --- NEW FILE: Collection.pm --- package SiteSampler::Report::Urls::Collection; use strict; use SiteSampler::Report::Base; use base qw(SiteSampler::Report::Base); sub obj_count_hash_key{'urls'} sub base_class_suffix{'Url'} Index: Url.pm =================================================================== RCS file: /cvsroot/sitesampler/sitesampler/SiteSampler/Report/Urls/Url.pm,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** Url.pm 18 Jul 2005 01:36:39 -0000 1.3 --- Url.pm 28 Aug 2005 18:47:00 -0000 1.4 *************** *** 1,3 **** --- 1,4 ---- package SiteSampler::Report::Urls::Url; + use URI; use SiteSampler::Report::Base::Child; use base qw(SiteSampler::Report::Base::Child); |
|
From: Shane H. <sha...@us...> - 2005-08-28 18:47:08
|
Update of /cvsroot/sitesampler/sitesampler/SiteSampler/Report/Base In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16322/SiteSampler/Report/Base Modified Files: Child.pm Log Message: committing the diffs thatI found on the laptop. I am sure that this will make the tip very unstable - so be sure to check it out and wreck your currently runnning good system :) Index: Child.pm =================================================================== RCS file: /cvsroot/sitesampler/sitesampler/SiteSampler/Report/Base/Child.pm,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** Child.pm 18 Jul 2005 01:36:38 -0000 1.4 --- Child.pm 28 Aug 2005 18:47:00 -0000 1.5 *************** *** 55,59 **** my $key = 'user_ids'; unless(exists $self->{$key}){ - # my $cache_path = $self->cache_path($self->report->id,$self->parent->obj_count_hash_key,$self->safe_name); $self->{$key} = $self->data_hash; } --- 55,58 ---- |
|
From: Shane H. <sha...@us...> - 2005-08-28 18:47:08
|
Update of /cvsroot/sitesampler/sitesampler/SiteSampler/Report In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16322/SiteSampler/Report Modified Files: Urls.pm Viewer.pm Log Message: committing the diffs thatI found on the laptop. I am sure that this will make the tip very unstable - so be sure to check it out and wreck your currently runnning good system :) Index: Viewer.pm =================================================================== RCS file: /cvsroot/sitesampler/sitesampler/SiteSampler/Report/Viewer.pm,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** Viewer.pm 4 Jul 2005 03:09:54 -0000 1.5 --- Viewer.pm 28 Aug 2005 18:46:59 -0000 1.6 *************** *** 51,64 **** $self->section_footer; ! $self->report_section('months',$report->hits->monthly); ! $self->report_section('daysofmonth',$report->hits->daily); ! $self->report_section('daysofweek',$report->hits->weekdays); ! $self->report_section('hoursofday',$report->hits->hourly); ! $self->report_section('urls',$report->urls); # $self->report_section('internal_referers',$report->referers->internal); ! $self->report_section('direct_referers',$report->referers->direct); ! $self->report_section('search_referers',$report->referers->search_engine); ! $self->report_section('solicitations',$report->solicitations); =cutcode --- 51,64 ---- $self->section_footer; ! $self->report_section('months',$report->hits->monthly,'Monthly','Month'); ! $self->report_section('daysofmonth',$report->hits->daily,'Daily','Day of Month'); ! $self->report_section('daysofweek',$report->hits->weekdays,'Days of Week','Weekday'); ! $self->report_section('hoursofday',$report->hits->hourly,'Hourly','Hour of Day'); ! $self->report_section('urls',$report->urls,'Requested Pages','URL'); # $self->report_section('internal_referers',$report->referers->internal); ! $self->report_section('direct_referers',$report->referers->direct,'Referring Pages - Direct','URL'); ! $self->report_section('search_referers',$report->referers->search_engine,'Referring Pages - Search Engine',''); ! $self->report_section('solicitations',$report->solicitations,'Points of Solicitation','URL'); =cutcode *************** *** 71,87 **** =cut ! $self->report_section('domains',$report->domains); # $self->report_section('profiles',$report->profiles); ! $self->report_section('plugins',$report->plugins); ! $self->report_section('os',$report->os); ! $self->report_section('user_agent',$report->user_agents); ! $self->report_section('mon_width',$report->monitors->widths); ! $self->report_section('mon_height',$report->monitors->heights); ! $self->report_section('mon_res',$report->monitors->depths); ! $self->report_section('mon_config',$report->monitors->resolutions); ! $self->report_section('mon_col_depth',$report->monitors->configs); return($self->out); --- 71,87 ---- =cut ! $self->report_section('domains',$report->domains,'Countries','Country'); # $self->report_section('profiles',$report->profiles); ! $self->report_section('plugins',$report->plugins,'Plugins','Plugin Name'); ! $self->report_section('os',$report->os,'Operating Systems','OS'); ! $self->report_section('user_agent',$report->user_agents,'Browsers','Browser'); ! $self->report_section('mon_width',$report->monitors->widths,'Monitor Widths','Width (pixels)'); ! $self->report_section('mon_height',$report->monitors->heights,'Monitor Heights','Height (pixels)'); ! $self->report_section('mon_col_depth',$report->monitors->depths,'Monitor Color Depths','Color Depth (millions of colors)'); ! $self->report_section('mon_res',$report->monitors->resolutions,'Monitor Resolutions','Resolution (W x H)'); ! $self->report_section('mon_config',$report->monitors->configs,'Montior Configurations','Configuration (W x H x Depth)'); return($self->out); *************** *** 97,103 **** sub report_section{ my $self = shift; ! my($anchor_label,$obj) = @_; $self->a_name($anchor_label); ! $self->draw_table($obj); $self->section_footer; } --- 97,103 ---- sub report_section{ my $self = shift; ! my($anchor_label,$obj,$table_heading,$table_item_title) = @_; $self->a_name($anchor_label); ! $self->draw_table($obj,$table_heading,$table_item_title); $self->section_footer; } *************** *** 107,114 **** sub draw_table{ my $self = shift; ! my($obj) = @_; my $template = HTML::Template->new(scalarref => \$self->table_template); ! $template->param($self->report_data($obj)); push(@{$self->out},$template->output); --- 107,114 ---- sub draw_table{ my $self = shift; ! my($obj,$table_heading,$table_item_title) = @_; my $template = HTML::Template->new(scalarref => \$self->table_template); ! $template->param($self->report_data($obj,$table_heading,$table_item_title)); push(@{$self->out},$template->output); *************** *** 117,125 **** sub report_data{ my $self = shift; ! my($obj) = @_; my $report_data = {}; ! $report_data->{table_heading} = $obj->table_heading; ! $report_data->{table_item_title} = $obj->table_item_title; my @obj_ids = $obj->obj_ids_max_hits; --- 117,125 ---- sub report_data{ my $self = shift; ! my($obj,$table_heading,$table_item_title) = @_; my $report_data = {}; ! $report_data->{table_heading} = $table_heading; ! $report_data->{table_item_title} = $table_item_title; my @obj_ids = $obj->obj_ids_max_hits; *************** *** 136,140 **** $obj_data->{unique_users} = $obj->total_users; $obj_data->{percent_unique_users} = sprintf("%.3f",($tuu ? ($obj_data->{unique_users}/$tuu) * 100 : 0)); ! $obj_data->{obj_name} = $obj->name; push(@$object_rows,$obj_data); } --- 136,141 ---- $obj_data->{unique_users} = $obj->total_users; $obj_data->{percent_unique_users} = sprintf("%.3f",($tuu ? ($obj_data->{unique_users}/$tuu) * 100 : 0)); ! # we hyperlink the object if it is a url ! $obj_data->{obj_name} = _link_it($obj->name); push(@$object_rows,$obj_data); } *************** *** 143,146 **** --- 144,163 ---- } + sub _link_it{ + my($str) = @_; + if(_is_uri($str)){ + $str = qq|<a href="$str" target="urlwin">$str</a>|; + } + return($str); + } + + sub _is_uri{ + my($uri) = @_; + my($scheme, $authority, $path, $query, $fragment) = + $uri =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|; + return undef unless($scheme && $authority); + return(1); + } + sub table_template{ my $self = shift; *************** *** 161,165 **** <TMPL_LOOP NAME=OBJECT_ROWS> <tr class="th5"> ! <td class="th2" align="left"><a href="<TMPL_VAR name=OBJ_NAME>" target="urlwin"><TMPL_VAR name=OBJ_NAME></a></td> <td><TMPL_VAR name=UNIQUE_USERS></td> <td><TMPL_VAR name=PERCENT_UNIQUE_USERS></td> --- 178,182 ---- <TMPL_LOOP NAME=OBJECT_ROWS> <tr class="th5"> ! <td class="th2" align="left"><TMPL_VAR name=OBJ_NAME></td> <td><TMPL_VAR name=UNIQUE_USERS></td> <td><TMPL_VAR name=PERCENT_UNIQUE_USERS></td> *************** *** 174,177 **** --- 191,277 ---- } + =weird_code + sub draw_url_table{ + my $self = shift; + my($obj) = @_; + + my $template = HTML::Template->new(scalarref => \$self->url_table_template); + $template->param($self->url_report_data($obj)); + + push(@{$self->out},$template->output); + } + + sub url_report_data{ + my $self = shift; + my $report_data = {}; + for my $url ($obj->fetch_objs){ + + } + } + + sub _url_report_data{ + my $self = shift; + my($obj) = @_; + my $report_data = {}; + + $report_data->{table_heading} = $obj->table_heading; + $report_data->{table_item_title} = $obj->table_item_title; + + my @obj_ids = $obj->obj_ids_max_hits; + my $tuu = $obj->report->users->total_unique_users; + my $total_hits = $obj->report->hits->total_hits; + + my $object_rows = []; + for my $obj_id (@obj_ids){ + my $obj_data = {}; + my $obj = $obj->get_obj($obj_id); + next unless($obj); + $obj_data->{obj_hits} = $obj->total_hits; + $obj_data->{percent_hits} = sprintf("%.3f",$total_hits ? ($obj_data->{obj_hits}/$total_hits) * 100 : 0); + $obj_data->{unique_users} = $obj->total_users; + $obj_data->{percent_unique_users} = sprintf("%.3f",($tuu ? ($obj_data->{unique_users}/$tuu) * 100 : 0)); + # we hyperlink the object if it is a url + $obj_data->{obj_name} = $obj->name; + push(@$object_rows,$obj_data); + } + $report_data->{OBJECT_ROWS} = $object_rows; + return($report_data); + } + + sub url_table_template{ + my $self = shift; + + my $template = qq| + <TMPL_LOOP NAME=URL_TABLES> + <table class="blank2"> + <tr> + <th colspan=5><TMPL_VAR name=TABLE_HEADING></th> + </tr> + <tr> + <td class="th2" width="20%" bgcolor="#7EACD3"><TMPL_VAR name=TABLE_ITEM_TITLE></td> + <td class="th2" width="15%" bgcolor="#FFB055">Unique Visitors</td> + <td class="th2" width="15%" bgcolor="#FFB055">% Unique Visitors</td> + <td class="th2" width="15%" bgcolor="#66F0FF">Page Views</td> + <td class="th2" width="15%" bgcolor="#66F0FF">% Page Views</td> + </tr> + + <TMPL_LOOP NAME=OBJECT_ROWS> + <tr class="th5"> + <td class="th2" align="left"><TMPL_VAR name=OBJ_NAME></td> + <td><TMPL_VAR name=UNIQUE_USERS></td> + <td><TMPL_VAR name=PERCENT_UNIQUE_USERS></td> + <td><TMPL_VAR name=OBJ_HITS></td> + <td><TMPL_VAR name=PERCENT_HITS></td> + </tr> + </TMPL_LOOP> + </table> + </TMPL_LOOP> + |; + return($template); + + } + + =cut + # general summary table for viewing html sub general_summary_table{ *************** *** 192,198 **** $gen_sum_data->{total_page_views} = $report->hits->total_hits; $gen_sum_data->{total_visitors} = $report->users->total_unique_users; ! $gen_sum_data->{total_sessions} = 0 ;#$self->report->sessions->total_sessions; ! $gen_sum_data->{total_abandoned} = 0 ;#$self->report->sessions->total_abandoned; ! my $total_sessions_started = 0 ;#($total_sessions + $total_abandoned); $gen_sum_data->{percent_sessions_abandoned} --- 292,298 ---- $gen_sum_data->{total_page_views} = $report->hits->total_hits; $gen_sum_data->{total_visitors} = $report->users->total_unique_users; ! $gen_sum_data->{total_sessions} = 0; #$self->report->sessions->total_sessions; ! $gen_sum_data->{total_abandoned} = 0; #$self->report->sessions->total_abandoned; ! my $total_sessions_started = 0; #($total_sessions + $total_abandoned); $gen_sum_data->{percent_sessions_abandoned} Index: Urls.pm =================================================================== RCS file: /cvsroot/sitesampler/sitesampler/SiteSampler/Report/Urls.pm,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** Urls.pm 18 Jul 2005 01:36:38 -0000 1.5 --- Urls.pm 28 Aug 2005 18:46:59 -0000 1.6 *************** *** 3,6 **** --- 3,7 ---- use Data::Dumper; use File::Path; + use SiteSampler::Urls::Collection; use SiteSampler::Report::Urls::Url; use SiteSampler::Report::Base; *************** *** 45,49 **** =cut - sub url_key{'urls'} --- 46,49 ---- *************** *** 51,64 **** my $self = shift; my($log_entry) = @_; ! my($client_url,$qstr) = split(/\?/,$log_entry->client_url); ! my $url_obj = $self->add_obj($client_url); $url_obj->add_user($log_entry->user_id); } sub obj_count_hash_key{'urls'} sub base_class_suffix{'Url'} ! ! sub table_heading{'Requested Pages'} ! sub table_item_title{'URL'} 1; --- 51,99 ---- my $self = shift; my($log_entry) = @_; ! my($url_path,$qstr) = split(/\?/,$url,2); ! my $collection = $self->add_collection($log_entry->client_url); ! my $url_obj = $collection->add_obj($qstr); $url_obj->add_user($log_entry->user_id); } + # will create a new collection + # if the collection does not already exist + + sub add_collection{ + my $self = shift; + my($url_path) = @_; + my($url_path,$qstr) = split(/\?/,$url,2); + unless($self->collection($url_path)){ + $collection_class = ref($self).'::'.$self->collection_class_suffix + $self->{$url_path} = $collection_class->new($url_path); + } + return $self->collection($url_path); + } + + sub collection{ + my $self = shift; + my($url_path) = @_; + my $collection; + if($url_path && exists($self->{$url_path})){ + $collection = $self->{$url_path}; + } + return $collection; + } + + sub get_obj{ + my $self = shift; + my($obj_id) = @_; + my($url,$qstr) = split(/\?/,$obj_id,2); + + return( + (my $collection = $self->collection($url)) + ? $collection->get_obj($qstr); + : undef + ); + } + sub obj_count_hash_key{'urls'} sub base_class_suffix{'Url'} ! sub collection_class_suffix{'Collection'}; 1; |
|
From: Shane H. <sha...@us...> - 2005-07-31 02:44:23
|
Update of /cvsroot/sitesampler/sitesampler/SiteSampler In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv9121 Modified Files: Account.pm AddProject.pm Data.pm Form.pm Project.pm Log Message: checkin of small bug fixes Index: Data.pm =================================================================== RCS file: /cvsroot/sitesampler/sitesampler/SiteSampler/Data.pm,v retrieving revision 1.1.1.1 retrieving revision 1.2 diff -C2 -d -r1.1.1.1 -r1.2 *** Data.pm 22 Jun 2005 01:38:22 -0000 1.1.1.1 --- Data.pm 31 Jul 2005 02:44:13 -0000 1.2 *************** *** 17,21 **** my $self = shift; my $objId = shift; ! my($cgi) = $self->getObjRefs([qw(cgi)]); $self->{'tableHash'} = $self->_tableLookUpHash; $self->_setDataSource; --- 17,21 ---- my $self = shift; my $objId = shift; ! my($cgi) = $self->cgi; $self->{'tableHash'} = $self->_tableLookUpHash; $self->_setDataSource; Index: Form.pm =================================================================== RCS file: /cvsroot/sitesampler/sitesampler/SiteSampler/Form.pm,v retrieving revision 1.1.1.1 retrieving revision 1.2 diff -C2 -d -r1.1.1.1 -r1.2 *** Form.pm 22 Jun 2005 01:38:23 -0000 1.1.1.1 --- Form.pm 31 Jul 2005 02:44:13 -0000 1.2 *************** *** 12,16 **** sub validateForm(){ my $self = shift; ! my($cgi,$msgs) = $self->getObjRefs([qw(cgi msgs)]); my @formElement = ''; my $errMsg = ''; --- 12,18 ---- sub validateForm(){ my $self = shift; ! my $cgi = $self->cgi; ! my $msgs = $self->msgs; ! my @formElement = ''; my $errMsg = ''; *************** *** 85,87 **** --- 87,97 ---- } + sub add_error{ + my $self = shift; + my($data_name,$error_msg) = @_; + $self->{$data_name}->{'startFont'} = '<font color="red">'; + $self->{$data_name}->{'endFont'} = '</font>'; + $self->msgs->addErr($error_msg); + } + 1; \ No newline at end of file Index: Project.pm =================================================================== RCS file: /cvsroot/sitesampler/sitesampler/SiteSampler/Project.pm,v retrieving revision 1.1.1.1 retrieving revision 1.2 diff -C2 -d -r1.1.1.1 -r1.2 *** Project.pm 22 Jun 2005 01:38:22 -0000 1.1.1.1 --- Project.pm 31 Jul 2005 02:44:13 -0000 1.2 *************** *** 122,125 **** --- 122,126 ---- my $self = shift; my($num_of_agents,$type) = @_; + $num_of_agents = $self->core->check_tag_limit($num_of_agents); for(1..$num_of_agents){ my $agent = SiteSampler::Agent->new; Index: Account.pm =================================================================== RCS file: /cvsroot/sitesampler/sitesampler/SiteSampler/Account.pm,v retrieving revision 1.1.1.1 retrieving revision 1.2 diff -C2 -d -r1.1.1.1 -r1.2 *** Account.pm 22 Jun 2005 01:38:23 -0000 1.1.1.1 --- Account.pm 31 Jul 2005 02:44:13 -0000 1.2 *************** *** 32,34 **** --- 32,50 ---- } + sub add_project{ + my $self = shift; + my($projectname,$num_agents,$agent_type) = @_; + my $project; #this acts as a boolean flag that we return to the caller + unless($self->data->objectExists($projectname,'SiteSampler::Project')){ + $project = SiteSampler::Project->new; + $project->ownerid($self->current_user->id); + $project->accountid($self->id); + $project->name($projectname); + $project->save; + $project->add_agents($num_agents,$agent_type); # type is an integer + $project->create_report; #this saves the project after the report is created + } + return($project); + } + 1; \ No newline at end of file Index: AddProject.pm =================================================================== RCS file: /cvsroot/sitesampler/sitesampler/SiteSampler/AddProject.pm,v retrieving revision 1.1.1.1 retrieving revision 1.2 diff -C2 -d -r1.1.1.1 -r1.2 *** AddProject.pm 22 Jun 2005 01:38:21 -0000 1.1.1.1 --- AddProject.pm 31 Jul 2005 02:44:13 -0000 1.2 *************** *** 12,16 **** } ! sub main(){ my $self = shift; if($self->core->checkPermissions($self,$self->current_user) --- 12,16 ---- } ! sub main{ my $self = shift; if($self->core->checkPermissions($self,$self->current_user) *************** *** 18,24 **** && defined($self->cgi->param($self->data->param('reqMethod'))) && $self->form->validateForm ) { - $self->add_project; $self->form->clearValues; } --- 18,24 ---- && defined($self->cgi->param($self->data->param('reqMethod'))) && $self->form->validateForm + && $self->add_project ) { $self->form->clearValues; } *************** *** 27,45 **** sub add_project{ my $self = shift; - - my $type = $self->cgi->param('type'); - my $num_of_agents = $self->core->check_tag_limit($self->cgi->param('numberOfTags')); my $projectname = $self->cgi->param('projectname'); ! ! my $project = SiteSampler::Project->new; ! $project->ownerid($self->current_user->id); ! $project->accountid($self->account->id); ! $project->name($projectname); ! $project->save; ! $project->add_agents($num_of_agents,$type); # type is an integer ! $project->create_report; #this saves the project after the report is created ! return(undef); } - 1; \ No newline at end of file --- 27,47 ---- sub add_project{ my $self = shift; my $projectname = $self->cgi->param('projectname'); ! my $num_agents = $self->cgi->param('numberOfTags'); ! my $agent_type = $self->cgi->param('type'); ! my $account = $self->account; ! my $project_added; ! if($self->data->objectExists($projectname,'SiteSampler::Project')){ ! # if an account with the same name exists, throw an error ! $self->form->add_error('projectname',"A project with the name $projectname already exists. Please choose another name"); ! }elsif($project_added = $account->add_project($projectname,$num_agents,$agent_type)){ ! # attempt to add the project, if success the method returns true ! $self->msgs->addSuccess("Project $projectname added successfully"); ! }else{ ! # this is bad joo jooz!!!!!!!!!! ! $self->msgs->addErr('Critical Error Please Contact the Administrator'); ! } ! return($project_added); } 1; \ No newline at end of file |
|
From: Farid A. <alf...@us...> - 2005-07-30 09:58:58
|
Update of /cvsroot/sitesampler/sitesampler/support In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv25242/sitesampler/support Modified Files: SiteSampler_Installation.pm SiteSampler_InstConfig.pm Log Message: Directories were created with very strange permissions, apparently, because of quotes around creation mode Index: SiteSampler_Installation.pm =================================================================== RCS file: /cvsroot/sitesampler/sitesampler/support/SiteSampler_Installation.pm,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** SiteSampler_Installation.pm 30 Jul 2005 08:44:58 -0000 1.1 --- SiteSampler_Installation.pm 30 Jul 2005 09:58:43 -0000 1.2 *************** *** 92,96 **** #cgi script installation comes with three stages: creation(modification), ! #copying(actual installation), and testing; these are happening in these: #fill_config commit_install and audit_install; $self->isWithScript ? $self->init_cgi_script : 0; --- 92,96 ---- #cgi script installation comes with three stages: creation(modification), ! #copying(actual installation), and testing; these are happening in stages: #fill_config commit_install and audit_install; $self->isWithScript ? $self->init_cgi_script : 0; Index: SiteSampler_InstConfig.pm =================================================================== RCS file: /cvsroot/sitesampler/sitesampler/support/SiteSampler_InstConfig.pm,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** SiteSampler_InstConfig.pm 30 Jul 2005 08:44:58 -0000 1.1 --- SiteSampler_InstConfig.pm 30 Jul 2005 09:58:43 -0000 1.2 *************** *** 12,15 **** --- 12,16 ---- use DBI; + use Data::Dumper; sub new { *************** *** 302,306 **** } ! sub default_creation_mode{'0755'} sub dbh{ --- 303,307 ---- } ! sub default_creation_mode{ return 0755} sub dbh{ *************** *** 327,349 **** sub dbh_key{ 'db_connection handle' } sub load_sql{ my $self = shift; my $dbh = $self->dbh; ! my $sqlFile = FileHandle->new ! or die(qq|Could not create file handle for the SQL file sitesampler.sql|); ! my $schema_file = File::Spec->catfile($self->{$self->support_path_key}, ); ! $sqlFile->open($schema_file,'<') ! or die qq|Could not open the file $schema_file: $!|; ! my @sql = <$sqlFile>; ! $sqlFile->close; ! my $query = join ' ', @sql; ! my $dbname = $self->get_set($self->dbname_key); ! $query =~ s/postgres/$dbname/; ! my $res = $dbh->do("$query;") if $query; ! $self->db_err_check; $dbh->disconnect; $self->unset_dbh; return 1; ! } sub writeCore{ --- 328,362 ---- sub dbh_key{ 'db_connection handle' } + sub list_sql_files{ + my $self = shift; + my $schema_file = File::Spec->catfile($self->{$self->support_path_key}, 'sitesampler.schema.sql' ); + my $updates_file = File::Spec->catfile( ($self->{$self->support_path_key}), 'sitesampler.updates.sql' ); + my $initdata_sql = File::Spec->catfile( ($self->{$self->support_path_key}), 'sitesampler.init.sql' ); + my @retval = ($schema_file, $updates_file, $initdata_sql); + return ( \@retval ); + } + sub load_sql{ my $self = shift; my $dbh = $self->dbh; ! print Dumper($self->list_sql_files); ! for my $sqlfile( @{ $self->list_sql_files }){ ! print qq|sql file is : |, $sqlfile,qq|\n|; ! my $sqlFile = FileHandle->new ! or die(qq|Could not create file handle for the SQL file : $!|); ! $sqlFile->open($sqlfile,'<') ! or die qq|Could not open the file $sqlfile: $!|; ! my @sql = <$sqlFile>; ! $sqlFile->close; undef $sqlFile; ! my $query = join ' ', @sql; ! my $dbname = $self->get_set($self->dbname_key); ! $query =~ s/postgres/$dbname/; ! my $res = $dbh->do("$query;") if $query; ! $self->db_err_check; ! } $dbh->disconnect; $self->unset_dbh; return 1; ! } sub writeCore{ |
|
From: Farid A. <alf...@us...> - 2005-07-30 08:45:08
|
Update of /cvsroot/sitesampler/sitesampler/support In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13573/support Added Files: SiteSampler_InstConfig.pm run.pl SiteSampler_Installation.pm Log Message: initial commit of installation code --- NEW FILE: run.pl --- #!/usr/bin/perl -w use strict; use Data::Dumper; use SiteSampler_Installation; use SiteSampler_InstConfig; my $ss_inst = SiteSampler_Installation->new; $ss_inst->run; print Dumper($ss_inst); --- NEW FILE: SiteSampler_Installation.pm --- package SiteSampler_Installation; use SiteSampler_InstConfig; use strict; sub new { my $class = shift; my $self = bless {}, $class; return $self; } sub with_cgi_script{ my $self = shift; my $key = $self->with_cgi_script_key; if (@_ == 1){ $self->{$key} = (shift); } return $self->{$key}; } sub with_cgi_script_key{ 'with_cgi_script_key' } sub started_key{ 'Started_Install' } sub stopped_key{ 'Stopped Install' } sub config_key{ 'Configuration_Object' } sub start{ my $self = shift; $self->get_set($self->started_key, 1); print "Welcome to SiteSampler click-stream analyzer configuration and installation.\n\n"; $self->checkRoot; my $config = SiteSampler_InstConfig->new; $self->get_set($self->config_key, $config); } sub stop{ my $self = shift; $self->get_set($self->stopped_key, 1); $self->clean_up; } sub finish{ my $self = shift; exit(0); } sub get_set{ my $self = shift; my($member_key) = shift; if(@_ == 1 ){ $self->{$member_key} = shift; } return($self->{$member_key}); } sub run{ my $self = shift; $self->start; $self->fill_config; $self->test_config; $self->commit_install; $self->audit_install; $self->stop; #$self->finish; } sub test_config{ my $self = shift; } sub fill_config { my $self = shift; $self->init_base; $self->init_db; $self->init_install_paths; #cgi script installation comes with three stages: creation(modification), #copying(actual installation), and testing; these are happening in these: #fill_config commit_install and audit_install; $self->isWithScript ? $self->init_cgi_script : 0; } sub init_cgi_script{ my $self = shift; $self->init_cgi_dir; $self->get_script_name; } sub init_cgi_dir{ my $self = shift; print qq|What is the path to your executable bin (cgi-bin or mod_perl enabled directory)? [/usr/local/apache2/cgi-bin]\n|; $self->config->set_cgiscript_path( $self->get_stdin_str ); } sub get_script_name{ my $self = shift; print qq|What would you like to name the web accessible script? <sitesampler>\n|; $self->config->set_cgiscript_name( $self->get_stdin_str ); } sub isWithScript{ my $self = shift; print "You will need to provide path to Apache1/2 cgi-bin or mod_perl enabled directory to install sitesampler.cgi script. (Yes)if you know that path and would like to install cgi script ; (No) If you would like to copy script manually later. \n"; if ($self->get_stdin_bool){ $self->with_cgi_script(1); } else{ $self->with_cgi_script; } } sub checkRoot{ my $self = shift; print qq|This installation needs to be run as a privileged user to modify file and directory permissions. If you logged in as a user that does not have sufficiennt privileges, this installation will fail. Continue?(y/n)\n|; if ($self->get_stdin_bool){ print qq|assuming that user has sufficient permissions; based on user input ..\n|; } else{ print qq|Cancelled by user\n|; $self->finish; } } sub commit_install{ my $self = shift; $self->create_install_dirs; $self->create_codebase; $self->createDB; $self->with_cgi_script ? $self->create_cgi_script : 0; } sub create_install_dirs{ my $self = shift; print qq|Creating installation paths\n|; $self->config->make_install_paths; } sub create_codebase{ my $self = shift; print qq|Copying perl modules.. \n|; $self->config->copy_codebase; print qq|Altering DataSettings.pm to add database connection information\n|; $self->config->writeDataSettings; } sub createDB{ my $self = shift; print qq|Creating database, inserting default values.. \n|; $self->config->load_sql; $self->config->writeCore; } sub create_cgi_script{ my $self = shift; print qq|Creating and installing cgi script \n|; $self->config->write_cgi_script; } sub audit_install{ my $self = shift; } sub init_base{ my $self = shift; $self->config->set_base; } sub config{ my $self = shift; return $self->{$self->config_key} ; } sub init_db{ my $self = shift; $self->setDBuser; #database user $self->setDBname; #database name $self->setDBpass; #confusingly and surprizingly, this is database password $self->test_DBconnection; } sub test_DBconnection{ my $self = shift; $self->config->test_dbconn; } sub setDBuser{ my $self = shift; print qq|Please, enter database user name<postgres>\n|; $self->config->set_dbuser( $self->get_stdin_str ); } sub setDBname{ my $self = shift; print qq|Please, enter database name<sitesampler>\n|; $self->config->set_dbname( $self->get_stdin_str ); } sub setDBpass{ my $self = shift; print qq|Please, enter database password\n|; $self->config->set_dbpass( $self->get_stdin_str ); } sub init_install_paths{ my $self = shift; $self->init_targetdir; $self->init_perlmods_path; $self->init_tags_path; $self->init_cache_path; $self->init_logs_path; } sub init_targetdir{ my $self = shift; print qq|Please, enter directory path, where SiteSampler will be installed.[/usr/local/sitesampler]\n|; $self->config->set_install_path( $self->get_stdin_str ); } sub init_perlmods_path{ my $self = shift; print qq|Please, enter directory path, where SiteSampler perl-modules will exist.[/usr/local/sitesampler/perlmods]\n|; $self->config->set_perlmods_path( $self->get_stdin_str ); } sub init_tags_path{ my $self = shift; print qq|Please, enter directory path, where SiteSampler site project tags will exist.[/usr/local/sitesampler/site_data]\n|; $self->config->set_tag_path( $self->get_stdin_str ); } sub init_cache_path{ my $self= shift; print qq|Please, enter directory path, where SiteSampler cache will be installed.[/usr/local/sitesampler/cache]\n|; $self->config->set_cache_path( $self->get_stdin_str ); } sub init_logs_path{ my $self = shift; print qq|Please, enter directory path, where SiteSampler logs will live.[/usr/local/sitesampler/logs]\n|; $self->config->set_log_path( $self->get_stdin_str ); } sub get_stdin_bool{ my $self = shift; my $a = <STDIN>; chomp($a); my $retval = 0; if ($a =~ /y/i){ $retval = 1; } return $retval; } sub get_stdin_str{ my $self = shift; my $a = <STDIN>; chomp ($a); my $retval = undef; if ($a){ $retval = $a; } return $retval; } sub clean_up{ my $self = shift; } 1; =head1 NAME SiteSampler_Installation =head1 SYNOPSIS use SiteSampler_Installation; my $obj = SiteSampler_Installation->new(); =head1 DESCRIPTION SiteSampler_Installation =head1 AUTHOR Farid Aliev, E<lt>fa...@gm...<gt> =head1 COPYRIGHT AND LICENSE Copyright (C) 2005 by Farid Aliev This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.7 or, at your option, any later version of Perl 5 you may have available. =cut --- NEW FILE: SiteSampler_InstConfig.pm --- package SiteSampler_InstConfig; use strict; use File::Copy; use File::Path; use File::Spec; use DirHandle; use FileHandle; use DBI; sub new { my $class = shift; my $self = bless {}, $class; return $self; } sub make_install_paths{ my $self = shift; $self->create_install_path; $self->create_perlmods_path ; # PerlMods $self->create_cache_path ; # SitesamplerCache $self->create_log_path; # SiteSamplerLogs $self->create_tag_path; #TagDirectory } sub create_install_path{ my $self = shift; my $path = $self->{$self->install_path_key}; $self->create_dir($path, $self->creation_mode); } sub create_perlmods_path{ my $self = shift; my $path = $self->{$self->perlmods_path_key}; $self->create_dir($path, $self->creation_mode); } sub create_cache_path{ my $self = shift; my $path = $self->{$self->cache_path_key}; $self->create_dir($path, $self->creation_mode); } sub create_log_path{ my $self = shift; my $path = $self->{$self->log_path_key}; $self->create_dir($path, $self->creation_mode); } sub create_tag_path{ my $self = shift; my $path = $self->{$self->tag_path_key}; $self->create_dir($path, $self->creation_mode); } sub copy_codebase{ my $self = shift; my $install_dir = File::Spec->canonpath( $self->{$self->install_path_key} ); my $perlmods_dir = File::Spec->canonpath( $self->{$self->perlmods_path_key} ); my $base_dir = File::Spec->canonpath( $self->{$self->base_path_key} ); my $dir_handle = DirHandle->new($base_dir) or (die qq|Unknown error: could not open directory $base_dir : $!|); foreach my $node( File::Spec->no_upwards($dir_handle->read) ){ if ($node =~ /CVS/ ){ next } $node = File::Spec->catfile($base_dir, $node); my $source = $node; my $dest = $perlmods_dir; if ($node =~ /support$/) { $dest = $install_dir } my $retval = system("cp -rf $source $dest"); if ($retval){ die qq|Unknown error: cp command returned this: $retval \n|; } } } sub writeDataSettings{ my $self = shift; my $filename = File::Spec->catfile( ($self->{$self->perlmods_path_key}),'SiteSampler', 'Data', 'DataSettings.pm'); if(! -e $filename){ die qq| Cannot find the Data Settings file, DataSettings.pm.\n\n|; } my $dbname = $self->{$self->dbname_key}; my $dbuser = $self->{$self->dbuser_key}; my $dbpass = $self->{$self->dbpass_key}; my $dataFile = FileHandle->new; $dataFile->open($filename,q|<|) or die(qq|$filename, $!|); my @code = <$dataFile>; for my $line(@code){ if ($line =~ /return\(\'PostgreSQL\'/){ $line = qq| return('PostgreSQL', "dbi:Pg:dbname=$dbname", "$dbuser", "$dbpass", {AutoCommit => 1});\n|; } } $dataFile->open($filename,q|>|) or die(qq|$filename, $!|);#for writing $dataFile->print(@code); $dataFile->close; return; } sub write_cgi_script{ my $self = shift; my $base_script = File::Spec->catfile( ($self->{$self->support_path_key}), ($self->default_cgiscript_name) ); #print qq|base script is : |,$base_script; my $target_script = File::Spec->catfile( ($self->{$self->cgiscript_path_key}), ($self->{$self->cgiscript_name_key}) ) ; #print qq|target script is : |,$target_script; File::Copy::copy($base_script , $target_script) or die(qq|Could not copy sitesampler base cgi script into executable directory: $! \n|); chmod(0755, $target_script) or die qq|Unknown error while changing permissions on cgi script: chmod failed with: $!\n|; $self->edit_script_uselib; return(1); } sub edit_script_uselib{ my $self = shift; my $filename = File::Spec->catfile( ($self->{$self->cgiscript_path_key}) , ($self->{$self->cgiscript_name_key}) ); if(! -e $filename){ die qq| Cannot find created cgi script, $filename. \n\n|; } my $lib = File::Spec->catdir( $self->{$self->perlmods_path_key}); my $dataFile = FileHandle->new; $dataFile->open($filename,'<') or die(qq|$filename, $!|); my @code = <$dataFile>; for my $line(@code){ if ($line =~ /use lib/){ $line = qq|use lib('$lib'); #inserted by install\n|; } } $dataFile->open($filename,'>') or die(qq|$filename, $!|);#for writing $dataFile->print(@code); $dataFile->close; return; } #object hash keys sub base_path_key{ 'BaseDir' } # this is where this code has been checked-out to. sub support_path_key{ 'SupportDir' } # this is where this code is running from. sub dbname_key{ 'DBname' } sub dbuser_key{ 'DBuser' } sub dbpass_key{ 'DBpass' } sub install_path_key{ 'InstallDir' } sub perlmods_path_key { 'PerlMods' } sub cache_path_key{ 'SitesamplerCache' } sub log_path_key{ 'SiteSamplerLogs' } sub tag_path_key{ 'TagDirectory' } sub latest_logs_path_key{ 'LatestLogsDir' } sub temp_logs_path_key{ 'TempLogsDir' } sub arch_logs_path_key{ 'ArchivedLogsDir' } sub locked_logs_path_key{ 'LockedLogsDir' } sub error_logs_path_key{ 'ErroredLogsDir' } sub template_path_key{ 'TemplateDir' } sub image_path_key{ 'WebUI_ImageDir' } sub cgiscript_path_key{ 'cgiscript_path' } sub cgiscript_name_key{ 'cgiscript_name' } #DEFAULTS.. #db defaults sub default_dbname{'sitesampler'} sub default_dbuser{'postgres'} sub default_dbpass{''} #installation defaults sub default_install_path{'/usr/local/sitesampler'} sub default_perlmods_path{'/usr/local/sitesampler/perl_mods'} sub default_cache_path{'/usr/local/sitesampler/cache'} sub default_log_path{'/usr/local/sitesampler/logs'} sub default_tag_path{'/usr/local/sitesampler/site_data'} #logs paths defaults sub default_log_errors_path{'/usr/local/sitesampler/logs/errors'} sub default_log_latest_path{'/usr/local/sitesampler/logs/latest'} sub default_log_temp_path{'/usr/local/sitesampler/logs/temp'} sub default_log_arch_path{'/usr/local/sitesampler/logs/archived'} sub default_log_locked_path{'/usr/local/sitesampler/logs/locked'} sub default_template_path{''} sub default_cgiscript_path{'/usr/local/apache2/cgi-bin'} sub default_cgiscript_name{'sitesampler'} sub set_base{ my $self = shift; my $support = File::Spec->rel2abs( File::Spec->curdir() ); my $base = File::Spec->rel2abs( File::Spec->updir( $support ) ); $self->get_set( $self->base_path_key, $base ); $self->get_set($self->support_path_key, $support); } sub test_dbconn{ my $self = shift; my $dbh = $self->dbh; $dbh->disconnect; $self->unset_dbh; return 1; } sub set_dbname{ my $self = shift; my $dbname = (defined ($_ = shift)) ? $_ : $self->default_dbname; $self->get_set($self->dbname_key, $dbname); } sub set_dbuser{ my $self = shift; my $dbuser = (defined ($_ = shift)) ? $_ : $self->default_dbuser; $self->get_set($self->dbuser_key, $dbuser); } sub set_dbpass{ my $self = shift; my $dbpass = (defined ($_ = shift)) ? $_ : $self->default_dbpass; $self->get_set($self->dbpass_key, $dbpass); } sub set_install_path{ my $self = shift; my $install_path = (defined ($_ = shift)) ? $_ : $self->default_install_path; $self->get_set($self->install_path_key, $install_path); } sub set_perlmods_path{ my $self = shift; my $perlmods_path = (defined ($_ = shift)) ? $_ : $self->default_perlmods_path; $self->get_set($self->perlmods_path_key, $perlmods_path); } sub set_cache_path{ my $self = shift; my $cache_path = (defined ($_ = shift)) ? $_ : $self->default_cache_path; $self->get_set($self->cache_path_key, $cache_path); } sub set_tag_path{ my $self = shift; my $tag_path = (defined ($_ = shift)) ? $_ : $self->default_tag_path; $self->get_set($self->tag_path_key, $tag_path); } sub set_log_path{ my $self = shift; my $log_path = (defined ($_ = shift)) ? $_ : $self->default_log_path; $self->get_set($self->log_path_key, $log_path); } sub set_cgiscript_path{ my $self = shift; my $cgiscript_path = (defined ($_ = shift)) ? $_ : $self->default_cgiscript_path; $self->get_set($self->cgiscript_path_key, $cgiscript_path); } sub set_cgiscript_name{ my $self = shift; my $cgiscript_name = (defined ($_ = shift)) ? $_ : $self->default_cgiscript_name; $self->get_set($self->cgiscript_name_key, $cgiscript_name); } sub get_set{ my $self = shift; my($member_key) = shift; if(@_ == 1 ){ $self->{$member_key} = shift; } return($self->{$member_key}); } sub db_err_check{ my $self = shift; if( $DBI::errstr){ print (qq|There is DBI ERROR, installation is terminated: |, $DBI::errstr, $!); } } sub create_dir{ my $self = shift; my $dir = shift; my $creation_mode = shift; eval( mkpath($dir, 1, $creation_mode)); if ($@){ print qq|Error: couldn't create directory $dir: $@\n|; $self->finish; } else{ return 1; } } sub creation_mode{ my $self = shift; return ($self->default_creation_mode); } sub default_creation_mode{'0755'} sub dbh{ my $self = shift; my $key = $self->dbh_key; unless (exists $self->{$key}){ my $dbname = $self->get_set($self->dbname_key); my $dbuser = $self->get_set($self->dbuser_key); my $dbpass = $self->get_set($self->dbpass_key); $self->{$key} = DBI->connect("dbi:Pg:dbname=$dbname", "$dbuser", "$dbpass", { AutoCommit => 1, RaiseError => 1 } ); $self->db_err_check; } return ( $self->{$key} ); } sub unset_dbh{ my $self = shift; delete $self->{$self->dbh_key}; } sub dbh_key{ 'db_connection handle' } sub load_sql{ my $self = shift; my $dbh = $self->dbh; my $sqlFile = FileHandle->new or die(qq|Could not create file handle for the SQL file sitesampler.sql|); my $schema_file = File::Spec->catfile($self->{$self->support_path_key}, ); $sqlFile->open($schema_file,'<') or die qq|Could not open the file $schema_file: $!|; my @sql = <$sqlFile>; $sqlFile->close; my $query = join ' ', @sql; my $dbname = $self->get_set($self->dbname_key); $query =~ s/postgres/$dbname/; my $res = $dbh->do("$query;") if $query; $self->db_err_check; $dbh->disconnect; $self->unset_dbh; return 1; } sub writeCore{ my $self = shift; } 1; =head1 NAME SiteSampler_InstConfig =head1 SYNOPSIS use SiteSampler_InstConfig; my $obj = SiteSampler_InstConfig->new(); =head1 DESCRIPTION SiteSampler_InstConfig =head1 AUTHOR Farid Aliev, E<lt>fa...@gm...<gt> =head1 COPYRIGHT AND LICENSE Copyright (C) 2005 by Farid Aliev This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.3 or, at your option, any later version of Perl 5 you may have available. =cut |
|
From: Shane H. <sha...@us...> - 2005-07-25 01:28:50
|
Update of /cvsroot/sitesampler/sitesampler/support In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv14948/support Modified Files: sitesampler.schema.sql Log Message: added the default value of -1 to a report_id for an agent. agents are now using the report id from the project that they belong to Index: sitesampler.schema.sql =================================================================== RCS file: /cvsroot/sitesampler/sitesampler/support/sitesampler.schema.sql,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** sitesampler.schema.sql 22 Jul 2005 03:42:17 -0000 1.3 --- sitesampler.schema.sql 25 Jul 2005 01:28:40 -0000 1.4 *************** *** 118,122 **** "s_accessPerms" text DEFAULT ''::text, n_creation_date integer, ! n_report_id integer ); --- 118,122 ---- "s_accessPerms" text DEFAULT ''::text, n_creation_date integer, ! n_report_id integer DEFAULT -1 ); |
|
From: Shane H. <sha...@us...> - 2005-07-25 01:26:19
|
Update of /cvsroot/sitesampler/sitesampler/support In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv14408/support Added Files: sitesampler.updates.sql Log Message: adding a file that will be used to track any manual changes that are made to a live database to accommodate changes --- NEW FILE: sitesampler.updates.sql --- alter table agents alter column n_report_id set default -1; |
|
From: Shane H. <sha...@us...> - 2005-07-25 00:43:44
|
Update of /cvsroot/sitesampler/sitesampler/SiteSampler/Agent/Template/Basic In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv6155/SiteSampler/Agent/Template/Basic Modified Files: Basic Log Message: discovered a pretty serious bug where we were logging solicitations when there were no solicitations. the solution required a change to the javascripts so that sending stats would happen at the right time. Index: Basic =================================================================== RCS file: /cvsroot/sitesampler/sitesampler/SiteSampler/Agent/Template/Basic/Basic,v retrieving revision 1.1.1.1 retrieving revision 1.2 diff -C2 -d -r1.1.1.1 -r1.2 *** Basic 22 Jun 2005 01:38:28 -0000 1.1.1.1 --- Basic 25 Jul 2005 00:43:24 -0000 1.2 *************** *** 102,105 **** --- 102,106 ---- Zev = <TMPL_VAR NAME=js_event>; Zsw = <TMPL_VAR NAME=solicit_window>; + ZsurveyWin = null; if(Zrv > <TMPL_VAR NAME=sampling_rate>){ *************** *** 107,112 **** } ! if(!Zsw)Zss='window.location.href=ZSU;'; ! else if(Zsw)Zss='surveyWin=window.open(ZSU,"surveyWin",Zwp);'; if(Zev==0){ --- 108,115 ---- } ! if(!Zsw) ! Zss='ss_t.send_stats("1",false); window.location.href=ZSU;'; ! else if(Zsw) ! Zss='ZsurveyWin = window.open(ZSU,"surveyWin",Zwp); if(ZsurveyWin){ ss_t.send_stats("1",false);}'; if(Zev==0){ *************** *** 160,164 **** function Zav(){ if(ZUQ) ZSU += makeQstr(); - ss_t.send_stats("1",false); eval(Zss); } --- 163,166 ---- |
|
From: Shane H. <sha...@us...> - 2005-07-25 00:43:44
|
Update of /cvsroot/sitesampler/sitesampler/SiteSampler/Agent/Template/ImpressionTracking In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv6155/SiteSampler/Agent/Template/ImpressionTracking Modified Files: ImpressionTracking Log Message: discovered a pretty serious bug where we were logging solicitations when there were no solicitations. the solution required a change to the javascripts so that sending stats would happen at the right time. Index: ImpressionTracking =================================================================== RCS file: /cvsroot/sitesampler/sitesampler/SiteSampler/Agent/Template/ImpressionTracking/ImpressionTracking,v retrieving revision 1.1.1.1 retrieving revision 1.2 diff -C2 -d -r1.1.1.1 -r1.2 *** ImpressionTracking 22 Jun 2005 01:38:29 -0000 1.1.1.1 --- ImpressionTracking 25 Jul 2005 00:43:24 -0000 1.2 *************** *** 151,158 **** ZSU = '<TMPL_VAR NAME=solicit_url>'; Ztop1 = (new Date() * 1); - if(!Zsw)Zss='top.location.href=ZSU;'; - else if(Zsw)Zss='surveyWin=window.open(ZSU,"surveyWin",Zwp);'; - if(window.onunload)Zss+=Zgc(window.onunload); eval("window.onunload=Zav"); } --- 151,164 ---- ZSU = '<TMPL_VAR NAME=solicit_url>'; Ztop1 = (new Date() * 1); + ZsurveyWin = null; + + if(!Zsw) + Zss='ss_t.send_stats("1",false);top.location.href=ZSU;'; + else if(Zsw) + Zss='ZsurveyWin=window.open(ZSU,"surveyWin",Zwp); if(ZsurveyWin) {ss_t.send_stats("1",false);} '; + + if(window.onunload) + Zss+=Zgc(window.onunload); eval("window.onunload=Zav"); } *************** *** 193,197 **** function Zav(){ - ss_t.send_stats("1",false); if(ZUQ) ZSU += makeQstr(); eval(Zss); --- 199,202 ---- |
|
From: Shane H. <sha...@us...> - 2005-07-25 00:43:43
|
Update of /cvsroot/sitesampler/sitesampler/SiteSampler/Agent In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv6155/SiteSampler/Agent Modified Files: Data.pm Log Message: discovered a pretty serious bug where we were logging solicitations when there were no solicitations. the solution required a change to the javascripts so that sending stats would happen at the right time. Index: Data.pm =================================================================== RCS file: /cvsroot/sitesampler/sitesampler/SiteSampler/Agent/Data.pm,v retrieving revision 1.1.1.1 retrieving revision 1.2 diff -C2 -d -r1.1.1.1 -r1.2 *** Data.pm 22 Jun 2005 01:38:28 -0000 1.1.1.1 --- Data.pm 25 Jul 2005 00:43:24 -0000 1.2 *************** *** 36,40 **** sub log_path{ my $self = shift; ! return File::Spec->catdir($self->core->parent_dir,$self->core->rel_log_path,$self->core->rel_latest_log_path); } --- 36,40 ---- sub log_path{ my $self = shift; ! return File::Spec->catdir($self->core->latest_log_path); } |
|
From: Shane H. <sha...@us...> - 2005-07-25 00:43:37
|
Update of /cvsroot/sitesampler/sitesampler/SiteSampler/Agent/Template/OnExit In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv6155/SiteSampler/Agent/Template/OnExit Modified Files: OnExit Log Message: discovered a pretty serious bug where we were logging solicitations when there were no solicitations. the solution required a change to the javascripts so that sending stats would happen at the right time. Index: OnExit =================================================================== RCS file: /cvsroot/sitesampler/sitesampler/SiteSampler/Agent/Template/OnExit/OnExit,v retrieving revision 1.1.1.1 retrieving revision 1.2 diff -C2 -d -r1.1.1.1 -r1.2 *** OnExit 22 Jun 2005 01:38:29 -0000 1.1.1.1 --- OnExit 25 Jul 2005 00:43:24 -0000 1.2 *************** *** 145,157 **** function solicitUser(){ - ss_t.send_stats("1"); if(Zuq) Zsu += makeQstr(); var Zurl = Zsu; if(Ztc) Zurl = 'http://$ENV{'HTTP_HOST'}$COOKIE_PATH/<TMPL_VAR NAME=agentid>/setCookie?' + Zurl; if(!Zsw){ top.location.href=(Zurl); } else{ Zwin=window.open(Zurl,"Zpn",Zwp); } --- 145,159 ---- function solicitUser(){ if(Zuq) Zsu += makeQstr(); var Zurl = Zsu; if(Ztc) Zurl = 'http://$ENV{'HTTP_HOST'}$COOKIE_PATH/<TMPL_VAR NAME=agentid>/setCookie?' + Zurl; if(!Zsw){ + ss_t.send_stats("1",false); top.location.href=(Zurl); } else{ Zwin=window.open(Zurl,"Zpn",Zwp); + if(Zwin) + ss_t.send_stats("1",false); } |
|
From: Shane H. <sha...@us...> - 2005-07-25 00:43:32
|
Update of /cvsroot/sitesampler/sitesampler/SiteSampler In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv6155/SiteSampler Modified Files: Core.pm Log Message: discovered a pretty serious bug where we were logging solicitations when there were no solicitations. the solution required a change to the javascripts so that sending stats would happen at the right time. Index: Core.pm =================================================================== RCS file: /cvsroot/sitesampler/sitesampler/SiteSampler/Core.pm,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** Core.pm 6 Jul 2005 12:24:32 -0000 1.2 --- Core.pm 25 Jul 2005 00:43:23 -0000 1.3 *************** *** 107,111 **** sub rel_latest_log_path{ ! warn("this method is deprecated as of 7/5/2005"); my $self = shift; $self->get_set('s_rel_log_latest_path',@_); --- 107,111 ---- sub rel_latest_log_path{ ! warn("the method rel_latest_log_path is deprecated as of 7/5/2005 use latest_log_path instead"); my $self = shift; $self->get_set('s_rel_log_latest_path',@_); |
|
From: Shane H. <sha...@us...> - 2005-07-22 03:44:25
|
Update of /cvsroot/sitesampler/sitesampler/support In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv29972/support Modified Files: sitesampler.schema.sql statd.pl Log Message: changes to the SiteSampler::Agent object such that the report object returned from the report method is the same object returned from the report method of the project object. also removed some extraneous stuff from the schema sql file added the ability to fork the processing of stats off to its own process if necessary Index: statd.pl =================================================================== RCS file: /cvsroot/sitesampler/sitesampler/support/statd.pl,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** statd.pl 18 Jul 2005 01:36:40 -0000 1.2 --- statd.pl 22 Jul 2005 03:42:18 -0000 1.3 *************** *** 18,22 **** my($ss) = @_; for my $agent ($ss->core->agents){ ! $agent->process_forked(1); $agent->update_stats; } --- 18,22 ---- my($ss) = @_; for my $agent ($ss->core->agents){ ! $agent->process_forked(0); $agent->update_stats; } Index: sitesampler.schema.sql =================================================================== RCS file: /cvsroot/sitesampler/sitesampler/support/sitesampler.schema.sql,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** sitesampler.schema.sql 6 Jul 2005 12:24:36 -0000 1.2 --- sitesampler.schema.sql 22 Jul 2005 03:42:17 -0000 1.3 *************** *** 3,10 **** -- - SET client_encoding = 'SQL_ASCII'; - SET check_function_bodies = false; - SET client_min_messages = warning; - -- -- Name: SCHEMA public; Type: COMMENT; Schema: -; Owner: postgres --- 3,6 ---- |
|
From: Shane H. <sha...@us...> - 2005-07-22 03:43:59
|
Update of /cvsroot/sitesampler/sitesampler/SiteSampler In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv29972/SiteSampler Modified Files: Agent.pm Log Message: changes to the SiteSampler::Agent object such that the report object returned from the report method is the same object returned from the report method of the project object. also removed some extraneous stuff from the schema sql file added the ability to fork the processing of stats off to its own process if necessary Index: Agent.pm =================================================================== RCS file: /cvsroot/sitesampler/sitesampler/SiteSampler/Agent.pm,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** Agent.pm 18 Jul 2005 01:36:38 -0000 1.7 --- Agent.pm 22 Jul 2005 03:42:16 -0000 1.8 *************** *** 32,36 **** my $key = $self->report_key; unless(exists $self->{$key}){ ! $self->{$key} = SiteSampler::Report->new($self->report_id); } return($self->{$key}); --- 32,37 ---- my $key = $self->report_key; unless(exists $self->{$key}){ ! # use the same report object that the parent does ! $self->{$key} = $self->project->report; } return($self->{$key}); *************** *** 49,53 **** sub report_id{ my $self = shift; ! return $self->get_set($self->report_id_key,@_); } --- 50,55 ---- sub report_id{ my $self = shift; ! return $self->project->report_id; ! # return $self->get_set($self->report_id_key,@_); } *************** *** 150,154 **** $report->cache; $report->set_report_html; - # print $report->report_html; $report->save; } --- 152,155 ---- |
|
From: Shane H. <sha...@us...> - 2005-07-22 03:42:55
|
Update of /cvsroot/sitesampler/sitesampler/SiteSampler/Report In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv29972/SiteSampler/Report Modified Files: Base.pm Log Message: changes to the SiteSampler::Agent object such that the report object returned from the report method is the same object returned from the report method of the project object. also removed some extraneous stuff from the schema sql file added the ability to fork the processing of stats off to its own process if necessary Index: Base.pm =================================================================== RCS file: /cvsroot/sitesampler/sitesampler/SiteSampler/Report/Base.pm,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** Base.pm 18 Jul 2005 01:36:38 -0000 1.8 --- Base.pm 22 Jul 2005 03:42:17 -0000 1.9 *************** *** 5,8 **** --- 5,9 ---- use HTML::Template; use DB_File; + # use BerkeleyDB; use SiteSampler::Object; use base qw(SiteSampler::Object); *************** *** 33,38 **** if(exists $hash_type{tied}){ my $cache_path = $hash_type{tied}; ! tie(%$cache, "DB_File", $cache_path) ! or die("Cannot open file $cache_path: $!\n"); } return($cache); --- 34,44 ---- if(exists $hash_type{tied}){ my $cache_path = $hash_type{tied}; ! =cutcode ! tie %$cache, "BerkeleyDB::Btree", ! -Filename => $cache_path, ! -Flags => DB_CREATE ! or die "Cannot open file $cache_path: $! $BerkeleyDB::Error\n" ; ! =cut ! tie(%$cache, "DB_File", $cache_path) or die("Cannot open file $cache_path: $!\n"); } return($cache); |
|
From: Shane H. <sha...@us...> - 2005-07-18 01:36:49
|
Update of /cvsroot/sitesampler/sitesampler/SiteSampler/Report/Solicitations In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv6252/SiteSampler/Report/Solicitations Modified Files: Solicitation.pm Log Message: this is a big commit related to fixing the report object Index: Solicitation.pm =================================================================== RCS file: /cvsroot/sitesampler/sitesampler/SiteSampler/Report/Solicitations/Solicitation.pm,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** Solicitation.pm 6 Jul 2005 12:24:35 -0000 1.2 --- Solicitation.pm 18 Jul 2005 01:36:39 -0000 1.3 *************** *** 1,4 **** package SiteSampler::Report::Solicitations::Solicitation; - use Digest::MD5; use SiteSampler::Report::Base::Child; use base qw(SiteSampler::Report::Base::Child); --- 1,3 ---- |
|
From: Shane H. <sha...@us...> - 2005-07-18 01:36:49
|
Update of /cvsroot/sitesampler/sitesampler/SiteSampler In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv6252/SiteSampler Modified Files: Agent.pm Report.pm Log Message: this is a big commit related to fixing the report object Index: Report.pm =================================================================== RCS file: /cvsroot/sitesampler/sitesampler/SiteSampler/Report.pm,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** Report.pm 6 Jul 2005 12:24:32 -0000 1.4 --- Report.pm 18 Jul 2005 01:36:38 -0000 1.5 *************** *** 55,58 **** --- 55,64 ---- } + sub cache_html_path{ + my $self = shift; + return $self->cache_file_path."_html"; + } + + sub latest_date_key{'n_latest_date'} *************** *** 136,149 **** my $viewer = SiteSampler::Report::Viewer->new; my $html_arr = $viewer->html_report($self); ! $self->report_html("@$html_arr"); } sub report_html{ my $self = shift; ! my $html = $self->get_set('s_report_html',@_) ! || qq|This report has not been updated since it was created. The update will happen within the next 24 hours.|; return($html); } sub analyze_log_data{ my $self = shift; --- 142,173 ---- my $viewer = SiteSampler::Report::Viewer->new; my $html_arr = $viewer->html_report($self); ! Storable::store($html_arr,$self->cache_html_path); ! chmod(0777,$self->cache_html_path); } sub report_html{ my $self = shift; ! my $html = qq|This report has not been updated since it was created. The update will happen within the next 24 hours.|; ! if(-e $self->cache_html_path){ ! $html = Storable::retrieve($self->cache_html_path); ! $html = "@$html"; ! } return($html); } + sub user_id_idx{ + my $self = shift; + my($user_id) = @_; + + my $key = 'user_ids'; + $self->{$key} = {} unless(exists $self->{$key}); + + unless(exists $self->{$key}->{$user_id}){ + $self->{$key}->{$user_id} = scalar(keys %{$self->{$key}}) + 1; + } + + return $self->{$key}->{$user_id}; + } + sub analyze_log_data{ my $self = shift; *************** *** 163,167 **** $self->monitors->analyze($log_entry); $self->os->analyze($log_entry); ! # $self->profiles->analyze($log_entry); $self->users->analyze($log_entry); $self->urls->analyze($log_entry); --- 187,191 ---- $self->monitors->analyze($log_entry); $self->os->analyze($log_entry); ! $self->profiles->analyze($log_entry); $self->users->analyze($log_entry); $self->urls->analyze($log_entry); Index: Agent.pm =================================================================== RCS file: /cvsroot/sitesampler/sitesampler/SiteSampler/Agent.pm,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** Agent.pm 6 Jul 2005 12:24:32 -0000 1.6 --- Agent.pm 18 Jul 2005 01:36:38 -0000 1.7 *************** *** 78,86 **** --- 78,119 ---- } + sub process_forked{ + my $self = shift; + return $self->get_set('process_forked',@_); + } + sub process_log{ my $self = shift; + if($self->process_forked){ + $self->_process_log_forked; + }else{ + $self->_process_log; + } + } + + sub _process_log{ + my $time = time; + my $self = shift; $self->load_log($self->temp_log_fh); $self->archive_log; $self->unlock_log; + $time = time - $time; + print "done in $time seconds\n"; + } + + sub _process_log_forked{ + my $self = shift; + my $pid = fork; + if($pid){ + # in the parent + wait; + die($?) if($?); + }elsif(defined($pid)){ + print "My PID: $$\n"; + $self->_process_log; + exit(0); + }else{ + die("fork failed : $!"); + } } *************** *** 117,120 **** --- 150,154 ---- $report->cache; $report->set_report_html; + # print $report->report_html; $report->save; } |
|
From: Shane H. <sha...@us...> - 2005-07-18 01:36:49
|
Update of /cvsroot/sitesampler/sitesampler/support In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv6252/support Modified Files: statd.pl Log Message: this is a big commit related to fixing the report object Index: statd.pl =================================================================== RCS file: /cvsroot/sitesampler/sitesampler/support/statd.pl,v retrieving revision 1.1.1.1 retrieving revision 1.2 diff -C2 -d -r1.1.1.1 -r1.2 *** statd.pl 22 Jun 2005 01:38:32 -0000 1.1.1.1 --- statd.pl 18 Jul 2005 01:36:40 -0000 1.2 *************** *** 1,5 **** #!/usr/bin/perl -w use strict; ! no warnings; use FileHandle; --- 1,5 ---- #!/usr/bin/perl -w use strict; ! use warnings; use FileHandle; *************** *** 12,45 **** sub main{ my $ss = SiteSampler->new; ! update_stats($ss); ! # update_queries($ss); ! # update_query_forms($ss); } ! sub update_stats{ my($ss) = @_; for my $agent ($ss->core->agents){ $agent->update_stats; } } - - sub update_queries{ - my($ss) = @_; - for my $report ($ss->core->reports){ - my $log = SiteSampler::Log->new($report->query,$report->latest_log_id); - if($log->has_entries){ - $report->parse_log($log); - $report->set_report_html; - $report->save; - } - } - } - - sub update_query_forms{ - my($ss) = @_; - # print "updating query_forms"; - for my $query_form ($ss->core->query_forms){ - # print Dumper($query_form),"\n\n"; - $query_form->refresh_html; - } - } --- 12,23 ---- sub main{ my $ss = SiteSampler->new; ! update_agent_stats($ss); } ! sub update_agent_stats{ my($ss) = @_; for my $agent ($ss->core->agents){ + $agent->process_forked(1); $agent->update_stats; } } |
|
From: Shane H. <sha...@us...> - 2005-07-18 01:36:49
|
Update of /cvsroot/sitesampler/sitesampler/SiteSampler/Report/Profiles In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv6252/SiteSampler/Report/Profiles Modified Files: Profile.pm Log Message: this is a big commit related to fixing the report object Index: Profile.pm =================================================================== RCS file: /cvsroot/sitesampler/sitesampler/SiteSampler/Report/Profiles/Profile.pm,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** Profile.pm 6 Jul 2005 12:24:33 -0000 1.2 --- Profile.pm 18 Jul 2005 01:36:38 -0000 1.3 *************** *** 1,4 **** package SiteSampler::Report::Profiles::Profile; - use Digest::MD5; use SiteSampler::Report::Base::Child; use base qw(SiteSampler::Report::Base::Child); --- 1,3 ---- |
