CMS/Simple.pm

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