~ubuntu-branches/ubuntu/raring/qtwebkit-source/raring-proposed

generateNewChangeLogs($prefixes, $filesInChangeLog, $addedRegressionTests, $functionLists, $bugURL, $bugDescription, $name, $emailAddress, $gitReviewer, $gitCommit, $writeChangeLogs);

214

215

if ($writeChangeLogs) {

216

print STDERR "-- Please remember to include a detailed description in your ChangeLog entry. --\n-- See <http://webkit.org/coding/contributing.html> for more info --\n";

217

}

218

219

# Write out another diff.

220

if ($spewDiff && @$changedFiles) {

221

printDiff($changedFiles, $gitCommit, $gitIndex, $mergeBase);

222

}

223

224

# Open ChangeLogs.

225

if ($openChangeLogs && @$changeLogs) {

226

openChangeLogs($changeLogs);

227

}

228

return 0;

229

}

230

231

sub generateFunctionLists($$$$$)

232

{

233

my ($changedFiles, $functionLists, $gitCommit, $gitIndex, $mergeBase) = @_;

234

235

my %changed_line_ranges;

236

if (@$changedFiles) {

237

# For each file, build a list of modified lines.

238

# Use line numbers from the "after" side of each diff.

239

print STDERR " Reviewing diff to determine which lines changed.\n";

240

my $file;

241

open DIFF, "-|", diffCommand($changedFiles, $gitCommit, $gitIndex, $mergeBase) or die "The diff failed: $!.\n";

242

while (<DIFF>) {

243

$file = makeFilePathRelative($1) if $_ =~ diffHeaderFormat();

244

if (defined $file) {

245

my ($start, $end) = extractLineRange($_);

246

if ($start >= 0 && $end >= 0) {

247

push @{$changed_line_ranges{$file}}, [ $start, $end ];

248

} elsif (/DO_NOT_COMMIT/) {

249

print STDERR "WARNING: file $file contains the string DO_NOT_COMMIT, line $.\n";

250

}

251

}

252

}

253

close DIFF;

254

}

255

256

# For each source file, convert line range to function list.

257

if (%changed_line_ranges) {

258

print STDERR " Extracting affected function names from source files.\n";

259

foreach my $file (keys %changed_line_ranges) {

260

# Find all the functions in the file.

261

open SOURCE, $file or next;

262

my @function_ranges = get_function_line_ranges(\*SOURCE, $file);

263

close SOURCE;

264

265

# Find all the modified functions.

266

my @functions;

267

my %saw_function;

268

my @change_ranges = (@{$changed_line_ranges{$file}}, []);

269

my @change_range = (0, 0);

270

FUNCTION: foreach my $function_range_ref (@function_ranges) {

271

my @function_range = @$function_range_ref;

272

273

# FIXME: This is a hack. If the function name is empty, skip it.

274

# The cpp, python, javascript, perl, css and java parsers

275

# are not perfectly implemented and sometimes function names cannot be retrieved

276

# correctly. As you can see in get_function_line_ranges_XXXX(), those parsers

277

# are not intended to implement real parsers but intended to just retrieve function names

278

# for most practical syntaxes.

279

next unless $function_range[2];

280

281

# Advance to successive change ranges.

282

for (;; @change_range = @{shift @change_ranges}) {

283

last FUNCTION unless @change_range;

284

285

# If past this function, move on to the next one.

286

next FUNCTION if $change_range[0] > $function_range[1];

287

288

# If an overlap with this function range, record the function name.

289

if ($change_range[1] >= $function_range[0]

290

and $change_range[0] <= $function_range[1]) {

291

if (!$saw_function{$function_range[2]}) {

292

$saw_function{$function_range[2]} = 1;

293

push @functions, $function_range[2];

294

}

295

next FUNCTION;

296

}

297

}

298

}

299

300

# Format the list of functions now.

301

if (@functions) {

302

$functionLists->{$file} = "" if !defined $functionLists->{$file};

303

$functionLists->{$file} .= "\n (" . join("):\n (", @functions) . "):";

304

}

305

}

306

}

307

}

308

309

sub changeLogDate($)

310

{

311

my ($timeZone) = @_;

312

my $savedTimeZone = $ENV{'TZ'};

313

# Set TZ temporarily so that localtime() is in that time zone

314

$ENV{'TZ'} = $timeZone;

315

my $date = strftime("%Y-%m-%d", localtime());

316

if (defined $savedTimeZone) {

317

$ENV{'TZ'} = $savedTimeZone;

318

} else {

319

delete $ENV{'TZ'};

320

}

321

return $date;

322

}

323

324

sub changeLogNameFromArgs($$)

325

{

326

my ($nameFromArgs, $gitCommit) = @_;

327

# Silently allow --git-commit to win, we could warn if $nameFromArgs is defined.

328

my $command = GIT . ' log --max-count=1 --pretty="format:%an" "' . $gitCommit . '"';

329

return `$command` if $gitCommit;

330

331

return $nameFromArgs || changeLogName();

332

}

333

334

sub changeLogEmailAddressFromArgs($$)

335

{

336

my ($emailAddressFromArgs, $gitCommit) = @_;

337

# Silently allow --git-commit to win, we could warn if $emailAddressFromArgs is defined.

338

my $command = GIT . ' log --max-count=1 --pretty="format:%ae" "' . $gitCommit . '"';

339

return `$command` if $gitCommit;

340

341

return $emailAddressFromArgs || changeLogEmailAddress();

342

}

343

344

sub fetchBugDescriptionFromURL($$)

345

{

346

my ($bugURL, $bugNumber) = @_;

347

348

my $bugXMLURL = "$bugURL&ctype=xml&excludefield=attachmentdata";

349

# Perl has no built in XML processing, so we'll fetch and parse with curl and grep

350

# Pass --insecure because some cygwin installs have no certs we don't

351

# care about validating that bugs.webkit.org is who it says it is here.

352

my $descriptionLine = `curl --insecure --silent "$bugXMLURL" | grep short_desc`;

353

if ($descriptionLine !~ /<short_desc>(.*)<\/short_desc>/) {

354

# Maybe the reason the above did not work is because the curl that is installed doesn't

355

# support ssl at all.

356

if (`curl --version | grep ^Protocols` !~ /\bhttps\b/) {

357

print STDERR " Could not get description for bug $bugNumber.\n";

358

print STDERR " It looks like your version of curl does not support ssl.\n";

359

print STDERR " If you are using macports, this can be fixed with sudo port install curl +ssl.\n";

360

} else {

361

print STDERR " Bug $bugNumber has no bug description. Maybe you set wrong bug ID?\n";

362

print STDERR " The bug URL: $bugXMLURL\n";

363

}

364

exit 1;

365

}

366

my $bugDescription = decodeEntities($1);

367

print STDERR " Description from bug $bugNumber:\n \"$bugDescription\".\n";

368

return $bugDescription;

369

}

370

371

sub findChangeLogs($)

372

{

373

my ($functionLists) = @_;

374

375

# Find the change logs.

376

my %has_log;

377

my %filesInChangeLog;

378

foreach my $file (sort keys %$functionLists) {

379

my $prefix = $file;

380

my $has_log = 0;

381

while ($prefix) {

382

$prefix =~ s-/[^/]+/?$-/- or $prefix = "";

383

$has_log = $has_log{$prefix};

384

if (!defined $has_log) {

385

$has_log = -f "${prefix}ChangeLog";

386

$has_log{$prefix} = $has_log;

387

}

388

last if $has_log;

389

}

390

if (!$has_log) {

391

print STDERR "No ChangeLog found for $file.\n";

392

} else {

393

push @{$filesInChangeLog{$prefix}}, $file;

394

}

395

}

396

397

# Build the list of ChangeLog prefixes in the correct project order

398

my @prefixes;

399

my %prefixesSort;

400

foreach my $prefix (keys %filesInChangeLog) {

401

my $prefixDir = substr($prefix, 0, length($prefix) - 1); # strip trailing /

402

my $sortKey = lc $prefix;

403

$sortKey = "top level" unless length $sortKey;

404

405

if ($prefixDir eq "top level") {

406

$sortKey = "";

407

} elsif ($prefixDir eq "Tools") {

408

$sortKey = "-, just after top level";

409

} elsif ($prefixDir eq "WebBrowser") {

410

$sortKey = lc "WebKit, WebBrowser after";

411

} elsif ($prefixDir eq "Source/WebCore") {

412

$sortKey = lc "WebFoundation, WebCore after";

413

} elsif ($prefixDir eq "LayoutTests") {

414

$sortKey = lc "~, LayoutTests last";

415

}

416

417

$prefixesSort{$sortKey} = $prefix;

418

}

419

foreach my $prefixSort (sort keys %prefixesSort) {

420

push @prefixes, $prefixesSort{$prefixSort};

421

}

422

return (\%filesInChangeLog, \@prefixes);

423

}

