CMS/Simple.pm

   1 package CMS::Simple ;
   2
   3 use warnings ;
   4 use strict ;
   5
   6 use Carp ;
   7 use File::Path;
   8 use Data::Dumper ;
   9
  10 use CMS::Simple::Parse ;
  11 use Template::Simple ;
  12 use File::Slurp ;
  13
  14
  15 our $VERSION = '0.01' ;
  16
  17
  18 my %defaults = (
  19
  20 ###
  21 # use File::Path and other modules to make paths clean and portable
  22 ###
  23
  24         working_dir     => '.',
  25         content_paths   => ['content'],
  26         templates_dir   => 'templates',
  27         output_dir      => 'output',
  28
  29 # this is for timestamps
  30
  31         published_dir   => 'published',
  32
  33         template_args   => {},
  34 ) ;
  35
  36 my %parsers = (
  37
  38         cont    => \&CMS::Simple::Parse::parse_content,
  39         csv     => \&CMS::Simple::Parse::parse_csv,
  40         pl      => \&_parse_perl,
  41 #       yaml    => \&parse_yaml,
  42 ) ;
  43
  44 sub new {
  45
  46         my( $class, $args ) = @_ ;
  47
  48         my $self = bless { %defaults, %{$args} }, $class ;
  49
  50         $self->_invert_filter_tags() ;
  51
  52         $self->_make_dirs() ;
  53
  54 # rename/clean dirs??
  55
  56         $self->_load_content() ;
  57
  58 ####
  59 # add template path arg
  60
  61         $self->{tmpl_obj} = Template::Simple->new( %{$self->{template_args}} ) ;
  62
  63         return $self ;
  64 }
  65
  66 sub _find_content_file {
  67
  68         my( $self, $file ) = @_ ;
  69
  70         my @dirs = @{$self->{content_paths}} ;
  71
  72         foreach my $dir ( @dirs ) {
  73
  74                 my $file_path = "$dir/$file" ;
  75
  76                 return $file_path if -e $file_path ;
  77         }
  78
  79         croak "can't file content file '$file' in [@dirs]" ;
  80 }
  81
  82
  83 sub _load_content {
  84
  85         my( $self ) = @_ ;
  86
  87         my $contents = $self->{contents} ;
  88
  89 #print Dumper $contents ;
  90
  91         while( my( $name, $file ) = each %{$contents} ) {
  92
  93 ######
  94 # ADD BETTER DIRECTORY STUFF
  95 ######
  96
  97                 my $file_path = $self->_find_content_file( $file ) ;
  98
  99                 my $content_text = read_file( $file_path ) ;
 100
 101 #print "FILE $file_path\n$content_text" if $file_path =~ /location/;
 102
 103                 my ($suffix) = $file_path =~ /\.(\w+)$/ ;
 104
 105                 my $parser = $parsers{ $suffix } ;
 106
 107                 $parser or croak "unknown suffix '$suffix'" ;
 108
 109                 my $parsed = $parser->( $content_text ) ;
 110
 111                 $contents->{$name} = {
 112
 113                         file    =>      $file,
 114                         text    =>      $content_text,
 115                         parsed  =>      $parsed,
 116                 } ;
 117         }
 118 #print Dumper $contents ;
 119
 120 }
 121
 122 sub build_all_pages {
 123
 124         my( $self ) = @_ ;
 125
 126         foreach my $page_name ( keys %{$self->{pages}} ) {
 127
 128                 $self->build_page( $page_name ) ;
 129         }
 130 }
 131
 132
 133 sub build_page {
 134
 135         my( $self, $page_name ) = @_ ;
 136
 137 #print "BUILD $page_name\n" ;
 138
 139         my $page = $self->{pages}{$page_name} ;
 140
 141         return if $page->{skip} ;
 142
 143         $page->{name} = $page_name ;
 144
 145         $self->_get_page_content( $page ) ;
 146
 147 #print Dumper $page ;
 148
 149         $self->_filter_page_content( $page ) ;
 150
 151         if( my $filter = $page->{filter} ) {
 152                 $filter->( $page ) ;
 153         }
 154
 155         $self->_render_page( $page ) ;
 156 #print ${$page->{rendered}} ;
 157
 158         $self->_output_page( $page ) ;
 159 }
 160
 161 sub _get_page_content {
 162
 163         my( $self, $page ) = @_ ;
 164
 165 #######
 166 # FIX so a page contents can override values and not just whole maps
 167 # ADD contents maps to have multilevel keys
 168 #######
 169
 170         my $all_contents = $self->{contents} ;
 171
 172         my $page_contents = $page->{contents} || {} ;
 173
 174         $page->{contents_map} ||= { $page->{name} => '' } ;
 175
 176 # loop over the default (common) and page specific content maps
 177
 178         foreach my $contents_map (
 179                 $self->{default_contents_map},
 180                 $page->{contents_map} ) {
 181
 182 print "MAP ", Dumper $contents_map if $page->{dump_content} ;
 183
 184                 if ( ref $contents_map eq 'ARRAY' ) {
 185
 186                         for( my $i = 0 ; $i < @$contents_map ; $i += 2 ) {
 187
 188 # get the contents for this content name
 189                                 my( $name, $location ) =
 190                                         @{$contents_map}[$i, $i+1] ;
 191
 192                                 my $contents = $all_contents->{$name}{parsed} ;
 193
 194                                 $self->_add_page_contents(
 195                                         $page_contents,
 196                                         $location,
 197                                         $contents
 198                                 ) ;
 199
 200 #print "CONT ", Dumper $page_contents if $page->{dump_content} ;
 201
 202                         }
 203                 }
 204                 else {
 205                         while( my( $name, $location ) =
 206                                 each %{$contents_map} ) {
 207
 208         # get the contents for this content name
 209
 210                                 my $contents = $all_contents->{$name}{parsed} ;
 211
 212         #print "CONT ", Dumper $contents if $page->{dump_content} ;
 213
 214                                 $self->_add_page_contents(
 215                                         $page_contents,
 216                                         $location,
 217                                         $contents
 218                                 ) ;
 219                         }
 220                 }
 221         }
 222
 223         print "ALL CONT ", Dumper $page_contents if $page->{dump_content} ;
 224
 225         $page->{contents} = $page_contents ;
 226 }
 227
 228 sub _add_page_contents {
 229
 230         my( $self, $page_contents, $location, $contents ) = @_ ;
 231
 232 #########
 233 # this needs to handle multilevel content location
 234 #########
 235
 236 # if we have a location, just store the contents there
 237
 238         if ( $location ) {
 239
 240                 my @loc_keys = split /:/, $location ;
 241 #print "LOC @loc_keys\n" ;
 242
 243                 my $loc_ref = \$page_contents->{ shift @loc_keys } ;
 244
 245 #print "LOC $loc_ref\n" ;
 246
 247 # descend into the page contents based on the location keys
 248
 249                 $loc_ref = \${$loc_ref}->{$_} for @loc_keys ;
 250
 251                 ${$loc_ref} = deep_copy( $contents ) ;
 252
 253                 return ;
 254         }
 255
 256 # no location so store all the top level contents in the top level of
 257 # the page
 258
 259         @{$page_contents}{keys %{$contents}} = values %{$contents} ;
 260 }
 261
 262 sub _filter_page_content {
 263
 264         my( $self, $page ) = @_ ;
 265
 266 # NOTE content must be a hash at the top
 267
 268         $self->_filter_content_hash( $page->{contents} ) ;
 269
 270         print "DONE\n", Dumper $page->{contents} if $page->{dump_filtered} ;
 271 }
 272
 273 sub _filter_content_hash {
 274
 275         my( $self, $href, $path ) = @_ ;
 276
 277         while( my( $tag, $val ) = each %{$href} ) {
 278
 279                 my @new_val =
 280                         $self->_filter_content_tag( $tag, $val, $path ) ;
 281
 282                 next unless @new_val ;
 283                 $href->{$tag} = $new_val[0] ;
 284
 285 #print "NEW\n", Dumper \@new_val if $tag =~ /location/ ;
 286
 287         }
 288 }
 289
 290 sub _filter_content_array {
 291
 292         my( $self, $tag, $aref, $path ) = @_ ;
 293
 294 #print "ARRAY: ", Dumper \$tag, $aref ;
 295
 296         my @new_vals ;
 297
 298         foreach my $val ( @{$aref} ) {
 299
 300                 push @new_vals,
 301                         $self->_filter_content_tag( $tag, $val, $path ) ;
 302         }
 303
 304         @{$aref} = @new_vals ;
 305
 306 #print Dumper $aref ;
 307
 308 }
 309
 310 sub _filter_content_tag {
 311
 312         my( $self, $tag, $val, $path ) = @_ ;
 313
 314 #print "TAG1 $tag\n" ;
 315 #print "TAG $tag\n" if $tag =~ /location/ ;
 316
 317         my $ref_type = ref $val ;
 318
 319         if( my @new_val =
 320                 $self->_filter_content_value( $tag, $val, $path ) ) {
 321
 322                 $val = $new_val[0] ;
 323
 324 #print "VAL $tag\n" if $tag =~ /location/ ;
 325
 326 # handle case where the filter changed the type of the value
 327
 328                 $ref_type = ref $val ;
 329         }
 330
 331         if ( $ref_type eq 'HASH' ) {
 332
 333 #print "HASH $tag\n" if $tag =~ /location/ ;
 334
 335                 $self->_filter_content_hash( $val, $path ) ;
 336                 return $val ;
 337         }
 338
 339         if ( $ref_type eq 'ARRAY' ) {
 340
 341                 $self->_filter_content_array( $tag, $val, $path ) ;
 342                 return $val ;
 343         }
 344
 345         return $val ;
 346 }
 347
 348 sub _filter_content_value {
 349
 350         my( $self, $tag, $val, $path ) = @_ ;
 351
 352 #print "VAL TAG $tag\n" if $tag =~ /location/ ;
 353
 354         my $filters = $self->{tag_to_filters}{$tag} ;
 355
 356         return unless $filters ;
 357
 358         my @new_val ;
 359
 360         foreach my $filter ( @{$filters} ) {
 361
 362 #print "FILTER $filter->{name}\n" ;
 363
 364 #print "TAG $tag [$val]\n" unless defined $val;
 365
 366 $val = '' unless defined $val || $tag ne 'text' ;
 367
 368                 @new_val = $filter->{code}->( $tag, $val, $path ) ;
 369
 370                 next unless @new_val ;
 371
 372                 $val = $new_val[0] ;
 373         }
 374
 375 #print "TAG: $tag: ", Dumper \$val ;
 376
 377 # return if nothing was changed
 378
 379         return unless @new_val ;
 380
 381         return $val ;
 382 }
 383
 384 sub _render_page {
 385
 386         my( $self, $page ) = @_ ;
 387
 388         my $tmpl_obj = $self->{tmpl_obj} ;
 389
 390 # NOTE: using internal method. will fix template::simple to expose it
 391
 392         my $tmpl_name = $page->{template} || $self->{default_template} ;
 393
 394         my $template = $tmpl_obj->_get_template( $tmpl_name ) ;
 395
 396 #print Dumper $page->{contents} ;
 397
 398         my $rendered = $tmpl_obj->render( $template, $page->{contents} ) ;
 399
 400         $page->{rendered} = $rendered ;
 401 }
 402
 403
 404
 405 sub _output_page {
 406
 407         my( $self, $page ) = @_ ;
 408
 409 ##########
 410 # use file::path stuff to make this portable
 411 ##########
 412
 413         my $sub_dir = $page->{sub_dir} || '' ;
 414         $sub_dir .= '/' if $sub_dir ;
 415
 416         my $suffix = $page->{'output_suffix'} || $self->{'output_suffix'} ;
 417
 418         my $output_dir = "$self->{'output_dir'}/$sub_dir" ;
 419
 420         mkpath( $output_dir ) unless -d $output_dir ;
 421
 422         my $output_path = "$output_dir$page->{name}$suffix" ;
 423
 424         $page->{'output_path'} = $output_path ;
 425
 426         write_file( $output_path, $page->{rendered} ) ;
 427 }
 428
 429 sub publish_output {
 430
 431         my( $self ) = @_ ;
 432
 433         while ( my($name, $page) = each %{$self->{'pages'}} ) {
 434
 435                 my $output_file         = $self->{'pages'}{$name}{'output_file'} ;
 436
 437                 my $remote_host         = $self->{'remote_host'} ;
 438                 my $remote_user         = $self->{'remote_user'} ;
 439                 my $remote_directory    = $self->{'remote_directory'} ;
 440
 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!)
 444
 445                 $remote_directory =~ s/^(.*)\/$/$1/ ;
 446
 447                 my $scp = Net::SCP->new() ;
 448
 449                 die "Unable to construct remote destination" unless
 450                   ( $remote_host && $remote_user && $remote_directory ) ;
 451
 452                 # Construct remote destination from class attributes:
 453                 my $destination = "${remote_user}\@${remote_host}:${remote_directory}/" ;
 454
 455                 # Use 'iscp' for interactive scp:
 456                 $scp->iscp( $output_file, $destination ) or die $scp->{errstr};
 457
 458         }
 459 }
 460
 461 sub _parse_perl {
 462
 463         my( $text ) = @_ ;
 464
 465         return eval $text ;
 466 }
 467
 468
 469 # change
 470 sub deep_copy {
 471
 472         my( $val ) = @_ ;
 473
 474         return $val unless ref $val ;
 475
 476         return [ map deep_copy( $_ ), @{$val} ] if ref $val eq 'ARRAY' ;
 477
 478         return { map { $_, deep_copy( $val->{$_} ) } keys %{$val} }
 479                 if ref $val eq 'HASH' ;
 480
 481         die "$val is not a scalar, ARRAY or HASH" ;
 482 }
 483
 484
 485 sub _make_dirs {
 486
 487         my( $self ) = @_ ;
 488
 489 ############
 490 # use File::Path to make deep dirs
 491 ###########
 492
 493         mkdir( $self->{output_dir} ) ;
 494         mkdir( $self->{published_dir} ) ;
 495 }
 496
 497 sub _invert_filter_tags {
 498
 499         my( $self) = @_ ;
 500
 501         my %tag_to_filters ;
 502
 503         foreach my $filter ( @{$self->{filters}} ) {
 504
 505                 push @{$tag_to_filters{$_}}, $filter for @{$filter->{tags}} ;
 506         }
 507
 508 #print Dumper \%tag_to_filters ;
 509
 510         $self->{tag_to_filters} = \%tag_to_filters ;
 511 }
 512
 513 1 ;