File Coverage

lib/Fry/Lib/CDBI/Tags.pm

Criterion	Covered	Total	%
statement	3	98	3.0
branch	0	8	0.0
condition			n/a
subroutine	1	15	6.6
pod	0	11	0.0
total	4	132	3.0

#!/usr/bin/perl
package Fry::Lib::CDBI::Tags;
use strict qw/vars refs/; #?forget the subs cause makes hash assignment a pain

#variables
our $tagcolumn='tags';
#our cdbi_search = "search_abstract";
#functions
	sub _default_data {
		return {
			depend=>[qw/:CDBI::Basic/],
			vars=>{ otlnum=>'3',tag_delimiter=>',' },
			cmds=>{tagcount=>{qw/a tc aa aliasInputAndSql/},
				tagname=>{qw/a tn aa aliasInputAndSql/},
				auto_outline=>{qw/a ao/},#aa aliasInputAndSql/},
				sorted_tag_list=>{qw/a ts aa aliasInputAndSql/},
				tagcount_obj=>{qw/a :tc/},
				tagname_obj=>{qw/a :tn/},
			},
			opts=>{otlnum=>{qw/a otl type var noreset 1 default 3/ }}
			#	subs=>{qw/g init_tag_group/ }
		}
	}

	#shell commands
	sub auto_outline {
		my $class = shift;

		$class->lib->requireLibraries(':CDBI::Outline');
		my @a = $class->aliasInputAndSql(@_);
		my @results = $class->${\$class->Var('cdbi_search')}(@a);
		$class->obj_to_otl(\@_,\@results);
	}
	sub tagcount {
		my $cls =  shift;

		my @results = $cls->${\$cls->Var('cdbi_search')}(@_);
		if (@results > 0) {
			$cls->tagcount_obj(@results)
		}
		else { $cls->view("No search results\n") }
	}
	sub tagname {
		my $cls = shift;
		my @results = $cls->${\$cls->Var('cdbi_search')}(@_);
		if (@results > 0) {
			$cls->tagname_obj(@results)
		}
		else { $cls->view("No search results\n") }
	}
	sub tagcount_obj {
		my ($cls,@obj) = @_;
		my $tags = $cls->get_tags_compact(@obj);
		$cls->print_tags_compact($tags);
	}
	sub tagname_obj {
		my ($cls,@obj) = @_;
		my @sortedtags = $cls->listtags(@obj);
		$cls->print_tags(@sortedtags);
	}
	sub sorted_tag_list {
		my $class = shift;
		my @results = $class->${\$class->Var('cdbi_search')}(@_);
		return sort $class->_unique_result_tags(@results);
	}
	#internal methods
	sub obj_to_otl {
		my $class = shift;
		my @aliasedinput= @{shift()};
		my @results = @{shift()};

		#gives unique tags but in order of most tags
		my @tagnames = map { $_->{name} } $class->listtags(@results);
		if (@tagnames == 0) { $class->view("no taggnames,outline not possible\n"); return}

		#delete first tagname since it's a repeat of parent tag
		shift @tagnames if ("@aliasedinput" =~ /$tagcolumn/);

		#create autoquery
		my @savedtags = splice(@tagnames,0,$class->Var('otlnum'));
		my $input = "@aliasedinput"."(".join(',',@savedtags).")";
		#print "i: $input:\n";

		$class->view($class->outlineSearches($input));
	}
	sub _all_result_tags {
		my ($class,@cdbi) = @_;
		my @tcolumn = map {$_->$tagcolumn} @cdbi;
		return map {split(/${\$class->Var('tag_delimiter')}/,$_) } @tcolumn;
	}
	sub _unique_result_tags {
		my ($class,@cdbi) = @_;
		my @tags = $class->_all_result_tags(@cdbi);
		my %uniq;
		for (@tags) { $uniq{$_}++ }
		return keys %uniq;
	}
	sub listtags {
		#d:returns tags and number of occurences in table
		my ($class,@cdbi) =  @_;
		my @tags = $class->_all_result_tags(@cdbi);
		my (%uniqtag,$result);

		#count + get unique tags
		for (@tags) { $uniqtag{$_}{count}++; }

		#combine count + tagname into @ of %
		@tags=();
		for (keys %uniqtag) {
			push(@tags,{name=>$_,count=>$uniqtag{$_}{count}});
		}

		#sort descending
		my @sortedtags = sort {${$b}{count} <=> ${$a}{count}} @tags;
		return @sortedtags;
	}
	sub get_tags_compact {
		my $class = shift;
		my @sortedtags = $class->listtags(@_);
		my ($i,$j,@body);

		while ($i != @sortedtags -1){
			my $previouscount;

			#print $sortedtags[$i]{count},": ";
			$body[$j]{count} = $sortedtags[$i]{count};
			#print $sortedtags[$i]{name},$class->Var('delim')->{tag};
			$body[$j]{tags} .= $sortedtags[$i]{name}.  $class->Var('tag_delimiter');

			$previouscount = $sortedtags[$i]{count};
			$i++;

			#create taggroup
			my @taggroup;
			#prints groups of tags with same count
			while ($sortedtags[$i]{count} == $previouscount) {
				#print $sortedtags[$i]{name},$class->Var('delim')->{tag};
				push(@taggroup,$sortedtags[$i]{name});
				$previouscount = $sortedtags[$i]{count};
				$i++;
			}

			$body[$j]{tags} .= join($class->Var('tag_delimiter'),@taggroup);
			$j++;
		}
		return \@body;
	}
	#format fns
	sub print_tags_compact {
		my ($cls,$tags) = @_;
		my $output;

		for (@$tags) {
			$output .= $_->{count}.": ".$_->{tags}."\n";
		}
		$cls->view($output);
	}
	sub print_tags {
		my ($class,@sortedtags) = @_;
		my $result;
		for (@sortedtags) { $result .= "$_->{count}: $_->{name}\n";}
		$class->view($result);
	}


__END__