10 use CMS::Simple::Parse ;
11 use Template::Simple ;
15 our $VERSION = '0.01' ;
21 # use File::Path and other modules to make paths clean and portable
25 content_paths => ['content'],
26 templates_dir => 'templates',
27 output_dir => 'output',
29 # this is for timestamps
31 published_dir => 'published',
38 cont => \&CMS::Simple::Parse::parse_content,
39 csv => \&CMS::Simple::Parse::parse_csv,
41 # yaml => \&parse_yaml,
46 my( $class, $args ) = @_ ;
48 my $self = bless { %defaults, %{$args} }, $class ;
50 $self->_invert_filter_tags() ;
56 $self->_load_content() ;
59 # add template path arg
61 $self->{tmpl_obj} = Template::Simple->new( %{$self->{template_args}} ) ;
66 sub _find_content_file {
68 my( $self, $file ) = @_ ;
70 my @dirs = @{$self->{content_paths}} ;
72 foreach my $dir ( @dirs ) {
74 my $file_path = "$dir/$file" ;
76 return $file_path if -e $file_path ;
79 croak "can't file content file '$file' in [@dirs]" ;
87 my $contents = $self->{contents} ;
89 #print Dumper $contents ;
91 while( my( $name, $file ) = each %{$contents} ) {
94 # ADD BETTER DIRECTORY STUFF
97 my $file_path = $self->_find_content_file( $file ) ;
99 my $content_text = read_file( $file_path ) ;
101 #print "FILE $file_path\n$content_text" if $file_path =~ /location/;
103 my ($suffix) = $file_path =~ /\.(\w+)$/ ;
105 my $parser = $parsers{ $suffix } ;
107 $parser or croak "unknown suffix '$suffix'" ;
109 my $parsed = $parser->( $content_text ) ;
111 $contents->{$name} = {
114 text => $content_text,
118 #print Dumper $contents ;
122 sub build_all_pages {
126 foreach my $page_name ( keys %{$self->{pages}} ) {
128 $self->build_page( $page_name ) ;
135 my( $self, $page_name ) = @_ ;
137 #print "BUILD $page_name\n" ;
139 my $page = $self->{pages}{$page_name} ;
141 return if $page->{skip} ;
143 $page->{name} = $page_name ;
145 $self->_get_page_content( $page ) ;
147 #print Dumper $page ;
149 $self->_filter_page_content( $page ) ;
151 if( my $filter = $page->{filter} ) {
155 $self->_render_page( $page ) ;
156 #print ${$page->{rendered}} ;
158 $self->_output_page( $page ) ;
161 sub _get_page_content {
163 my( $self, $page ) = @_ ;
166 # FIX so a page contents can override values and not just whole maps
167 # ADD contents maps to have multilevel keys
170 my $all_contents = $self->{contents} ;
172 my $page_contents = $page->{contents} || {} ;
174 $page->{contents_map} ||= { $page->{name} => '' } ;
176 # loop over the default (common) and page specific content maps
178 foreach my $contents_map (
179 $self->{default_contents_map},
180 $page->{contents_map} ) {
182 print "MAP ", Dumper $contents_map if $page->{dump_content} ;
184 if ( ref $contents_map eq 'ARRAY' ) {
186 for( my $i = 0 ; $i < @$contents_map ; $i += 2 ) {
188 # get the contents for this content name
189 my( $name, $location ) =
190 @{$contents_map}[$i, $i+1] ;
192 my $contents = $all_contents->{$name}{parsed} ;
194 $self->_add_page_contents(
200 #print "CONT ", Dumper $page_contents if $page->{dump_content} ;
205 while( my( $name, $location ) =
206 each %{$contents_map} ) {
208 # get the contents for this content name
210 my $contents = $all_contents->{$name}{parsed} ;
212 #print "CONT ", Dumper $contents if $page->{dump_content} ;
214 $self->_add_page_contents(
223 print "ALL CONT ", Dumper $page_contents if $page->{dump_content} ;
225 $page->{contents} = $page_contents ;
228 sub _add_page_contents {
230 my( $self, $page_contents, $location, $contents ) = @_ ;
233 # this needs to handle multilevel content location
236 # if we have a location, just store the contents there
240 my @loc_keys = split /:/, $location ;
241 #print "LOC @loc_keys\n" ;
243 my $loc_ref = \$page_contents->{ shift @loc_keys } ;
245 #print "LOC $loc_ref\n" ;
247 # descend into the page contents based on the location keys
249 $loc_ref = \${$loc_ref}->{$_} for @loc_keys ;
251 ${$loc_ref} = deep_copy( $contents ) ;
256 # no location so store all the top level contents in the top level of
259 @{$page_contents}{keys %{$contents}} = values %{$contents} ;
262 sub _filter_page_content {
264 my( $self, $page ) = @_ ;
266 # NOTE content must be a hash at the top
268 $self->_filter_content_hash( $page->{contents} ) ;
270 print "DONE\n", Dumper $page->{contents} if $page->{dump_filtered} ;
273 sub _filter_content_hash {
275 my( $self, $href, $path ) = @_ ;
277 while( my( $tag, $val ) = each %{$href} ) {
280 $self->_filter_content_tag( $tag, $val, $path ) ;
282 next unless @new_val ;
283 $href->{$tag} = $new_val[0] ;
285 #print "NEW\n", Dumper \@new_val if $tag =~ /location/ ;
290 sub _filter_content_array {
292 my( $self, $tag, $aref, $path ) = @_ ;
294 #print "ARRAY: ", Dumper \$tag, $aref ;
298 foreach my $val ( @{$aref} ) {
301 $self->_filter_content_tag( $tag, $val, $path ) ;
304 @{$aref} = @new_vals ;
306 #print Dumper $aref ;
310 sub _filter_content_tag {
312 my( $self, $tag, $val, $path ) = @_ ;
314 #print "TAG1 $tag\n" ;
315 #print "TAG $tag\n" if $tag =~ /location/ ;
317 my $ref_type = ref $val ;
320 $self->_filter_content_value( $tag, $val, $path ) ) {
324 #print "VAL $tag\n" if $tag =~ /location/ ;
326 # handle case where the filter changed the type of the value
328 $ref_type = ref $val ;
331 if ( $ref_type eq 'HASH' ) {
333 #print "HASH $tag\n" if $tag =~ /location/ ;
335 $self->_filter_content_hash( $val, $path ) ;
339 if ( $ref_type eq 'ARRAY' ) {
341 $self->_filter_content_array( $tag, $val, $path ) ;
348 sub _filter_content_value {
350 my( $self, $tag, $val, $path ) = @_ ;
352 #print "VAL TAG $tag\n" if $tag =~ /location/ ;
354 my $filters = $self->{tag_to_filters}{$tag} ;
356 return unless $filters ;
360 foreach my $filter ( @{$filters} ) {
362 #print "FILTER $filter->{name}\n" ;
364 #print "TAG $tag [$val]\n" unless defined $val;
366 $val = '' unless defined $val || $tag ne 'text' ;
368 @new_val = $filter->{code}->( $tag, $val, $path ) ;
370 next unless @new_val ;
375 #print "TAG: $tag: ", Dumper \$val ;
377 # return if nothing was changed
379 return unless @new_val ;
386 my( $self, $page ) = @_ ;
388 my $tmpl_obj = $self->{tmpl_obj} ;
390 # NOTE: using internal method. will fix template::simple to expose it
392 my $tmpl_name = $page->{template} || $self->{default_template} ;
394 my $template = $tmpl_obj->_get_template( $tmpl_name ) ;
396 #print Dumper $page->{contents} ;
398 my $rendered = $tmpl_obj->render( $template, $page->{contents} ) ;
400 $page->{rendered} = $rendered ;
407 my( $self, $page ) = @_ ;
410 # use file::path stuff to make this portable
413 my $sub_dir = $page->{sub_dir} || '' ;
414 $sub_dir .= '/' if $sub_dir ;
416 my $suffix = $page->{'output_suffix'} || $self->{'output_suffix'} ;
418 my $output_dir = "$self->{'output_dir'}/$sub_dir" ;
420 mkpath( $output_dir ) unless -d $output_dir ;
422 my $output_path = "$output_dir$page->{name}$suffix" ;
424 $page->{'output_path'} = $output_path ;
426 write_file( $output_path, $page->{rendered} ) ;
433 while ( my($name, $page) = each %{$self->{'pages'}} ) {
435 my $output_file = $self->{'pages'}{$name}{'output_file'} ;
437 my $remote_host = $self->{'remote_host'} ;
438 my $remote_user = $self->{'remote_user'} ;
439 my $remote_directory = $self->{'remote_directory'} ;
441 # Strip trailing slash if there is one, then replace it...
442 # so that dir always ends in slash whether or not one is passed:
443 # (Note: not portable outside Linux/unix!)
445 $remote_directory =~ s/^(.*)\/$/$1/ ;
447 my $scp = Net::SCP->new() ;
449 die "Unable to construct remote destination" unless
450 ( $remote_host && $remote_user && $remote_directory ) ;
452 # Construct remote destination from class attributes:
453 my $destination = "${remote_user}\@${remote_host}:${remote_directory}/" ;
455 # Use 'iscp' for interactive scp:
456 $scp->iscp( $output_file, $destination ) or die $scp->{errstr};
474 return $val unless ref $val ;
476 return [ map deep_copy( $_ ), @{$val} ] if ref $val eq 'ARRAY' ;
478 return { map { $_, deep_copy( $val->{$_} ) } keys %{$val} }
479 if ref $val eq 'HASH' ;
481 die "$val is not a scalar, ARRAY or HASH" ;
490 # use File::Path to make deep dirs
493 mkdir( $self->{output_dir} ) ;
494 mkdir( $self->{published_dir} ) ;
497 sub _invert_filter_tags {
503 foreach my $filter ( @{$self->{filters}} ) {
505 push @{$tag_to_filters{$_}}, $filter for @{$filter->{tags}} ;
508 #print Dumper \%tag_to_filters ;
510 $self->{tag_to_filters} = \%tag_to_filters ;