initial commit

[urisagit/CMS-Simple.git] / CMS / Simple / Parse.pm

package CMS::Simple::Parse ;


use strict ;
use warnings ;

use Data::Dumper ;

sub parse_content {

	my( $text ) = @_ ;

#print $text ;

	my $lines = [ $text =~ m{(.*?$/)}sg ] ;

	return parse_lines( {}, $lines ) ;
}

sub parse_lines {

	my( $curr_hash, $lines ) = @_ ;

	my $content = '' ;
	my $scalar_tag ;

	while( my $line = shift @{$lines} ) {

# skip blank lines

#		next unless $line =~ /\S/ ;

# look for tag:: lines and parse them out.
# ignore leading white space, grad for a word followed by 1 or 2 :'s.
# also grab any optional content following the tag

		unless( $line =~ /^\s*(\w+)(::?)\s+(.*)\z/s ) {

# no tag found so just add this line to the current scalar content

			$content .= $line ;
			next ;
		}

		my $tag = $1 ;

# save any existing scalar as we found a new tag entry

		if ( $scalar_tag ) {
			_store_value( $curr_hash, $scalar_tag, $content ) ;
			$scalar_tag = '' ;
		}

# see we at the end of a structure. if so, return what we have parsed

		return $curr_hash if $tag eq 'END' ;

# see if this a start of a structure. if so, recursively parse and
# store it any content on the structure tag line is ignored. its value
# is always a hash ref of the structure data.

		if( $2 eq '::' ) {

			my $new_val = parse_lines( {}, $lines ) ;
			_store_value( $curr_hash, $tag, $new_val ) ;
			next ;
		}

# now it must be a new scalar entry. save any new content on this line

		$scalar_tag = $tag ;
		$content = $3 ;
	}

#print "TAG $scalar_tag\n" ;
	_store_value( $curr_hash, $scalar_tag, $content ) if $scalar_tag ;

#print Dumper $curr_hash ;

	return $curr_hash ;
}

sub _store_value {

	my( $curr_ref, $tag, $val ) = @_ ;

# NOTE: always chomping scalar content

	chomp $val unless ref $val ;

	my $curr_val = $curr_ref->{$tag} ;


	unless( defined $curr_val ) {

#print "NEW TAG $tag [$val]\n" ;

		$curr_ref->{$tag} = $val ;
		return ;
	}

	if ( ref $curr_val eq 'ARRAY' ) {

#print "PUSH TAG $tag [$val]\n" ;

		push( @{$curr_val}, $val ) ;

		return ;
	}

#print "ARRAY TAG $tag [$val]\n" ;
	$curr_ref->{$tag} = [ $curr_val, $val ] ;

}

# cheapo csv tab file parser

sub parse_csv {

	my( $text ) = @_ ;

	my @lines = split m{(?<=$/)}, $text ;

	chomp @lines ;

	return [ map [ split /\t/ ], @lines ] ;
}

1 ;