File Coverage

bin/clearpress

Criterion	Covered	Total	%
statement	48	159	30.1
branch	11	56	19.6
condition	3	22	13.6
subroutine	11	15	73.3
pod			n/a
total	73	252	28.9

#!/usr/bin/perl -T
# -*- mode: cperl; tab-width: 8; indent-tabs-mode: nil; basic-offset: 2 -*-
# vim:ts=8:sw=2:et:sta:sts=2
#########
# Author: rmp
# Created: 2007-06-21
#
use strict;
use warnings;
use Getopt::Long;
use English qw(-no_match_vars);
use Carp;
use Template;
use Lingua::EN::Inflect qw(PL);
use lib qw(blib/lib lib);
use ClearPress;

our $VERSION = q[477.1.2];
our $ASPECTS = [qw(read list add create edit update)];

local $ENV{PATH} = join q(:), qw(/bin /usr/bin /usr/local/bin /opt/local/bin);

main();
0;


sub main { ## no critic (complexity)
  my $opts      = {};
  my @argvcopy = @ARGV;

  GetOptions($opts,
	     'new=s',
	     'driver=s',
	     'yes',
	     'help',
	     'version',
	    );

  if($opts->{help}) {
    print <<"EOT" or croak qq[Error printing: $ERRNO];
Usage Example:
  $PROGRAM_NAME --new GrandKids 'child->family child(name,birthday:date) family(name,address,city,state,zip)'
EOT
    return 1;
  }

  if($opts->{version}) {
    print q(ClearPress v).ClearPress->VERSION.qq(\n) or croak qq[Error printing: $ERRNO];
    return 1;
  }

  ($opts->{driver}) = ($opts->{driver} || 'mysql') =~ /(SQLite|mysql)/smx;

  if(!$opts->{new}) {
    croak q(Please specify --new );
  }

  my ($app) = $opts->{new} =~ /^([[:lower:]][[:lower:][:digit:]_]+)$/smxi;
  $app    ||= q();

  if($app ne $opts->{new}) {
    croak q(Invalid characters in application name, only /[a-z][a-z\\d_]+/i allowed.);
  }

  my $all_structure = shift @ARGV;

  my $schema     = {};
  my $driver_pkg = "ClearPress::driver::$opts->{driver}";

  eval "require $driver_pkg"; ## no critic (ProhibitStringyEval RequireCheckingReturnValueOfEval)
  my $driver = $driver_pkg->new();

  for my $structure (split /\s+/smx, $all_structure) {
    if($structure =~ /\S+[(]\S+[)]/smx) {
      #########
      # table definition
      #
      my ($table, $columns) = $structure =~ /(\S+)[(](\S+)[)]/smx;

      for my $column (split /,/smx, $columns) {
	my ($name, $type) = split /:/smx, $column;
	$name           ||= $column;
	$type             = $driver->type_map($type||'char(128)');
	$schema->{$table}->{fields}->{$name} = $type;

	print {*STDERR} qq($table has $name of type $type\n) or croak qq[Error printing: $ERRNO];
      }

    } elsif($structure =~ /\S+\->\S+/smx) {
      #########
      # relationship
      #
      my ($one, $many) = $structure =~ /(\S+)\->(\S+)/smx;
      push @{$schema->{$one}->{has_a}},     $many;
      push @{$schema->{$many}->{has_many}}, $one;
      print {*STDERR} qq($one has a $many\n$many has many @{[PL($one)]}\n) or croak qq[Error printing: $ERRNO];
    }
  }

  my $template_cache = {};
  read_templates($template_cache);

  create_application({
		      'template_cache' => $template_cache,
		      'application'    => $app,
		      'views'          => [keys %{$schema}],
		      'yes'            => exists $opts->{yes},
		      'driver'         => $opts->{driver},
		      'schema'         => $schema,
		     });

  my $precedence = [map  { $_->{name} }
		    sort _sorter
		    values %{$schema}];

  my $cfg = qq($app/config.layout);
  open my $fh, q(>), $cfg or croak qq[Error opening $cfg: $ERRNO];
  print {$fh} $PROGRAM_NAME, (map { qq( '$_') } @argvcopy), qq(\n) or croak qq[Error printing: $ERRNO];
  close $fh or croak qq[Error closing $cfg: $ERRNO];

  if($opts->{driver} eq 'mysql') {
    #########
    # mysql message
    #
    print <<"EOT" or croak qq[Error printing: $ERRNO];
You now need to configure your database.
1. Check and/or modify $app/data/config.ini
2. If necessary create a database, something like this:
  mysqladmin -uroot create $app
3. cat @{[map { "$app/data/schema/$_.mysql \\\n      " } @{$precedence}]} | mysql -uroot $app

Note you may need to create your new schema in order, depending on your foreign key constraints.
EOT

  } else {
    #########
    # SQLite message
    #
    print <<"EOT" or croak qq[Error printing: $ERRNO];
You now need to configure your database.
1. Check and/or modify $app/data/config.ini
2. If necessary create a database, something like this:
  cat $app/data/schema/*.SQLite | sqlite3 $app/$app
EOT
  }

  return 1;
}

sub read_templates {
  my $cache = shift;
  local $RS = "\n-- \n";

  if(!scalar keys %{$cache}) {
    for my $field (qw(config schema_mysql schema_SQLite application_sa application_cgi util model view view_error),
		   (map { "aspect_$_" } @{$ASPECTS}),
		   qw(actions warnings stylesheet)) {
      my $str          = ;
      $str             =~ s/$RS//smx;
      $cache->{$field} = \$str;
      print qq(Read @{[length($str)]} bytes for $field\n) or croak qq[Error printing: $ERRNO];
    }
  }
  return 1;
}

sub create_application {
  my $opts   = shift;
  my $app    = $opts->{application};
  my $cache  = $opts->{template_cache};
  my $driver = $opts->{driver};
  my $schema = $opts->{schema};
  my $tt     = Template->new({
			     EVAL_PERL => 1,
			     TAG_STYLE => 'asp',
			    });

  for my $view (@{$opts->{views}}) {
    $schema->{$view}->{name} = $view;
    $opts->{name}     = $view;
    $opts->{fields}   = [map { {name => $_,
				type => $schema->{$view}->{fields}->{$_}};
                               } sort keys %{$schema->{$view}->{fields} }];
    $opts->{has_many} = $schema->{$view}->{has_many} || [];
    $opts->{has_a}    = $schema->{$view}->{has_a}    || [];

    process_template($opts, $tt, $cache->{"schema_$driver"}, "$app/data/schema",    "$view.$driver");

    process_template($opts, $tt, $cache->{model},  "$app/lib/$app/model", "$view.pm");
    process_template($opts, $tt, $cache->{view},   "$app/lib/$app/view",  "$view.pm");

    for my $aspect (@{$ASPECTS}) {
      process_template($opts, $tt, $cache->{"aspect_$aspect"}, "$app/data/templates", "${view}_$aspect.tt2");
    }
  }

  process_template($opts, $tt, $cache->{util},            "$app/lib/$app",  'util.pm');

  process_template($opts, $tt, $cache->{view_error},      "$app/lib/$app/view",  'error.pm');

  process_template($opts, $tt, $cache->{config},          "$app/data",           'config.ini');
  process_template($opts, $tt, $cache->{application_cgi}, "$app/cgi-bin",        $app);
  process_template($opts, $tt, $cache->{application_sa},  "$app/bin",            $app);
  process_template($opts, $tt, $cache->{stylesheet},      "$app/htdocs",         "$app.css");
  process_template($opts, $tt, $cache->{actions},         "$app/data/templates", 'actions.tt2');
  process_template($opts, $tt, $cache->{warnings},        "$app/data/templates", 'warnings.tt2');

  return 1;
}

sub _yn {
  my ($default) = @_;
  local $RS     = "\n";
  my $response  = <>;
  chomp $response;
  $response   ||= $default;
  return (uc $response eq uc $default)
}

sub process_template {
  my ($opts, $tt, $tmpl, $path, $fn) = @_;

  $fn = "$path/$fn";

  if(!$opts->{yes} && -e $fn) {
    print "$fn exists. Overwrite? [y/N] " or croak qq[Error printing: $ERRNO];
    _yn('N') and return 1;
  }

  system qw(mkdir -p), $path;
  open my $fh, q[>], $fn or croak "Opening $fn: $ERRNO";
  $tt->process($tmpl, $opts, $fh) or croak "Template error building $fn: ".$tt->error(). "\nTemplate was:\n".${$tmpl}."\n";
  close $fh or croak "Closing $fn: $ERRNO";
  return 1;
}

sub _sorter {
  my $a_deps = [@{$a->{has_a}||[]}];#, @{$a->{has_many}||[]}];
  my $b_deps = [@{$b->{has_a}||[]}];#, @{$b->{has_many}||[]}];

  if(scalar grep { $_ eq $b->{name} } @{$a_deps}) {
    return 1;
  }

  if(scalar grep { $_ eq $a->{name} } @{$b_deps}) {
    return -1; ## no critic (ProhibitMagicNumbers)
  }

  return (scalar @{$a_deps} <=> scalar @{$b_deps} || $a->{name} cmp $b->{name});
}

__END__