424

425

sub getLatestChangeLogs($)

426

{

427

my ($prefixes) = @_;

428

429

my @changeLogs = ();

430

foreach my $prefix (@$prefixes) {

431

push @changeLogs, File::Spec->catfile($prefix || ".", changeLogFileName());

432

}

433

return \@changeLogs;

434

}

435

436

sub resolveConflictedChangeLogs($)

437

{

438

my ($changeLogs) = @_;

439

440

print STDERR " Running 'svn update' to update ChangeLog files.\n";

441

open ERRORS, "-|", SVN, "update", @$changeLogs

442

or die "The svn update of ChangeLog files failed: $!.\n";

443

my @conflictedChangeLogs;

444

while (my $line = <ERRORS>) {

445

print STDERR " ", $line;

446

push @conflictedChangeLogs, $1 if $line =~ m/^C\s+(.+?)[\r\n]*$/;

447

}

448

close ERRORS;

449

450

return if !@conflictedChangeLogs;

451

452

print STDERR " Attempting to merge conflicted ChangeLogs.\n";

453

my $resolveChangeLogsPath = File::Spec->catfile(dirname($0), "resolve-ChangeLogs");

454

open RESOLVE, "-|", $resolveChangeLogsPath, "--no-warnings", @conflictedChangeLogs

455

or die "Could not open resolve-ChangeLogs script: $!.\n";

456

print STDERR " $_" while <RESOLVE>;

457

close RESOLVE;

458

}

459

460

sub generateNewChangeLogs($$$$$$$$$$$)

461

{

462

my ($prefixes, $filesInChangeLog, $addedRegressionTests, $functionLists, $bugURL, $bugDescription, $name, $emailAddress, $gitReviewer, $gitCommit, $writeChangeLogs) = @_;

463

464

# Generate new ChangeLog entries and (optionally) write out new ChangeLog files.

465

foreach my $prefix (@$prefixes) {

466

my $endl = "\n";

467

my @old_change_log;

468

469

if ($writeChangeLogs) {

470

my $changeLogPath = File::Spec->catfile($prefix || ".", changeLogFileName());

471

print STDERR " Editing the ${changeLogPath} file.\n";

472

open OLD_CHANGE_LOG, ${changeLogPath} or die "Could not open ${changeLogPath} file: $!.\n";

473

# It's less efficient to read the whole thing into memory than it would be

474

# to read it while we prepend to it later, but I like doing this part first.

475

@old_change_log = <OLD_CHANGE_LOG>;

476

close OLD_CHANGE_LOG;

477

# We want to match the ChangeLog's line endings in case it doesn't match

478

# the native line endings for this version of perl.

479

if ($old_change_log[0] =~ /(\r?\n)$/g) {

480

$endl = "$1";

481

}

482

open CHANGE_LOG, "> ${changeLogPath}" or die "Could not write ${changeLogPath}\n.";

483

} else {

484

open CHANGE_LOG, ">-" or die "Could not write to STDOUT\n.";

485

print substr($prefix, 0, length($prefix) - 1) . ":\n\n" unless (scalar @$prefixes) == 1;

486

}

487

488

my $date = changeLogDate(ChangeLogTimeZone);

489

print CHANGE_LOG normalizeLineEndings("$date $name <$emailAddress>\n\n", $endl);

490

491

my ($reviewer, $description) = reviewerAndDescriptionForGitCommit($gitCommit, $gitReviewer) if $gitCommit;

492

$reviewer = "NOBODY (OO" . "PS!)" if !$reviewer;

493

494

print CHANGE_LOG normalizeLineEndings($description . "\n", $endl) if $description;

495

496

$bugDescription = "Need a short description (OOPS!).\n Need the bug URL (OOPS!)." unless $bugDescription;

497

print CHANGE_LOG normalizeLineEndings(" $bugDescription\n", $endl) if $bugDescription;

498

print CHANGE_LOG normalizeLineEndings(" $bugURL\n", $endl) if $bugURL;

499

print CHANGE_LOG normalizeLineEndings("\n", $endl);

500

501

print CHANGE_LOG normalizeLineEndings(" Reviewed by $reviewer.\n\n", $endl);

502

print CHANGE_LOG normalizeLineEndings(" Additional information of the change such as approach, rationale. Please add per-function descriptions below (OOPS!).\n\n", $endl);

503

504

if ($prefix =~ m/WebCore/ || `pwd` =~ m/WebCore/) {

505

if (@$addedRegressionTests) {

506

print CHANGE_LOG normalizeLineEndings(testListForChangeLog(sort @$addedRegressionTests), $endl);

507

} else {

508

print CHANGE_LOG normalizeLineEndings(" No new tests (OOPS!).\n\n", $endl);

509

}

510

}

511

512

foreach my $file (sort @{$filesInChangeLog->{$prefix}}) {

513

my $file_stem = substr $file, length $prefix;

514

print CHANGE_LOG normalizeLineEndings(" * $file_stem:$functionLists->{$file}\n", $endl);

515

}

516

517

if ($writeChangeLogs) {

518

print CHANGE_LOG normalizeLineEndings("\n", $endl), @old_change_log;

519

} else {

520

print CHANGE_LOG "\n";

521

}

522

523

close CHANGE_LOG;

524

}

525

}

526

527

sub printDiff($$$$)

528

{

529

my ($changedFiles, $gitCommit, $gitIndex, $mergeBase) = @_;

530

531

print STDERR " Running diff to help you write the ChangeLog entries.\n";

532

local $/ = undef; # local slurp mode

533

my $changedFilesString = "'" . join("' '", @$changedFiles) . "'";

534

open DIFF, "-|", createPatchCommand($changedFilesString, $gitCommit, $gitIndex, $mergeBase) or die "The diff failed: $!.\n";

535

print <DIFF>;

536

close DIFF;

537

}

538

539

sub openChangeLogs($)

540

{

541

my ($changeLogs) = @_;

542

543

print STDERR " Opening the edited ChangeLog files.\n";

544

my $editor = $ENV{CHANGE_LOG_EDITOR} || $ENV{VISUAL} || $ENV{EDITOR};

545

if ($editor) {

546

system ((split ' ', $editor), @$changeLogs);

547

} else {

548

$editor = $ENV{CHANGE_LOG_EDIT_APPLICATION};

549

if ($editor) {

550

system "open", "-a", $editor, @$changeLogs;

551

} else {

552

system "open", "-e", @$changeLogs;

553

}

554

}

555

}

556

557

sub get_function_line_ranges($$)

558

