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