Bluto.pm (12887B)
1 package Bluto; 2 3 use DateTime; 4 use File::Basename qw/ basename /; 5 use File::Path qw / make_path /; 6 7 use Bluto::Log qw/error info debug warn trace/; 8 use Bluto::Archive; 9 use Bluto::Announce; 10 use Bluto::Tree; 11 use Bluto::SemVer; 12 use Bluto::RSS; 13 14 use constant { VCS_TAG_PREFIX => 'v' }; 15 #use constant { VERSION => '0.0.1' }; 16 our $VERSION = '0.0.1' ; 17 18 our %config; 19 our $have_version_match = undef; 20 our @m_tech; 21 our @m_url; 22 our @m_vcs; 23 our @m_src; 24 our @m_contributors; 25 #our @m_author_maintainer = [undef, undef, undef]; 26 #our @m_author_origin = [undef, undef, undef]; 27 our %m_main = ( 28 name => undef, 29 slug => undef, 30 version => undef, 31 summary => undef, 32 license => undef, 33 copyright => undef, 34 tag_prefix => VCS_TAG_PREFIX, 35 changelog => undef, 36 time => undef, 37 #tech_main => undef, 38 tech => undef, 39 vcs => \@m_vcs, 40 src => \@m_src, 41 uri => undef, 42 url => \@m_url, 43 _author_maintainer => undef, 44 author_maintainer => undef, 45 author_origin => undef, 46 contributors => \@m_contributors, 47 engine => undef, 48 ); 49 50 sub version { 51 return $VERSION; 52 } 53 54 sub _set_single { 55 my $cfg = shift; 56 my $cfg_k = shift; 57 my $main_k = shift; 58 my $need = shift; 59 60 my $v = $cfg->{$cfg_k}; 61 if (ref($v) eq 'ARRAY') { 62 if ($#v < 0) { 63 debug('empty value not set: ' . $cfg_k); 64 $v = undef; 65 } 66 } 67 68 if ($need && !defined $v) { 69 error('required config key not set: ' . $cfg_k); 70 return 1; 71 } 72 73 $m_main{$main_k} = $v; 74 75 return 0; 76 } 77 78 79 sub _set_author { 80 my $cfg = shift; 81 my $k = shift; 82 my $need = shift; 83 84 return _set_triple('author', $cfg, $k, $need); 85 } 86 87 sub _set_contributor { 88 my $cfg = shift; 89 my $v = shift; 90 my $k = shift; 91 my $need = shift; 92 93 return _set_triple('contributor', $cfg, $k, $need); 94 } 95 96 sub _set_triple { 97 my $pfx = shift; 98 my $cfg = shift; 99 my $k = shift; 100 my $need = shift; 101 my $name; 102 my $email; 103 my $pgp; 104 105 #$m_main{'_' . $pfx . '_' . $k} = []; 106 #my $cfg_k = $pfx . ':' . $k; 107 my $v = $cfg->{$k}->{name}; 108 # TODO if if if... 109 if (defined $v) { 110 $name = $cfg->{$k}->{name}; 111 if (ref($name) eq 'ARRAY') { 112 $v = undef; 113 } else { 114 $email = $cfg->{$k}->{email}; 115 if (ref($email) eq 'ARRAY') { 116 $email = undef; 117 } 118 $pgp = $cfg->{$k}->{pgp}; 119 if (ref($pgp) eq 'ARRAY') { 120 $pgp = undef; 121 } 122 } 123 } 124 125 if ($need && !defined $v) { 126 error('required ' . $pfx . ' data not set: ' . $cfg_k); 127 return 1; 128 } 129 130 $m_main{'_' . $pfx . '_' . $k}[0] = $name; 131 if (defined $email) { 132 $m_main{'_' . $pfx . '_' . $k}[1] = $name . ' <' . $email . '>'; 133 } 134 $m_main{'_' . $pfx . '_' . $k}[2] = $pgp; 135 $m_main{$pfx . '_' . $k} = $name; 136 return 0; 137 } 138 139 #sub _check_ini { 140 sub _check_yml { 141 my $env = shift; 142 143 #my $fp = File::Spec->catfile($env->{src_dir}, 'bluto.ini'); 144 my $fp = File::Spec->catfile($env->{src_dir}, 'bluto.yml'); 145 if ( ! -f $fp ) { 146 error('yml file not found: ' . $fp); 147 return 1; 148 } 149 debug('using yml file: ' . $fp); 150 return 0; 151 } 152 153 sub _check_readme { 154 my $env = shift; 155 my $f; 156 my $fp; 157 158 for my $fn (('README', 'README.txt', 'README.adoc', 'README.rst', 'README.md')) { 159 $fp = File::Spec->catfile($env->{content_dir}, $fn); 160 if ( -f $fp ) { 161 debug('using readme file: ' . $fp); 162 $env{readme} = $fp; 163 return 0; 164 } 165 } 166 167 warn('no readme file found'); 168 return 1; 169 } 170 171 sub _check_version { 172 my $env = shift; 173 my $f; 174 my $fp; 175 176 $fp = File::Spec->catfile($env->{src_dir}, 'VERSION'); 177 if ($env->{version}) { 178 info('writing new explicit version ' . $env->{version} . ' to file: ' . $fp); 179 open($f, '>', $fp); 180 print $f $env->{version}; 181 close($f); 182 } 183 if (! -f $fp ) { 184 error('no version file'); 185 return 1; 186 } 187 debug('using version file: ' . $fp); 188 return 0; 189 } 190 191 sub _prepare_out { 192 my $release = shift; 193 my $env = shift; 194 195 return Bluto::Tree::prepare($release, $env); 196 } 197 198 sub check_sanity { 199 my $env = shift; 200 my $r = 0; 201 202 $r += _check_readme($env); 203 #$r += _check_ini($env); 204 $r += _check_yml($env); 205 $r += _check_version($env); 206 207 return $r; 208 } 209 210 sub from_yaml { 211 my $cfg_m = shift; 212 my $cfg_v = shift; 213 my $env = shift; 214 215 my $version; 216 if (!defined $env->{version}) { 217 die "version missing"; 218 } 219 $version = $env->{version}; 220 info('using version ' . $version); 221 $m_main{version} = $version; 222 223 $r += _set_single($cfg_m, 'name', 'name', 1); 224 $r += _set_single($cfg_m, 'slug', 'slug', 1); 225 $r += _set_single($cfg_m, 'summary', 'summary', 1); 226 $r += _set_single($cfg_m, 'license', 'license', 1); 227 $r += _set_single($cfg_m, 'copyright', 'copyright', 1); 228 $r += _set_single($cfg_m, 'tech', 'tech', 1); 229 $r += _set_author($cfg_m, 'maintainer', undef, 1); 230 if ($r) { 231 error('invalid configuration'); 232 return undef; 233 } 234 235 if (defined $cfg_m->{vcs}->{tag_prefix}) { 236 $m_main{tag_prefix} = $cfg_m->{vcs}->{tag_prefix}; 237 } 238 239 foreach my $v (@{$cfg_m->{locate}->{www}}) { 240 warn('not checking url formatting for ' . $v); 241 push(@m_url, $v); 242 } 243 244 foreach my $v (@{$cfg_m->{locate}->{vcs}}) { 245 warn('not checking git formatting for ' . $v); 246 push(@m_vcs, $v); 247 } 248 249 debug("contributor list: " . $cfg_v->{contributors}); 250 foreach my $v (@{$cfg_v->{contributors}}) { 251 debug('have contributor: ' . $v); 252 push(@m_contributors, $v); 253 } 254 255 foreach my $v(@{$cfg_m->{locate}->{www}}) { 256 if (!defined $m_main{uri}) { 257 $m_main{uri} = $v; 258 } 259 push(@m_uri, $v); 260 } 261 262 foreach my $v(@{$cfg_m->{locate}->{rel}}) { 263 push(@m_uri, $v); 264 } 265 266 # TODO: simplify now that changelog file is explicitly named 267 # TODO: if have sha256, check against the contents 268 push(@changelog_candidates, "CHANGELOG." . $m_main{version}); 269 for my $fn (@changelog_candidates) { 270 my $fp = File::Spec->catfile ( $env->{src_dir}, $fn ); 271 if (open(my $f, '<', $fp)) { 272 $m_main{changelog} = ''; 273 my $i = 0; 274 while (!eof($f)) { 275 my $v = readline($f); 276 if ($v =~ /^[a-zA-Z0-9]/) { 277 chomp($v); 278 if ($i > 0) { 279 $m_main{changelog} .= "\n"; 280 } 281 $m_main{changelog} .= '* ' . $v; 282 } 283 $i++; 284 } 285 close($f); 286 info('read changelog info from ' . $fp); 287 last; 288 } else { 289 debug('changelog candidate ' . $fp . ' not available: ' . $!); 290 } 291 } 292 293 $r = _prepare_out(\%m_main, $env); 294 if ($r > 0) { 295 error('output location preparations fail'); 296 return undef; 297 } 298 299 #my $targz = Bluto::Archive::create($m_main{slug}, $m_main{version}, $m_main{author_maintainer}[2], $m_main{tag_prefix}, $env->{src_dir}, $env->{out_dir}, 0); 300 my $targz = Bluto::Archive::create(\%m_main, $env, 1); 301 if (!defined $targz) { 302 error('failed to generate archive'); 303 return undef; 304 } 305 my @targz_stat = stat ( $targz ); 306 $m_main{time} = DateTime->from_epoch( epoch => $targz_stat[9] )->stringify(); 307 foreach my $v ( @{$cfg_m->{locate}->{tgzbase}}) { 308 warn('not checking targz base formatting for ' . $v); 309 my $src = $m_main{slug} . '/' . basename($targz); 310 push(@m_src, $v . '/' . $src); 311 } 312 313 if ($#m_src < 0) { 314 error('no source bundle prefixes defined'); 315 return undef; 316 } 317 318 $m_main{engine} = $env->{engine}; 319 320 for $k (keys %m_main) { 321 if ($k =~ /^[^_].*/) { 322 debug('release data: ' . $k . ': ' . $m_main{$k}); 323 } 324 } 325 326 return $m_main{version}; 327 } 328 329 sub from_config { 330 my $cfg = shift; 331 my $env = shift; 332 333 my $version; 334 if (defined $cfg->{version}) { 335 $version = $cfg->{version}; 336 } else { 337 $fn = File::Spec->catfile($env->{src_dir}, 'VERSION'); 338 open(my $f, '<', $fn) or error('no version file found: ' . $fn) && return undef; 339 $version = <$f>; 340 close($f); 341 $version = SemVer->new($version); 342 } 343 info('using version ' . $version); 344 345 $m_main{version} = $version; 346 my $r = 0; 347 $r += _set_single($cfg, 'main.name', 'name', 1); 348 $r += _set_single($cfg, 'main.slug', 'slug', 1); 349 $r += _set_single($cfg, 'main.summary', 'summary', 1); 350 $r += _set_single($cfg, 'main.license', 'license', 1); 351 $r += _set_single($cfg, 'main.copyright', 'copyright', 1); 352 $r += _set_single($cfg, 'main.uri', 'uri', 1); 353 $r += _set_author($cfg, 'maintainer', undef, 1); 354 if ($r) { 355 error('invalid configuration'); 356 return undef; 357 } 358 359 360 # $m_main{author_maintainer}[0] = $cfg->param('author:maintainer.name'); 361 # $m_main{author_maintainer}[1] = $m_main{author_maintainer}[0] . " <" . $cfg->param('author:maintainer.email') . ">"; 362 # $m_main{author_maintainer}[2] = $cfg->param('author:maintainer.pgp'); 363 # 364 my $feed_file = File::Spec->catfile( $feed_dir, $m_main{slug} ) . ".rss"; 365 366 # if (!defined $cfg->param('author:origin')) { 367 # $m_main{author_origin}[0] = $m_main{author_maintainer}[0]; 368 # $m_main{author_origin}[1] = $m_main{author_maintainer}[1]; 369 # $m_main{author_origin}[2] = $m_main{author_maintainer}[2]; 370 # } 371 372 if (defined $cfg->param('vcs.tag_prefix')) { 373 $m_main{tag_prefix} = $cfg->param('vcs.tag_prefix'); 374 } 375 376 foreach my $v ( $cfg->param('locate.www') ) { 377 warn('not checking url formatting for ' . $v); 378 push(@m_url, $v); 379 } 380 381 foreach my $v ( $cfg->param('locate.vcs') ) { 382 warn('not checking git formatting for ' . $v); 383 push(@m_vcs, $v); 384 } 385 386 my $cfg_vars = $cfg->vars(); 387 foreach my $k ($cfg->vars()) { 388 if ($k =~ /^changelog\.(.+)$/) { 389 if ($m_main{version} eq $1) { 390 if (defined $have_version_match) { 391 croak('already have version defined for ' . $1); 392 } 393 debug('found version match in changelog for ' . $1); 394 395 $have_version_match = SemVer->new($1); 396 } 397 } elsif ($k =~ /^contributor:(.+)\.(\w+)$/) { 398 if ($1 eq $m_main{version}) { 399 # if (!defined $m_main{"_contributor_$2"}) { 400 # if (_set_contributor($cfg, $1, $2, 0)) { 401 # error('corrupted contributor record for ' . $1 . ': ' . $2); 402 # } 403 # debug('found contributor for ' . $1 . ': '. $2); 404 # } 405 push(@m_contributors, $cfg_vars->{$k}); 406 debug('found contributor for ' . $1 . ': '. $2 . ' -> ' . $cfg_vars->{$k}); 407 } 408 } 409 } 410 411 if (!defined $have_version_match) { 412 error("no changelog found for version " . $m_main{version}); 413 return undef; 414 } 415 416 $r = _prepare_out(\%m_main, $env); 417 if ($r > 0) { 418 error('output location preparations fail'); 419 return undef; 420 } 421 422 #my $targz = Bluto::Archive::create($m_main{slug}, $m_main{version}, $m_main{author_maintainer}[2], $m_main{tag_prefix}, $env->{src_dir}, $env->{out_dir}, 0); 423 my $targz = Bluto::Archive::create(\%m_main, $env, 0); 424 if (!defined $targz) { 425 error('failed to generate archive'); 426 return undef; 427 } 428 my @targz_stat = stat ( $targz ); 429 $m_main{time} = DateTime->from_epoch( epoch => $targz_stat[9] )->stringify(); 430 foreach my $v ( $cfg->param('locate.tgzbase') ) { 431 warn('not checking targz base formatting for ' . $v); 432 my $src = $m_main{slug} . '/' . basename($targz); 433 push(@m_src, $v . '/' . $src); 434 } 435 436 if ($#m_src < 0) { 437 error('no source bundle prefixes defined'); 438 return undef; 439 } 440 441 # process changelog entry 442 my $body = ''; 443 my $version_src = $cfg->param('changelog.' . $have_version_match); 444 my @changelog_candidates; 445 446 if ($version_src =~ '^sha256:(.*)$' ) { 447 push(@changelog_candidates, $1); 448 debug('found sha256 changelog entry ' . $1 . ' for ' . $have_version_match); 449 } else { 450 push(@changelog_candidates, $version_src); 451 } 452 push(@changelog_candidates, "CHANGELOG." . $have_version_match); 453 push(@changelog_candidates, "CHANGELOG/" . $have_version_match); 454 push(@changelog_candidates, "CHANGELOG/CHANGELOG." . $have_version_match); 455 456 # TODO: if have sha256, check against the contents 457 for my $fn (@changelog_candidates) { 458 my $fp = File::Spec->catfile ( $env->{src_dir}, $fn ); 459 if (open(my $f, '<', $fp)) { 460 $m_main{changelog} = ''; 461 my $i = 0; 462 while (!eof($f)) { 463 my $v = readline($f); 464 if ($v =~ /^[a-zA-Z0-9]/) { 465 chomp($v); 466 if ($i > 0) { 467 $m_main{changelog} .= "\n"; 468 } 469 $m_main{changelog} .= '* ' . $v; 470 } 471 $i++; 472 } 473 close($f); 474 info('read changelog info from ' . $fp); 475 last; 476 } else { 477 debug('changelog candidate ' . $fp . ' not available: ' . $!); 478 } 479 } 480 481 if (!defined $m_main{changelog} || ref($m_main{changelog} eq 'ARRAY')) { 482 error('changelog content empty after exhausting all options'); 483 return undef; 484 } 485 486 $m_main{engine} = $env->{engine}; 487 488 # for $k (keys %m_main) { 489 # if ($k =~ /^contributor_(.+)/) { 490 # push(@m_contributors, $m_main{$k}); 491 # debug("adding contributor string line: " . $k . " -> " . $m_main{contributors}); 492 # } 493 # } 494 495 for $k (keys %m_main) { 496 if ($k =~ /^[^_].*/) { 497 debug('release data: ' . $k . ': ' . $m_main{$k}); 498 } 499 } 500 501 return $have_version_match; 502 } 503 504 sub create_announce { 505 my $env = shift; 506 my $f; 507 508 my $out = Bluto::Announce::get_asciidoc(\%m_main, $env); 509 if (!defined $out) { 510 return undef; 511 } 512 513 my $fp_base = File::Spec->catfile(Bluto::Tree->announce_path); 514 make_path($fp_base); 515 my $fp = File::Spec->catfile($fp_base, $m_main{slug} . '-' . $m_main{version} . '.bluto.txt'); 516 open($f, '>', $fp) or (error('cannot open announce file: ' . $!) && return undef); 517 print $f $out; 518 close($f); 519 debug('stored announce text file: ' . $fp); 520 521 return $fp; 522 } 523 524 sub create_rss { 525 my $env = shift; 526 527 my $out = Bluto::Announce::get_asciidoc(\%m_main, $env); 528 if (!defined $out) { 529 return undef; 530 } 531 532 #return Bluto::RSS::to_string(\%m_main, $env, $out); 533 return Bluto::RSS::to_file(\%m_main, $env, $out); 534 } 535 536 1;