{

559

my ($file_handle, $file_name) = @_;

560

561

# Try to determine the source language based on the file extension.

562

563

return get_function_line_ranges_for_cpp($file_handle, $file_name) if $file_name =~ /\.(c|cpp|m|mm|h)$/;

564

return get_function_line_ranges_for_java($file_handle, $file_name) if $file_name =~ /\.java$/;

565

return get_function_line_ranges_for_javascript($file_handle, $file_name) if $file_name =~ /\.js$/;

566

return get_selector_line_ranges_for_css($file_handle, $file_name) if $file_name =~ /\.css$/;

567

return get_function_line_ranges_for_perl($file_handle, $file_name) if $file_name =~ /\.p[lm]$/;

568

return get_function_line_ranges_for_python($file_handle, $file_name) if $file_name =~ /\.py$/ or $file_name =~ /master\.cfg$/;

569

570

# Try to determine the source language based on the script interpreter.

571

572

my $first_line = <$file_handle>;

573

seek($file_handle, 0, 0);

574

575

return () unless $first_line =~ m|^#!(?:/usr/bin/env\s+)?(\S+)|;

576

my $interpreter = $1;

577

578

return get_function_line_ranges_for_perl($file_handle, $file_name) if $interpreter =~ /perl$/;

579

return get_function_line_ranges_for_python($file_handle, $file_name) if $interpreter =~ /python$/;

580

581

return ();

582

}

583

584

585

sub method_decl_to_selector($)

586

