File Coverage

lib/Fry/Lib/CDBI/Outline.pm

Criterion	Covered	Total	%
statement	6	113	5.3
branch	0	22	0.0
condition	0	2	0.0
subroutine	2	16	12.5
pod	0	11	0.0
total	8	164	4.8

#!/usr/bin/perl
#declarations
package Fry::Lib::CDBI::Outline;
use strict;
#because of use of local
no strict 'vars';
our $VERSION = '0.14';
#our cdbi_search = "search_abstract";

#our ($left,$right,$even,$otlcol,$indent_char) = ('\)','\(',',','tags',"\t");
#our $tree_result;
#our $ind;

#functions
	sub _default_data {
		return {
			#causes action_columns to be uninit when using Load
			depend=>[qw/:CDBI::Basic/],
			cmds=>{outlineSearches=>{a=>'O',d=>'presents several database queries in an outline format',
				u=>'($search_term$level_delimiter)+'}},
			vars=>{right_indent=>'\(',no_indent=>',',left_indent=>'\)',otlcol=>'tags',indent_char=>"\t"},
			#tr make_tree_simple trr make_tree_results/},
			#flags=>{qw/L last_tag tt triple_table/},
		}
	}
	#print
	sub print_indented_rows {
		my $class =shift;
		my @rows = @{shift()};
		my @columns = @{shift()};
		my $indent = shift;
		my $data;
		my $ind = $indent_char x ($indent + 1);

		return "" if (@rows  == 0);

		for my $row (@rows) {
			for my $c (@columns) {
				$data .= ($row->$c || "");
				$data .= $class->Var('field_delimiter');
			}
			$data .= "\n";
		}

		$data =~ s/^/$ind/mg;
		return $data;
	}
	#internals
	sub search_outline {
		my $class = shift;

		my @search = $class->aliasInputAndSql(@_);
		my @results = $class->${\$class->Var('cdbi_search')}(@search);
		return @results;

		#if ($class->Flag('triple_table') && $class->can('_triple_table')) {
			#@results =  map { $_->${\$class->_triple_table->{rc23}} }
			#map { $_->${\$class->_triple_table->{many_method}} } @results;
			#use Data::Dumper;
			#print Dumper \@results;
		#}
	}
	sub input_to_nodes {
		my $class = shift;
		my $entry ="@_";

		$entry =~ s/[$left$right$even]$//;
		$entry =~ s/([$left$right$even])/\n$1/g;
		$entry =~ s/^/$even/;

		return split(/\n/,$entry);
	}
	sub get_indents {
		#d:create indents associated with @entry
		#increment,decrement or do nothing too match level of $ith item
		my $class = shift;
		my @entry = @_;
		my @indent;
		$indent[0]=0;

		for (my $i=1;$i <@entry;$i++) {
			for (substr($entry[$i],0,1)) {
				/^$left$/ && do {$indent[$i]=$indent[$i-1]-1;last };
				/^$right$/ && do {$indent[$i]=$indent[$i-1]+1;last};
				/^$even$/ && do {$indent[$i] = $indent[$i-1];last };
			}
		}
		return @indent;
	}
	sub get_values {
		my $class = shift;
		my @values = @_;

		for (@values) {$_ = substr($_,1);}	#chop first letters off of array
		return @values;
	}
	sub alias_otl {
		#d:pass search terms to list fn,have special %% term
		my $class = shift;
		my @terms = @_;
		my (@sameterms,@normterms,$sameterm,@rows,@input);
		my $splitter = $class->Var('splitter');

		#parse terms
		for (@terms) {
			#(/=/) ? push(@normterms,$_) : push(@sameterms,$_)  ;
			#above line turned into below if/else

			#default tag column assumed when no splitter present
			if ($_ !~ /$splitter/) {
				push(@input,$otlcol.$splitter.$_);
			}
			else { push(@input,$_);	}
		}

		return @input;
	}
	sub set_results {
		#d:inserts results at proper outline levels into @tags
		my $class = shift;
		my @otl_obj = @{shift()};
		my @stack;	#stack stack for a given level
		my $max = scalar(@otl_obj);
		#turn off warnings about uninitialized comparisons
		local $SIG{__WARN__} = sub { return $_[0] unless $_[0] =~ m/Use of uninitialized value/; };

		for (my $i=0;$i <$max;$i++) {		#creates an array of base otl_obj for next search term
			#doesn't have child
			if ($otl_obj[$i]{indent} >= $otl_obj[$i+1]{indent}) {
				$otl_obj[$i]{result} = [$class->search_outline($class->alias_otl($otl_obj[$i]{value},@stack))];
			}

			#if next obj is a child (a greater indent) then add to stack
			if ($otl_obj[$i]{indent} < $otl_obj[$i+1]{indent}) {push(@stack,$otl_obj[$i]{value});}
			#if not child then pop
			elsif ($otl_obj[$i]{indent} > $otl_obj[$i+1]{indent}) {pop(@stack);}
		}
		pop(@otl_obj); 	#created accidently by autovivification
		return @otl_obj;
	}
	sub makeNodeOutline {
		#d:display @otl_obj in outline format
		my $class = shift;
		my @otl_obj = @_;
		my @tag;	#tag stack for a given level
		my ($body);
		#h: scalar works here but not in for loop
		my $max = scalar(@otl_obj);
		#turn off warnings about uninitialized comparisons
		local $SIG{__WARN__} = sub { return $_[0] unless $_[0] =~ m/Use of uninitialized value/; };

		for (my $i=0;$i <$max;$i++) {		#creates an array of base otl_obj for next search term
			$ind = $indent_char x $otl_obj[$i]{indent};
			$body .= $ind . "$otl_obj[$i]{value}\n";

			#h: need var for other tables' print columns
			#$class->action_columns([qw/id cmd tags options notes/]) if ($class->can('_triple_table')) ;
			#my @c3_columns = (qw/id name parent_id notes/) ;
			my @columns = @{$class->Var('action_columns')};

				#if ($class->Flag('triple_table')) {
					#($class->can('_triple_table'))
						#? @columns = $class->_triple_table->{c3}->columns
						#: warn "_triple_table isn't defined";
				#}
				#my @c3_columns = $class->_triple_table->{c3}->columns;
				#my @columns = ($class->_flag->{triple_table}) ? @c3_columns : @{$class->action_columns};

			#doesn't have child	+ has results
			if ($otl_obj[$i]{indent} >= $otl_obj[$i+1]{indent}) {
				$body  .= $class->print_indented_rows ($otl_obj[$i]{result},
				\@columns,$otl_obj[$i]{indent});
			}
		}
		return $body;
	}
	sub get_outline {
		#d:parses input + returns data to make outline
		my $class = shift;
		my (@otl_obj);
		#@otl_obj are @ of % with indent,value and result keys

		my @bits = $class->input_to_nodes(@_);
		my @indent = $class->get_indents(@bits);
		my @value = $class->get_values(@bits);

		#creating @ of % for otl_obj
		for (my $i=0;$i<@indent;$i++) {
			$otl_obj[$i]{value} = $value[$i];
			$otl_obj[$i]{indent} = $indent[$i];
		}

		$class->set_results(\@otl_obj);
		return \@otl_obj;
	}
	#main function calling all the above
	sub create_outline {
		my $class =  shift;

		my @otl_obj = @{$class->get_outline(@_)};
		my $body = $class->makeNodeOutline(@otl_obj);

		return $body;
	}

#shell function
	sub outlineSearches {
		my $cls = shift;
		#td: change to global variables
		local ($right,$even,$left,$otlcol,$indent_char) =
			$cls->varMany(qw/right_indent no_indent left_indent otlcol indent_char/);
		local $tree_result;
		local $ind;
		$cls->view($cls->create_outline(@_));
	}
1;

__END__