Cmd.pm (4051B)
1 package Bluto::Cmd; 2 3 use Getopt::Long qw/ :config auto_help /; 4 use Cwd qw/ getcwd abs_path /; 5 use File::Spec; 6 use File::Path qw/make_path/; 7 use File::Copy; 8 use Digest::SHA; 9 10 use Bluto::SemVer; 11 use Bluto; 12 use YAML::Tiny; 13 14 use Bluto::Log qw/debug info error/; 15 16 17 my $force_version = undef; 18 my $force_help = 0; 19 my %env = ( 20 src_dir => File::Spec->catfile(getcwd, '.bluto'), 21 version => undef, 22 loglevel => undef, 23 engine => undef, 24 ); 25 my @opts_x; 26 27 sub help { 28 print("$0\n\nwould have shown help...\n"); 29 exit 0; 30 } 31 32 sub croak_ { 33 $v = shift; 34 die $v; 35 } 36 37 sub register_param { 38 my $env_k = shift; 39 my $env_v_default = shift; 40 my $switch_long = shift, 41 my $switch_short = shift, 42 my $switch_typ = shift; 43 $env{$env_k} = $v; 44 45 if (!defined $switch_typ) { 46 $switch_typ = "s"; 47 } 48 if (defined $switch_long) { 49 push(@opts_x, $switch_long . ':' . $switch_typ); 50 push(@opts_x, \$env{$env_k}); 51 } 52 if (defined $switch_short) { 53 push(@opts_x, $switch_short . ':' . $switch_typ); 54 push(@opts_x, \$env{$env_k}); 55 } 56 debug("added env k $env_k switches $switch_long / $switch_short"); 57 } 58 59 sub process_param { 60 GetOptions( 61 'd:s', \$env{src_dir}, 62 'v+', \$env{loglevel}, 63 'h+', \$force_help, 64 'help+', \$force_help, 65 @opts_x, 66 ); 67 68 if ($force_help > 0) { 69 help; 70 } 71 72 if (defined $env{src_dir}) { 73 make_path($env{src_dir}); 74 } 75 76 if (defined $env{version}) { 77 $env{version} = SemVer->new($env{version}); 78 } 79 80 $env{engine} = 'bluto v' . SemVer->new(Bluto::version()). " (perl $^V)"; 81 foreach my $k (keys %env ) { 82 if (defined $env{$k}) { 83 debug('environment "' . $k . '": ' . $env{$k}); 84 } 85 } 86 87 foreach my $k (keys %env) { 88 my $v = $env{$k}; 89 if (defined $v) { 90 debug("env k $k v $v"); 91 } else { 92 debug("env k $k not defined"); 93 } 94 } 95 } 96 97 sub get_param { 98 my $k = shift; 99 return $env{$k}; 100 } 101 102 sub get_version { 103 if (defined $env{version}) { 104 $env{version} = SemVer->new($env{version}); 105 } 106 return $env{version}; 107 } 108 109 sub base_config_path { 110 return File::Spec->catfile($env{src_dir}, 'bluto.yml'); 111 } 112 113 sub release_config_path { 114 if (!defined $env{version}) { 115 die("release config path does not exist, version not set"); 116 } 117 return File::Spec->catfile($env{src_dir}, $env{version} . '.yml'); 118 } 119 120 sub base_config { 121 my $fn = base_config_path(); 122 my $yi = YAML::Tiny->read($fn); 123 return $yi->[0]; 124 } 125 126 sub release_config { 127 my $fn = release_config_path(); 128 my $yi = YAML::Tiny->read($fn); 129 return $yi->[0]; 130 } 131 132 sub params { 133 if (_check_sanity()) { 134 return undef; 135 } 136 return \%env; 137 } 138 139 sub process_changelog { 140 my $copy = shift; 141 142 if (!defined $env{changelog_file}) { 143 die("changelog file missing"); 144 } 145 146 my $h = Digest::SHA->new('sha256'); 147 $h->addfile($env{changelog_file}); 148 my $z = $h->hexdigest; 149 debug('calculated sha256 ' . $z . ' for changelog ' . $env{changelog_file}); 150 if ($copy) { 151 my $fp = File::Spec->catfile($env{src_dir}, 'CHANGELOG.' . $env{version}); 152 copy($env{changelog_file}, $fp); 153 } 154 return $z; 155 } 156 157 sub _check_yml { 158 my $env = shift; 159 160 #my $fp = File::Spec->catfile($env->{src_dir}, 'bluto.ini'); 161 my $fp = File::Spec->catfile($env{src_dir}, 'bluto.yml'); 162 if ( ! -f $fp ) { 163 error('yml file not found: ' . $fp); 164 return 1; 165 } 166 debug('using yml file: ' . $fp); 167 return 0; 168 } 169 170 sub _check_readme { 171 my $env = shift; 172 my $f; 173 my $fp; 174 175 for my $fn (('README', 'README.txt', 'README.adoc', 'README.rst', 'README.md')) { 176 $fp = File::Spec->catfile($env{content_dir}, $fn); 177 if ( -f $fp ) { 178 debug('using readme file: ' . $fp); 179 $env{readme} = $fp; 180 return 0; 181 } 182 } 183 184 warn('no readme file found'); 185 return 1; 186 } 187 188 sub _check_version { 189 my $env = shift; 190 my $f; 191 my $fp; 192 193 $fp = File::Spec->catfile($env{src_dir}, 'VERSION'); 194 if ($env{version}) { 195 info('writing new explicit version ' . $env{version} . ' to file: ' . $fp); 196 open($f, '>', $fp); 197 print $f $env{version}; 198 close($f); 199 } 200 if (! -f $fp ) { 201 error('no version file'); 202 return 1; 203 } 204 debug('using version file: ' . $fp); 205 return 0; 206 } 207 208 209 sub _check_sanity { 210 my $r = 0; 211 212 $r += _check_readme($env); 213 $r += _check_yml($env); 214 $r += _check_version($env); 215 216 return $r; 217 } 218 219 220 1;