{

587

(my $method_decl) = @_;

588

589

$_ = $method_decl;

590

591

if ((my $comment_stripped) = m-([^/]*)(//|/*).*-) {

592

$_ = $comment_stripped;

593

}

594

595

s/,\s*...//;

596

597

if (/:/) {

598

my @components = split /:/;

599

pop @components if (scalar @components > 1);

600

$_ = (join ':', map {s/.*[^[:word:]]//; scalar $_;} @components) . ':';

601

} else {

602

s/\s*$//;

603

s/.*[^[:word:]]//;

604

}

605

606

return $_;

607

}

608

609

610

611

# Read a file and get all the line ranges of the things that look like C functions.

612

# A function name is the last word before an open parenthesis before the outer

613

# level open brace. A function starts at the first character after the last close

614

# brace or semicolon before the function name and ends at the close brace.

615

# Comment handling is simple-minded but will work for all but pathological cases.

616

617

# Result is a list of triples: [ start_line, end_line, function_name ].

618

619

sub get_function_line_ranges_for_cpp($$)

620

{

621

my ($file_handle, $file_name) = @_;

622

623

my @ranges;

624

625

my $in_comment = 0;

626

my $in_macro = 0;

627

my $in_method_declaration = 0;

628

my $in_parentheses = 0;

629

my $in_braces = 0;

630

my $in_toplevel_array_brace = 0;

631

my $brace_start = 0;

632

my $brace_end = 0;

633

my $namespace_start = -1;

634

my $skip_til_brace_or_semicolon = 0;

635

my $equal_observed = 0;

636

637

my $word = "";

638

my $interface_name = "";

639

640

my $potential_method_char = "";

641

my $potential_method_spec = "";

642

643

my $potential_start = 0;

644

my $potential_name = "";

645

646

my $start = 0;

647

my $name = "";

648

649

my $next_word_could_be_namespace = 0;

650

my $potential_namespace = "";

651

my @namespaces;

652

653

while (<$file_handle>) {

654

# Handle continued multi-line comment.

655

if ($in_comment) {

656

next unless s-.*\*/--;

657

$in_comment = 0;

658

}

659

660

# Handle continued macro.

661

if ($in_macro) {

662

$in_macro = 0 unless /\\$/;

663

next;

664

}

665

666

# Handle start of macro (or any preprocessor directive).

667

if (/^\s*\#/) {

668

$in_macro = 1 if /^([^\\]|\\.)*\\$/;

669

next;

670

}

671

672

# Handle comments and quoted text.

673

while (m-(/\*|//|\'|\")-) { # \' and \" keep emacs perl mode happy

674

my $match = $1;

675

if ($match eq "/*") {

676

if (!s-/\*.*?\*/--) {

677

s-/\*.*--;

678

$in_comment = 1;

679

}

680

} elsif ($match eq "//") {

681

s-//.*--;

682

} else { # ' or "

683

if (!s-$match([^\\]|\\.)*?$match--) {

684

warn "mismatched quotes at line $. in $file_name\n";

685

s-$match.*--;

686

}

687

}

688

}

689

690

691

# continued method declaration

692

if ($in_method_declaration) {

693

my $original = $_;

694

my $method_cont = $_;

695

696

chomp $method_cont;

697

$method_cont =~ s/[;\{].*//;

698

$potential_method_spec = "${potential_method_spec} ${method_cont}";

699

700

$_ = $original;

701

if (/;/) {

702

$potential_start = 0;

703

$potential_method_spec = "";

704

$potential_method_char = "";

705

$in_method_declaration = 0;

706

s/^[^;\{]*//;

707

} elsif (/{/) {

708

my $selector = method_decl_to_selector ($potential_method_spec);

709

$potential_name = "${potential_method_char}\[${interface_name} ${selector}\]";

710

711

$potential_method_spec = "";

712

$potential_method_char = "";

713

$in_method_declaration = 0;

714

715

$_ = $original;

716

s/^[^;{]*//;

717

} elsif (/\@end/) {

718

$in_method_declaration = 0;

719

$interface_name = "";

720

$_ = $original;

721

} else {

722

next;

723

}

724

}

725

726

727

# start of method declaration

728

if ((my $method_char, my $method_spec) = m&^([-+])([^0-9;][^;]*);?$&) {

729

my $original = $_;

730

731

if ($interface_name) {

732

chomp $method_spec;

733

$method_spec =~ s/\{.*//;

734

735

$potential_method_char = $method_char;

736

$potential_method_spec = $method_spec;

737

$potential_start = $.;

738

$in_method_declaration = 1;

739

} else {

740

warn "declaring a method but don't have interface on line $. in $file_name\n";

741

}

742

$_ = $original;

743

if (/\{/) {

744

my $selector = method_decl_to_selector ($potential_method_spec);

745

$potential_name = "${potential_method_char}\[${interface_name} ${selector}\]";

746

747

$potential_method_spec = "";

748

$potential_method_char = "";

749

$in_method_declaration = 0;

750

$_ = $original;

751

s/^[^{]*//;

752

} elsif (/\@end/) {

753

$in_method_declaration = 0;

754

$interface_name = "";

755

$_ = $original;

756

} else {

757

next;

758

}

759

}

760

761

762

# Find function, interface and method names.

763

while (m&((?:[[:word:]]+::)*operator(?:[ \t]*|[^()]*)|[[:word:]:~]+|[(){}:;=])|\@(?:implementation|interface|protocol)\s+(\w+)[^{]*&g) {

764

# Skip an array definition at the top level.

765

# e.g. static int arr[] = { 1, 2, 3 };

766

if ($1) {

767

if ($1 eq "=" and !$in_parentheses and !$in_braces) {

768

$equal_observed = 1;

769

} elsif ($1 eq "{" and $equal_observed) {

770

# This '{' is the beginning of an array definition, not the beginning of a method.

771

$in_toplevel_array_brace = 1;

772

$in_braces++;

773

$equal_observed = 0;

774

next;

775

} elsif ($1 !~ /[ \t]/) {

776

$equal_observed = 0;

777

}

778

}

779

780

# interface name

781

if ($2) {

782

$interface_name = $2;

783

next;

784

}

785

786

# Open parenthesis.

787

if ($1 eq "(") {

788

$potential_name = $word unless $in_parentheses || $skip_til_brace_or_semicolon;

789

$in_parentheses++;

790

next;

791

}

792

793

# Close parenthesis.

794

if ($1 eq ")") {

795

$in_parentheses--;

796

next;

797

}

798

799

# C++ constructor initializers

800

if ($1 eq ":") {

801

$skip_til_brace_or_semicolon = 1 unless ($in_parentheses || $in_braces);

802

}

803

804

# Open brace.

805

if ($1 eq "{") {

806

$skip_til_brace_or_semicolon = 0;

807

808

if (!$in_braces) {

809

if ($namespace_start >= 0 and $namespace_start < $potential_start) {

810

push @ranges, [ $namespace_start . "", $potential_start - 1, $name ];

811

}

812

813

if ($potential_namespace) {

814

push @namespaces, $potential_namespace;

815

$potential_namespace = "";

816

$name = $namespaces[-1];

817

$namespace_start = $. + 1;

818

next;

819

}

820

821

# Promote potential name to real function name at the

822

# start of the outer level set of braces (function body?).

823

if ($potential_start) {

824

$start = $potential_start;

825

$name = $potential_name;

826

if (@namespaces && $name && (length($name) < 2 || substr($name,1,1) ne "[")) {

827

$name = join ('::', @namespaces, $name);

828

}

829

}

830

}

831

832

$in_method_declaration = 0;

833

834

$brace_start = $. if (!$in_braces);

835

$in_braces++;

836

next;

837

}

838

839

# Close brace.

840

if ($1 eq "}") {

841

if (!$in_braces && @namespaces) {

842

if ($namespace_start >= 0 and $namespace_start < $.) {

843

push @ranges, [ $namespace_start . "", $. - 1, $name ];

844

}

845

846

pop @namespaces;

847

if (@namespaces) {

848

$name = $namespaces[-1];

849

$namespace_start = $. + 1;

850

} else {

851

$name = "";

852

$namespace_start = -1;

853

}

854

next;

855

}

856

857

$in_braces--;

858

$brace_end = $. if (!$in_braces);

859

860

# End of an outer level set of braces.

861

# This could be a function body.

862

if (!$in_braces and $name) {

863

# This is the end of an array definition at the top level, not the end of a method.

864

if ($in_toplevel_array_brace) {

865

$in_toplevel_array_brace = 0;

866

next;

867

}

868

869

push @ranges, [ $start, $., $name ];

870

if (@namespaces) {

871

$name = $namespaces[-1];

872

$namespace_start = $. + 1;

873

} else {

874

$name = "";

875

$namespace_start = -1;

876

}

877

}

878

879

$potential_start = 0;

880

$potential_name = "";

881

next;

882

}

883

884

# Semicolon.

885

if ($1 eq ";") {

886

$skip_til_brace_or_semicolon = 0;

887

$potential_start = 0;

888

$potential_name = "";

889

$in_method_declaration = 0;

890

next;

891

}

892

893

# Ignore "const" method qualifier.

894

if ($1 eq "const") {

895

next;

896

}

897

898

if ($1 eq "namespace" || $1 eq "class" || $1 eq "struct") {

899

$next_word_could_be_namespace = 1;

900

next;

901

}

902

903

# Word.

904

$word = $1;

905

if (!$skip_til_brace_or_semicolon) {

906

if ($next_word_could_be_namespace) {

907

$potential_namespace = $word;

908

$next_word_could_be_namespace = 0;

909

} elsif ($potential_namespace) {

910

$potential_namespace = "";

911

}

912

913

if (!$in_parentheses) {

914

$potential_start = 0;

915

$potential_name = "";

916

}

917

if (!$potential_start) {

918

$potential_start = $.;

919

$potential_name = "";

920

}

921

}

922

}

923

}

924

925

warn "missing close braces in $file_name (probable start at $brace_start)\n" if ($in_braces > 0);

926

warn "too many close braces in $file_name (probable start at $brace_end)\n" if ($in_braces < 0);

927

928

warn "mismatched parentheses in $file_name\n" if $in_parentheses;

929

930

return @ranges;

931

}

932

933

934

935

# Read a file and get all the line ranges of the things that look like Java

936

# classes, interfaces and methods.

937

938

# A class or interface name is the word that immediately follows

939

# `class' or `interface' when followed by an open curly brace and not

940

# a semicolon. It can appear at the top level, or inside another class

941

# or interface block, but not inside a function block

942

943

# A class or interface starts at the first character after the first close

944

# brace or after the function name and ends at the close brace.

945

946

# A function name is the last word before an open parenthesis before

947

# an open brace rather than a semicolon. It can appear at top level or

948

# inside a class or interface block, but not inside a function block.

949

950

# A function starts at the first character after the first close

951

# brace or after the function name and ends at the close brace.

952

953

# Comment handling is simple-minded but will work for all but pathological cases.

954

955

# Result is a list of triples: [ start_line, end_line, function_name ].

956

957

sub get_function_line_ranges_for_java($$)

958

{

959

my ($file_handle, $file_name) = @_;

960

961

my @current_scopes;

962

963

my @ranges;

964

965

my $in_comment = 0;

966

my $in_macro = 0;

967

my $in_parentheses = 0;

968

my $in_braces = 0;

969

my $in_non_block_braces = 0;

970

my $class_or_interface_just_seen = 0;

971

my $in_class_declaration = 0;

972

973

my $word = "";

974

975

my $potential_start = 0;

976

my $potential_name = "";

977

my $potential_name_is_class_or_interface = 0;

978

979

my $start = 0;

980

my $name = "";

981

my $current_name_is_class_or_interface = 0;

982

983

while (<$file_handle>) {

984

# Handle continued multi-line comment.

985

if ($in_comment) {

986

next unless s-.*\*/--;

987

$in_comment = 0;

988

}

989

990

# Handle continued macro.

991

if ($in_macro) {

992

$in_macro = 0 unless /\\$/;

993

next;

994

}

995

996

# Handle start of macro (or any preprocessor directive).

997

if (/^\s*\#/) {

998

$in_macro = 1 if /^([^\\]|\\.)*\\$/;

999

next;

1000

}

1001

1002

# Handle comments and quoted text.

1003

while (m-(/\*|//|\'|\")-) { # \' and \" keep emacs perl mode happy

1004

my $match = $1;

1005

if ($match eq "/*") {

1006

if (!s-/\*.*?\*/--) {

1007

s-/\*.*--;

1008

$in_comment = 1;

1009

}

1010

} elsif ($match eq "//") {

1011

s-//.*--;

1012

} else { # ' or "

1013

if (!s-$match([^\\]|\\.)*?$match--) {

1014

warn "mismatched quotes at line $. in $file_name\n";

1015

s-$match.*--;

1016

}

1017

}

1018

}

1019

1020

# Find function names.

1021

while (m-(\w+|[(){};])-g) {

1022

# Open parenthesis.

1023

if ($1 eq "(") {

1024

if (!$in_parentheses) {

1025

$potential_name = $word;

1026

$potential_name_is_class_or_interface = 0;

1027

}

1028

$in_parentheses++;

1029

next;

1030

}

1031

1032

# Close parenthesis.

1033

if ($1 eq ")") {

1034

$in_parentheses--;

1035

next;

1036

}

1037

1038

# Open brace.

1039

if ($1 eq "{") {

1040

$in_class_declaration = 0;

1041

1042

# Promote potential name to real function name at the

1043

# start of the outer level set of braces (function/class/interface body?).

1044

if (!$in_non_block_braces

1045

and (!$in_braces or $current_name_is_class_or_interface)

1046

and $potential_start) {

1047

if ($name) {

1048

push @ranges, [ $start, ($. - 1),

1049

join ('.', @current_scopes) ];

1050

}

1051

1052

1053

$current_name_is_class_or_interface = $potential_name_is_class_or_interface;

1054

1055

$start = $potential_start;

1056

$name = $potential_name;

1057

1058

push (@current_scopes, $name);

1059

} else {

1060

$in_non_block_braces++;

1061

}

1062

1063

$potential_name = "";

1064

$potential_start = 0;

1065

1066

$in_braces++;

1067

next;

1068

}

1069

1070

# Close brace.

1071

if ($1 eq "}") {

1072

$in_braces--;

1073

1074

# End of an outer level set of braces.

1075

# This could be a function body.

1076

if (!$in_non_block_braces) {

1077

if ($name) {

1078

push @ranges, [ $start, $.,

1079

join ('.', @current_scopes) ];

1080

1081

pop (@current_scopes);

1082

1083

if (@current_scopes) {

1084

$current_name_is_class_or_interface = 1;

1085

1086

$start = $. + 1;

1087

$name = $current_scopes[$#current_scopes-1];

1088

} else {

1089

$current_name_is_class_or_interface = 0;

1090

$start = 0;

1091

$name = "";

1092

}

1093

}

1094

} else {

1095

$in_non_block_braces-- if $in_non_block_braces;

1096

}

1097

1098

$potential_start = 0;

1099

$potential_name = "";

1100

next;

1101

}

1102

1103

# Semicolon.

1104

if ($1 eq ";") {

1105

$potential_start = 0;

1106

$potential_name = "";

1107

next;

1108

}

1109

1110

if ($1 eq "class") {

1111

$in_class_declaration = 1;

1112

}

1113

if ($1 eq "class" or (!$in_class_declaration and $1 eq "interface")) {

1114

$class_or_interface_just_seen = 1;

1115

next;

1116

}

1117

1118

# Word.

1119

$word = $1;

1120

if (!$in_parentheses) {

1121

if ($class_or_interface_just_seen) {

1122

$potential_name = $word;

1123

$potential_start = $.;

1124

$class_or_interface_just_seen = 0;

1125

$potential_name_is_class_or_interface = 1;

1126

next;

1127

}

1128

}

1129

if (!$potential_start) {

1130

$potential_start = $.;

1131

$potential_name = "";

1132

}

1133

$class_or_interface_just_seen = 0;

1134

}

1135

}

1136

1137

warn "mismatched braces in $file_name\n" if $in_braces;

1138

warn "mismatched parentheses in $file_name\n" if $in_parentheses;

1139

1140

return @ranges;

1141

}

1142

1143

1144

1145

# Read a file and get all the line ranges of the things that look like

1146

# JavaScript functions.

1147

1148

# A function name is the word that immediately follows `function' when

1149

# followed by an open curly brace. It can appear at the top level, or

1150

# inside other functions.

1151

1152

# An anonymous function name is the identifier chain immediately before

1153

# an assignment with the equals operator or object notation that has a

1154

# value starting with `function' followed by an open curly brace.

1155

1156

# A getter or setter name is the word that immediately follows `get' or

1157

# `set' when followed by an open curly brace .

1158

1159

# Comment handling is simple-minded but will work for all but pathological cases.

1160

1161

# Result is a list of triples: [ start_line, end_line, function_name ].

1162

1163

sub get_function_line_ranges_for_javascript($$)

1164

{

1165

my ($fileHandle, $fileName) = @_;

1166

1167

my @currentScopes;

1168

my @currentIdentifiers;

1169

my @currentFunctionNames;

1170

my @currentFunctionDepths;

1171

my @currentFunctionStartLines;

1172

1173

my @ranges;

1174

1175

my $inComment = 0;

1176

my $inQuotedText = "";

1177

my $parenthesesDepth = 0;

1178

my $bracesDepth = 0;

1179

1180

my $functionJustSeen = 0;

1181

my $getterJustSeen = 0;

1182

my $setterJustSeen = 0;

1183

my $assignmentJustSeen = 0;

1184

1185

my $word = "";

1186

1187

while (<$fileHandle>) {

1188

# Handle continued multi-line comment.

1189

if ($inComment) {

1190

next unless s-.*\*/--;

1191

$inComment = 0;

1192

}

1193

1194

# Handle continued quoted text.

1195

if ($inQuotedText ne "") {

1196

next if /\\$/;

1197

s-([^\\]|\\.)*?$inQuotedText--;

1198

$inQuotedText = "";

1199

}

1200

1201

# Handle comments and quoted text.

1202

while (m-(/\*|//|\'|\")-) { # \' and \" keep emacs perl mode happy

1203

my $match = $1;

1204

if ($match eq '/*') {

1205

if (!s-/\*.*?\*/--) {

1206

s-/\*.*--;

1207

$inComment = 1;

1208

}

1209

} elsif ($match eq '//') {

1210

s-//.*--;

1211

} else { # ' or "

1212

if (!s-$match([^\\]|\\.)*?$match-string_appeared_here-) {

1213

$inQuotedText = $match if /\\$/;

1214

warn "mismatched quotes at line $. in $fileName\n" if $inQuotedText eq "";

1215

s-$match.*--;

1216

}

1217

}

1218

}

1219

1220

# Find function names.

1221

while (m-(\w+|[(){}=:;,])-g) {

1222

# Open parenthesis.

1223

if ($1 eq '(') {

1224

$parenthesesDepth++;

1225

next;

1226

}

1227

1228

# Close parenthesis.

1229

if ($1 eq ')') {

1230

$parenthesesDepth--;

1231

next;

1232

}

1233

1234

# Open brace.

1235

if ($1 eq '{') {

1236

push(@currentScopes, join(".", @currentIdentifiers));

1237

@currentIdentifiers = ();

1238

1239

$bracesDepth++;

1240

next;

1241

}

1242

1243

# Close brace.

1244

if ($1 eq '}') {

1245

$bracesDepth--;

1246

1247

if (@currentFunctionDepths and $bracesDepth == $currentFunctionDepths[$#currentFunctionDepths]) {

1248

pop(@currentFunctionDepths);

1249

1250

my $currentFunction = pop(@currentFunctionNames);

1251

my $start = pop(@currentFunctionStartLines);

1252

1253

push(@ranges, [$start, $., $currentFunction]);

1254

}

1255

1256

pop(@currentScopes);

1257

@currentIdentifiers = ();

1258

1259

next;

1260

}

1261

1262

# Semicolon or comma.

1263

if ($1 eq ';' or $1 eq ',') {

1264

@currentIdentifiers = ();

1265

next;

1266

}

1267

1268

# Function.

1269

if ($1 eq 'function') {

1270

$functionJustSeen = 1;

1271

1272

if ($assignmentJustSeen) {

1273

my $currentFunction = join('.', (@currentScopes, @currentIdentifiers));

1274

$currentFunction =~ s/\.{2,}/\./g; # Removes consecutive periods.

1275

1276

push(@currentFunctionNames, $currentFunction);

1277

push(@currentFunctionDepths, $bracesDepth);

1278

push(@currentFunctionStartLines, $.);

1279

}

1280

1281

next;

1282

}

1283

1284

# Getter prefix.

1285

if ($1 eq 'get') {

1286

$getterJustSeen = 1;

1287

next;

1288

}

1289

1290

# Setter prefix.

1291

if ($1 eq 'set') {

1292

$setterJustSeen = 1;

1293

next;

1294

}

1295

1296

# Assignment operator.

1297

if ($1 eq '=' or $1 eq ':') {

1298

$assignmentJustSeen = 1;

1299

next;

1300

}

1301

1302

next if $parenthesesDepth;

1303

1304

# Word.

1305

$word = $1;

1306

$word = "get $word" if $getterJustSeen;

1307

$word = "set $word" if $setterJustSeen;

1308

1309

if (($functionJustSeen and !$assignmentJustSeen) or $getterJustSeen or $setterJustSeen) {

1310

push(@currentIdentifiers, $word);

1311

1312

my $currentFunction = join('.', (@currentScopes, @currentIdentifiers));

1313

$currentFunction =~ s/\.{2,}/\./g; # Removes consecutive periods.

1314

1315

push(@currentFunctionNames, $currentFunction);

1316

push(@currentFunctionDepths, $bracesDepth);

1317

push(@currentFunctionStartLines, $.);

1318

} elsif ($word ne 'if' and $word ne 'for' and $word ne 'do' and $word ne 'while' and $word ne 'which' and $word ne 'var') {

1319

push(@currentIdentifiers, $word);

1320

}

1321

1322

$functionJustSeen = 0;

1323

$getterJustSeen = 0;

1324

$setterJustSeen = 0;

1325

$assignmentJustSeen = 0;

1326

}

1327

}

1328

1329

warn "mismatched braces in $fileName\n" if $bracesDepth;

1330

warn "mismatched parentheses in $fileName\n" if $parenthesesDepth;

1331

1332

return @ranges;

1333

}

1334

1335

# Read a file and get all the line ranges of the things that look like Perl functions. Functions

1336

# start on a line that starts with "sub ", and end on the first line starting with "}" thereafter.

1337

1338

# Result is a list of triples: [ start_line, end_line, function ].

1339

1340

sub get_function_line_ranges_for_perl($$)

1341

{

1342

my ($fileHandle, $fileName) = @_;

1343

1344

my @ranges;

1345

1346

my $currentFunction = "";

1347

my $start = 0;

1348

my $hereDocumentIdentifier = "";

1349

1350

while (<$fileHandle>) {

1351

chomp;

1352

if (!$hereDocumentIdentifier) {

1353

if (/^sub\s+([\w_][\w\d_]*)/) {

1354

# Skip over forward declarations, which don't contain a brace and end with a semicolon.

1355

next if /;\s*$/;

1356

1357

if ($currentFunction) {

1358

warn "nested functions found at top-level at $fileName:$.\n";

1359

next;

1360

}

1361

$currentFunction = $1;

1362

$start = $.;

1363

}

1364

if (/<<\s*[\"\']?([\w_][\w_\d]*)/) {

1365

# Enter here-document.

1366

$hereDocumentIdentifier = $1;

1367

}

1368

if (index($_, "}") == 0) {

1369

next unless $start;

1370

push(@ranges, [$start, $., $currentFunction]);

1371

$currentFunction = "";

1372

$start = 0;

1373

}

1374

} elsif ($_ eq $hereDocumentIdentifier) {

1375

# Escape from here-document.

1376

$hereDocumentIdentifier = "";

1377

}

1378

}

1379

1380

return @ranges;

1381

}

1382

1383

# Read a file and get all the line ranges of the things that look like Python classes, methods, or functions.

1384

1385

# FIXME: Maybe we should use Python's ast module to do the parsing for us?

1386

1387

# Result is a list of triples: [ start_line, end_line, function ].

1388

1389

sub get_function_line_ranges_for_python($$)

1390

{

1391

my ($fileHandle, $fileName) = @_;

1392

1393

my @ranges;

1394

1395

my @scopeStack = ({ line => 0, indent => -1, name => undef });

1396

my $lastLine = 0;

1397

until ($lastLine) {

1398

$_ = <$fileHandle>;

1399

unless ($_) {

1400

# To pop out all popped scopes, run the loop once more after

1401

# we encountered the end of the file.

1402

$_ = "pass\n";

1403

$.++;

1404

$lastLine = 1;

1405

}

1406

chomp;

1407

next unless /^(\s*)([^#].*)$/;

1408

1409

my $indent = length $1;

1410

my $rest = $2;

1411

my $scope = $scopeStack[-1];

1412

1413

if ($indent <= $scope->{indent}) {

1414

# Find all the scopes that we have just exited.

1415

my $i = 0;

1416

for (; $i < @scopeStack; ++$i) {

1417

last if $indent <= $scopeStack[$i]->{indent};

1418

}

1419

my @poppedScopes = splice @scopeStack, $i;

1420

1421

# For each scope that was just exited, add a range that goes from the start of that

1422

# scope to the start of the next nested scope, or to the line just before this one for

1423

# the innermost scope.

1424

for ($i = 0; $i < @poppedScopes; ++$i) {

1425

my $lineAfterEnd = $i + 1 == @poppedScopes ? $. : $poppedScopes[$i + 1]->{line};

1426

push @ranges, [$poppedScopes[$i]->{line}, $lineAfterEnd - 1, $poppedScopes[$i]->{name}];

1427

}

1428

@scopeStack or warn "Popped off last scope at $fileName:$.\n";

1429

1430

# Set the now-current scope to start at the current line. Any lines within this scope

1431

# before this point should already have been added to @ranges.

1432

$scope = $scopeStack[-1];

1433

$scope->{line} = $.;

1434

}

1435

1436

next unless $rest =~ /(?:class|def)\s+(\w+)/;

1437

my $name = $1;

1438

my $fullName = $scope->{name} ? join('.', $scope->{name}, $name) : $name;

1439

push @scopeStack, { line => $., indent => $indent, name => $fullName };

1440

1441

if ($scope->{indent} >= 0) {

1442

push @ranges, [$scope->{line}, $. - 1, $scope->{name}];

1443

}

1444

}

1445

1446

return @ranges;

1447

}

1448

1449

# Read a file and get all the line ranges of the things that look like CSS selectors. A selector is

1450

# anything before an opening brace on a line. A selector starts at the line containing the opening

1451

# brace and ends at the closing brace.

1452

1453

# Result is a list of triples: [ start_line, end_line, selector ].

1454

1455

sub get_selector_line_ranges_for_css($$)

1456

{

1457

my ($fileHandle, $fileName) = @_;

1458

1459

my @ranges;

1460

1461

my $currentSelector = "";

1462

my $start = 0;

1463

my $inComment = 0;

1464

my $inBrace = 0;

1465

1466

while (<$fileHandle>) {

1467

foreach my $token (split m-(\{|\}|/\*|\*/)-, $_) {

1468

if ($token eq "{") {

1469

if (!$inComment) {

1470

warn "mismatched brace found in $fileName\n" if $inBrace;

1471

$inBrace = 1;

1472

}

1473

} elsif ($token eq "}") {

1474

if (!$inComment) {

1475

warn "mismatched brace found in $fileName\n" if !$inBrace;

1476

$inBrace = 0;

1477

push(@ranges, [$start, $., $currentSelector]);

1478

$currentSelector = "";

1479

$start = 0;

1480

}

1481

} elsif ($token eq "/*") {

1482

$inComment = 1;

1483

} elsif ($token eq "*/") {

1484

warn "mismatched comment found in $fileName\n" if !$inComment;

1485

$inComment = 0;

1486

} else {

1487

if (!$inComment and !$inBrace and $token !~ /^[\s\t]*$/) {

1488

$token =~ s/^[\s\t]*|[\s\t]*$//g;

1489

$currentSelector = $token;

1490

$start = $.;

1491

}

1492

}

1493

}

1494

}

1495

1496

return @ranges;

1497

}

1498

1499

sub processPaths(\@)

1500

{

1501

my ($paths) = @_;

1502

return ("." => 1) if (!@{$paths});

1503

1504

my %result = ();

1505

1506

for my $file (@{$paths}) {

1507

die "can't handle absolute paths like \"$file\"\n" if File::Spec->file_name_is_absolute($file);

1508

die "can't handle empty string path\n" if $file eq "";

1509

die "can't handle path with single quote in the name like \"$file\"\n" if $file =~ /'/; # ' (keep Xcode syntax highlighting happy)

1510

1511

my $untouchedFile = $file;

1512

1513

$file = canonicalizePath($file);

1514

1515

die "can't handle paths with .. like \"$untouchedFile\"\n" if $file =~ m|/\.\./|;

1516

1517

$result{$file} = 1;

1518

}

1519

1520

return ("." => 1) if ($result{"."});

1521

1522

# Remove any paths that also have a parent listed.

1523

for my $path (keys %result) {

1524

for (my $parent = dirname($path); $parent ne '.'; $parent = dirname($parent)) {

1525

if ($result{$parent}) {

1526

delete $result{$path};

1527

last;

1528

}

1529

}

1530

}

1531

1532

return %result;

1533

}

1534

1535

sub diffFromToString($$$)

1536

{

1537

my ($gitCommit, $gitIndex, $mergeBase) = @_;

1538

1539

return "" if isSVN();

1540

return $gitCommit if $gitCommit =~ m/.+\.\..+/;

1541

return "\"$gitCommit^\" \"$gitCommit\"" if $gitCommit;

1542

return "--cached" if $gitIndex;

1543

return $mergeBase if $mergeBase;

1544

return "HEAD" if isGit();

1545

}

1546

1547

sub diffCommand($$$$)

1548

{

1549

my ($paths, $gitCommit, $gitIndex, $mergeBase) = @_;

1550

1551

my $command;

1552

if (isSVN()) {

1553

my @escapedPaths = map(escapeSubversionPath($_), @$paths);

1554

my $escapedPathsString = "'" . join("' '", @escapedPaths) . "'";

1555

$command = SVN . " diff --diff-cmd diff -x -N $escapedPathsString";

1556

} elsif (isGit()) {

1557

my $pathsString = "'" . join("' '", @$paths) . "'";

1558

$command = GIT . " diff --no-ext-diff -U0 " . diffFromToString($gitCommit, $gitIndex, $mergeBase);

1559

$command .= " -- $pathsString" unless $gitCommit or $mergeBase;

1560

}

1561

1562

return $command;

1563

}

1564

1565

sub statusCommand($$$$)

1566

{

1567

my ($paths, $gitCommit, $gitIndex, $mergeBase) = @_;

1568

1569

my $command;

1570

if (isSVN()) {

1571

my @escapedFiles = map(escapeSubversionPath($_), keys %$paths);

1572

my $escapedFilesString = "'" . join("' '", @escapedFiles) . "'";

1573

$command = SVN . " stat $escapedFilesString";

1574

} elsif (isGit()) {

1575

my $filesString = '"' . join('" "', keys %$paths) . '"';

1576

$command = GIT . " diff -r --name-status -M -C " . diffFromToString($gitCommit, $gitIndex, $mergeBase);

1577

$command .= " -- $filesString" unless $gitCommit;

1578

}

1579

1580

return "$command 2>&1";

1581

}

1582

1583

sub createPatchCommand($$$$)

1584

{

1585

my ($changedFilesString, $gitCommit, $gitIndex, $mergeBase) = @_;

1586

1587

my $command;

1588

if (isSVN()) {

1589

$command = "'$FindBin::Bin/svn-create-patch' $changedFilesString";

1590

} elsif (isGit()) {

1591

$command = GIT . " diff -M -C " . diffFromToString($gitCommit, $gitIndex, $mergeBase);

1592

$command .= " -- $changedFilesString" unless $gitCommit;

1593

}

1594

1595

return $command;

1596

}

1597

1598

sub diffHeaderFormat()

1599

{

1600

return qr/^Index: (\S+)[\r\n]*$/ if isSVN();

1601

return qr/^diff --git a\/.+ b\/(.+)$/ if isGit();

1602

}

1603

1604

sub findOriginalFileFromSvn($)

1605

{

1606

my ($file) = @_;

1607

my $baseUrl;

1608

open INFO, SVN . " info . |" or die;

1609

while (<INFO>) {

1610

if (/^URL: (.+?)[\r\n]*$/) {

1611

$baseUrl = $1;

1612

}

1613

}

1614

close INFO;

1615

my $sourceFile;

1616

my $escapedFile = escapeSubversionPath($file);

1617

open INFO, SVN . " info '$escapedFile' |" or die;

1618

while (<INFO>) {

1619

if (/^Copied From URL: (.+?)[\r\n]*$/) {

1620

$sourceFile = File::Spec->abs2rel($1, $baseUrl);

1621

}

1622

}

1623

close INFO;

1624

return $sourceFile;

1625

}

1626

1627

sub determinePropertyChanges($$$)

1628

{

1629

my ($file, $isAdd, $original) = @_;

1630

1631

my $escapedFile = escapeSubversionPath($file);

1632

my %changes;

1633

if ($isAdd) {

1634

my %addedProperties;

1635

my %removedProperties;

1636

open PROPLIST, SVN . " proplist '$escapedFile' |" or die;

1637

while (<PROPLIST>) {

1638

$addedProperties{$1} = 1 if /^ (.+?)[\r\n]*$/ && $1 ne 'svn:mergeinfo';

1639

}

1640

close PROPLIST;

1641

if ($original) {

1642

my $escapedOriginal = escapeSubversionPath($original);

1643

open PROPLIST, SVN . " proplist '$escapedOriginal' |" or die;

1644

while (<PROPLIST>) {

1645

next unless /^ (.+?)[\r\n]*$/;

1646

my $property = $1;

1647

if (exists $addedProperties{$property}) {

1648

delete $addedProperties{$1};

1649

} else {

1650

$removedProperties{$1} = 1;

1651

}

1652

}

1653

}

1654

$changes{"A"} = [sort keys %addedProperties] if %addedProperties;

1655

$changes{"D"} = [sort keys %removedProperties] if %removedProperties;

1656

} else {

1657

open DIFF, SVN . " diff '$escapedFile' |" or die;

1658

while (<DIFF>) {

1659

if (/^Property changes on:/) {

1660

while (<DIFF>) {

1661

my $operation;

1662

my $property;

1663

if (/^Added: (\S*)/) {

1664

$operation = "A";

1665

$property = $1;

1666

} elsif (/^Modified: (\S*)/) {

1667

$operation = "M";

1668

$property = $1;

1669

} elsif (/^Deleted: (\S*)/) {

1670

$operation = "D";

1671

$property = $1;

1672

} elsif (/^Name: (\S*)/) {

1673

# Older versions of svn just say "Name" instead of the type

1674

# of property change.

1675

$operation = "C";

1676

$property = $1;

1677

}

1678

if ($operation) {

1679

$changes{$operation} = [] unless exists $changes{$operation};

1680

push @{$changes{$operation}}, $property;

1681

}

1682

}

1683

}

1684

}

1685

close DIFF;

1686

}

1687

return \%changes;

1688

}

1689

1690

sub pluralizeAndList($$@)

1691

{

1692

my ($singular, $plural, @items) = @_;

1693

1694

return if @items == 0;

1695

return "$singular $items[0]" if @items == 1;

1696

return "$plural " . join(", ", @items[0 .. $#items - 1]) . " and " . $items[-1];

1697

}

1698

1699

sub generateFileList(\%$$$)

1700

{

1701

my ($paths, $gitCommit, $gitIndex, $mergeBase) = @_;

1702

1703

my @changedFiles;

1704

my @conflictFiles;

1705

my %functionLists;

1706

my @addedRegressionTests;

1707

print STDERR " Running status to find changed, added, or removed files.\n";

1708

open STAT, "-|", statusCommand($paths, $gitCommit, $gitIndex, $mergeBase) or die "The status failed: $!.\n";

1709

while (<STAT>) {

1710

my $status;

1711

my $propertyStatus;

1712

my $propertyChanges;

1713

my $original;

1714

my $file;

1715

1716

if (isSVN()) {

1717

my $matches;

1718

if (isSVNVersion16OrNewer()) {

1719

$matches = /^([ ACDMR])([ CM]).{5} (.+?)[\r\n]*$/;

1720

$status = $1;

1721

$propertyStatus = $2;

1722

$file = $3;

1723

} else {

1724

$matches = /^([ ACDMR])([ CM]).{4} (.+?)[\r\n]*$/;

1725

$status = $1;

1726

$propertyStatus = $2;

1727

$file = $3;

1728

}

1729

if ($matches) {

1730

$file = normalizePath($file);

1731

$original = findOriginalFileFromSvn($file) if substr($_, 3, 1) eq "+";

1732

my $isAdd = isAddedStatus($status);

1733

$propertyChanges = determinePropertyChanges($file, $isAdd, $original) if isModifiedStatus($propertyStatus) || $isAdd;

1734

} else {

1735

print; # error output from svn stat

1736

}

1737

} elsif (isGit()) {

1738

if (/^([ADM])\t(.+)$/) {

1739

$status = $1;

1740

$propertyStatus = " "; # git doesn't have properties

1741

$file = normalizePath($2);

1742

} elsif (/^([CR])[0-9]{1,3}\t([^\t]+)\t([^\t\n]+)$/) { # for example: R90% newfile oldfile

1743

$status = $1;

1744

$propertyStatus = " ";

1745

$original = normalizePath($2);

1746

$file = normalizePath($3);

1747

} else {

1748

print; # error output from git diff

1749

}

1750

}

1751

1752

next if !$status || isUnmodifiedStatus($status) && isUnmodifiedStatus($propertyStatus);

1753

1754

$file = makeFilePathRelative($file);

1755

1756

if (isModifiedStatus($status) || isAddedStatus($status) || isModifiedStatus($propertyStatus)) {

1757

my @components = File::Spec->splitdir($file);

1758

if ($components[0] eq "LayoutTests") {

1759

push @addedRegressionTests, $file

1760

if isAddedStatus($status)

1761

&& $file =~ /\.([a-zA-Z]+)$/

1762

&& SupportedTestExtensions->{lc($1)}

1763

&& $file !~ /-expected(-mismatch)?\.html$/

1764

&& !scalar(grep(/^resources$/i, @components))

1765

&& !scalar(grep(/^script-tests$/i, @components));

1766

}

1767

push @changedFiles, $file if $components[$#components] ne changeLogFileName();

1768

} elsif (isConflictStatus($status, $gitCommit, $gitIndex) || isConflictStatus($propertyStatus, $gitCommit, $gitIndex)) {

1769

push @conflictFiles, $file;

1770

}

1771

if (basename($file) ne changeLogFileName()) {

1772

my $description = statusDescription($status, $propertyStatus, $original, $propertyChanges);

1773

$functionLists{$file} = $description if defined $description;

1774

}

1775

}

1776

close STAT;

1777

return (\@changedFiles, \@conflictFiles, \%functionLists, \@addedRegressionTests);

1778

}

1779

1780

sub isUnmodifiedStatus($)

1781

{

1782

my ($status) = @_;

1783

1784

my %statusCodes = (

1785

" " => 1,

1786

);

1787

1788

return $statusCodes{$status};

1789

}

1790

1791

sub isModifiedStatus($)

1792

{

1793

my ($status) = @_;

1794

1795

my %statusCodes = (

1796

"M" => 1,

1797

);

1798

1799

return $statusCodes{$status};

1800

}

1801

1802

sub isAddedStatus($)

1803

{

1804

my ($status) = @_;

1805

1806

my %statusCodes = (

1807

"A" => 1,

1808

"C" => isGit(),

1809

"R" => 1,

1810

);

1811

1812

return $statusCodes{$status};

1813

}

1814

1815

sub isConflictStatus($$$)

1816

{

1817

my ($status, $gitCommit, $gitIndex) = @_;

1818

1819

my %svn = (

1820

"C" => 1,

1821

);

1822

1823

my %git = (

1824

"U" => 1,

1825

);

1826

1827

return 0 if ($gitCommit || $gitIndex); # an existing commit or staged change cannot have conflicts

1828

return $svn{$status} if isSVN();

1829

return $git{$status} if isGit();

1830

}

1831

1832

sub statusDescription($$$$)

1833

{

1834

my ($status, $propertyStatus, $original, $propertyChanges) = @_;

1835

1836

my $propertyDescription = defined $propertyChanges ? propertyChangeDescription($propertyChanges) : "";

1837

1838

my %svn = (

1839

"A" => defined $original ? " Copied from \%s." : " Added.",

1840

"D" => " Removed.",

1841

"M" => "",

1842

"R" => defined $original ? " Replaced with \%s." : " Replaced.",

1843

" " => "",

1844

);

1845

1846

my %git = %svn;

1847

$git{"A"} = " Added.";

1848

$git{"C"} = " Copied from \%s.";

1849

$git{"R"} = " Renamed from \%s.";

1850

1851

my $description;

1852

$description = sprintf($svn{$status}, $original) if isSVN() && exists $svn{$status};

1853

$description = sprintf($git{$status}, $original) if isGit() && exists $git{$status};

1854

return unless defined $description;

1855

1856

$description .= $propertyDescription unless isAddedStatus($status);

1857

return $description;

1858

}

1859

1860

sub propertyChangeDescription($)

1861

{

1862

my ($propertyChanges) = @_;

1863

1864

my %operations = (

1865

"A" => "Added",

1866

"M" => "Modified",

1867

"D" => "Removed",

1868

"C" => "Changed",

1869

);

1870

1871

my $description = "";

1872

while (my ($operation, $properties) = each %$propertyChanges) {

1873

my $word = $operations{$operation};

1874

my $list = pluralizeAndList("property", "properties", @$properties);

1875

$description .= " $word $list.";

1876

}

1877

return $description;

1878

}

1879

1880

sub extractLineRange($)

1881

{

1882

my ($string) = @_;

1883

1884

my ($start, $end) = (-1, -1);

1885

1886

if (isSVN() && $string =~ /^\d+(,\d+)?[acd](\d+)(,(\d+))?/) {

1887

$start = $2;

1888

$end = $4 || $2;

1889

} elsif (isGit() && $string =~ /^@@ -\d+(,\d+)? \+(\d+)(,(\d+))? @@/) {

1890

$start = $2;

1891

$end = defined($4) ? $4 + $2 - 1 : $2;

1892

}

1893

1894

return ($start, $end);

1895

}

1896

1897

sub testListForChangeLog(@)

1898

{

1899

my (@tests) = @_;

1900

1901

return "" unless @tests;

1902

1903

my $leadString = " Test" . (@tests == 1 ? "" : "s") . ": ";

1904

my $list = $leadString;

1905

foreach my $i (0..$#tests) {

1906

$list .= " " x length($leadString) if $i;

1907

my $test = $tests[$i];

1908

$test =~ s/^LayoutTests\///;

1909

$list .= "$test\n";

1910

}

1911

$list .= "\n";

1912

1913

return $list;

1914

}

1915

1916

sub reviewerAndDescriptionForGitCommit($$)

1917

{

1918

my ($commit, $gitReviewer) = @_;

1919

1920

my $description = '';

1921

my $reviewer;

1922

1923

my @args = qw(rev-list --pretty);

1924

push @args, '-1' if $commit !~ m/.+\.\..+/;

1925

my $gitLog;

1926

{

1927

local $/ = undef;

1928

open(GITLOG, "-|", GIT, @args, $commit) || die;

1929

$gitLog = <GITLOG>;

1930

close(GITLOG);

1931

}

1932

1933

my @commitLogs = split(/^[Cc]ommit [a-f0-9]{40}/m, $gitLog);

1934

shift @commitLogs; # Remove initial blank commit log

1935

my $commitLogCount = 0;

1936

foreach my $commitLog (@commitLogs) {

1937

$description .= "\n" if $commitLogCount;

1938

$commitLogCount++;

1939

my $inHeader = 1;

1940

my $commitLogIndent;

1941

my @lines = split(/\n/, $commitLog);

1942

shift @lines; # Remove initial blank line

1943

foreach my $line (@lines) {

1944

if ($inHeader) {

1945

if (!$line) {

1946

$inHeader = 0;

1947

}

1948

next;

1949

} elsif ($line =~ /[Ss]igned-[Oo]ff-[Bb]y: (.+)/) {

1950

if (!$reviewer) {

1951

$reviewer = $1;

1952

} else {

1953

$reviewer .= ", " . $1;

1954

}

1955

} elsif ($line =~ /^\s*$/) {

1956

$description = $description . "\n";

1957

} else {

1958

if (!defined($commitLogIndent)) {

1959

# Let the first line with non-white space determine

1960

# the global indent.

1961

$line =~ /^(\s*)\S/;

1962

$commitLogIndent = length($1);

1963

}

1964

# Strip at most the indent to preserve relative indents.

1965

$line =~ s/^\s{0,$commitLogIndent}//;

1966

$description = $description . (" " x 8) . $line . "\n";

1967

}

1968

}

1969

}

1970

if (!$reviewer) {

1971

$reviewer = $gitReviewer;

1972

}

1973

1974

return ($reviewer, $description);

1975

}

1976

1977

sub normalizeLineEndings($$)

1978

{

1979

my ($string, $endl) = @_;

1980

$string =~ s/\r?\n/$endl/g;

1981

return $string;

1982

}

1983

1984

sub decodeEntities($)

1985

{

1986

my ($text) = @_;

1987

$text =~ s/\</</g;

1988

$text =~ s/\>/>/g;

1989

$text =~ s/\"/\"/g;

1990

$text =~ s/\'/\'/g;

1991

$text =~ s/\&/\&/g;

1992

return $text;

1993

}

Older »