build-bcd-for-firefox

#! /usr/bin/perl

use strict;
use warnings;
use Getopt::Long qw(:config bundling);
use Cwd();
use File::Spec();
use File::Find();
use JSON();
use English qw( -no_match_vars );
use Fcntl();
use FileHandle();
use File::HomeDir();
use File::Temp();
use JSON();
use Carp();
use Firefox::Marionette();

local $ENV{PATH} = '/usr/bin:/bin:/usr/sbin:/sbin';
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};

sub _BUFFER_SIZE { return 8192 }
sub _MAX_KEYS    { return 3 }

our $VERSION = '1.62';

MAIN: {
    my %options;

    Getopt::Long::GetOptions( \%options, 'help|h', 'version|v', 'path|p', );
    my $bcd_path = Firefox::Marionette::BCD_PATH(1);
    _parse_options( $bcd_path, %options );
    my ( $volume, $directories, $file ) = File::Spec->splitpath($bcd_path);
    my $firefox_marionette_directory =
      File::Spec->catdir( $volume, $directories );
    my $browser_compat_data_directory =
      File::Spec->catdir( $firefox_marionette_directory,
        'browser-compat-data' );
    _setup_git_repos($browser_compat_data_directory);
    my $summary = {};
    my $api_directory =
      File::Spec->catdir( $browser_compat_data_directory, 'api' );
    my $builtins_directory = File::Spec->catdir( $browser_compat_data_directory,
        'javascript', 'builtins' );
    my $debug   = 0;
    my $firefox = Firefox::Marionette->new( debug => $debug )->content()
      ->go('https://duckduckgo.com');
    File::Find::find(
        {
            wanted => sub {
                if ( $File::Find::name =~ /[.]json$/smx ) {
                    if ($debug) { Carp::carp("Looking at $File::Find::name\n") }
                    my $path   = $File::Find::name;
                    my $handle = FileHandle->new( $path, Fcntl::O_RDONLY() )
                      or Carp::croak(
                        "Failed to open $path for reading:$EXTENDED_OS_ERROR");
                    my $content;
                    my $result;
                    while ( $result = sysread $handle,
                        my $buffer, _BUFFER_SIZE() )
                    {
                        $content .= $buffer;
                    }
                    defined $result
                      or Carp::croak(
                        "Failed to read from $path:$EXTENDED_OS_ERROR");
                    close $handle
                      or
                      Carp::croak("Failed to close $path:$EXTENDED_OS_ERROR");
                    my $json         = JSON::decode_json($content);
                    my $root_element = _get_root_element( $json, $path );
                    foreach my $class_name (
                        sort { $a cmp $b }
                        keys %{$root_element}
                      )
                    {
                        foreach
                          my $browser (qw(firefox chrome edge safari ie opera))
                        {
                            my $class_reference =
                              $root_element->{$class_name}->{__compat}
                              ->{support}->{$browser};
                            my $mirror_reference =
                              $root_element->{$class_name}->{__compat}
                              ->{support}->{chrome};
                            my @versions = _get_versions( $class_reference,
                                $mirror_reference, $class_name );
                            foreach my $version (
                                sort {
                                    $a->{version_added} <=> $b->{version_added}
                                } @versions
                              )
                            {
                                next if ( $version->{partial_implementation} );
                                _process_version(
                                    $summary, $class_name, $browser,
                                    $version, $path
                                );
                            }
                            foreach my $function_name (
                                sort { $a cmp $b }
                                keys %{ $root_element->{$class_name} }
                              )
                            {
                                next if ( $function_name eq '__compat' );
                                next if ( $function_name eq 'worker_support' );
                                _process_function(
                                    $summary,
                                    root_element  => $root_element,
                                    class_name    => $class_name,
                                    function_name => $function_name,
                                    browser       => $browser,
                                    path          => $path
                                );
                            }
                        }
                    }
                }
            },
            follow => 1
        },
        $api_directory,
        $builtins_directory
    );
    my ( $bcd_handle, $tmp_path ) = File::Temp::tempfile(
        'firefox-marionette-bcd-XXXXXXXXXXX',
        DIR => $firefox_marionette_directory
    );
    $bcd_handle->print( JSON->new()->pretty()->encode($summary) )
      or Carp::croak("Failed to write to $tmp_path:$EXTENDED_OS_ERROR");
    $bcd_handle->close()
      or Carp::croak("Failed to close $tmp_path:$EXTENDED_OS_ERROR");
    rename $tmp_path, $bcd_path
      or
      Carp::croak("Failed to rename $tmp_path to $bcd_path:$EXTENDED_OS_ERROR");
}

sub _parse_options {
    my ( $bcd_path, %options ) = @_;
    if ( $options{help} ) {
        require Pod::Simple::Text;
        my $parser = Pod::Simple::Text->new();
        $parser->parse_from_file($PROGRAM_NAME);
        exit 0;
    }
    elsif ( $options{version} ) {
        print "$VERSION\n"
          or die "Failed to print to STDOUT:$EXTENDED_OS_ERROR\n";
        exit 0;
    }
    elsif ( $options{path} ) {
        print "$bcd_path\n"
          or die "Failed to print to STDOUT:$EXTENDED_OS_ERROR\n";
        exit 0;
    }
    return;
}

sub _setup_git_repos {
    my ($browser_compat_data_directory) = @_;
    if ( -d $browser_compat_data_directory ) {
        my $cwd = Cwd::cwd();
        chdir $browser_compat_data_directory
          or Carp::croak(
            "Failed to chdir $browser_compat_data_directory:$EXTENDED_OS_ERROR"
          );
        system {'git'} 'git', 'pull', '--quiet'
          and Carp::croak(
            "Failed to git pull from $browser_compat_data_directory\n");
        chdir $cwd or Carp::croak("Failed to chdir $cwd:$EXTENDED_OS_ERROR");
    }
    else {
        my $mdn_browser_repo = 'https://github.com/mdn/browser-compat-data.git';
        system {'git'} 'git', 'clone', $mdn_browser_repo,
          $browser_compat_data_directory
          and Carp::croak(
"Failed to git clone $mdn_browser_repo $browser_compat_data_directory\n"
          );
    }
    return;
}

sub _process_version {
    my ( $summary, $class_name, $browser, $version, $path ) = @_;
    if ( $version->{version_added} ) {
        if ( $version->{version_added} ne 'preview' ) {
            $summary->{$class_name}->{type} = 'class';
            my %extra = _get_extra_from_flags( $version, $path );
            push @{ $summary->{$class_name}->{browsers}->{$browser} },
              { add => $version->{version_added}, %extra };
        }
    }
    if ( $version->{version_removed} ) {
        push @{ $summary->{$class_name}->{browsers}->{$browser} },
          { rm => $version->{version_removed} + 0 };
    }
    return;
}

sub _process_function {
    my ( $summary, %parameters ) = @_;
    my $root_element          = $parameters{root_element};
    my $function_name         = $parameters{function_name};
    my $class_name            = $parameters{class_name};
    my $browser               = $parameters{browser};
    my $path                  = $parameters{path};
    my $cleaned_function_name = $function_name;
    my $static;

    if ( $cleaned_function_name =~ s/_static$//smx ) {
        $static = 1;
    }
    my $function_reference =
      $root_element->{$class_name}->{$function_name}->{__compat}->{support}
      ->{$browser};
    my $mirror_reference =
      $root_element->{$class_name}->{$function_name}->{__compat}->{support}
      ->{chrome};
    my @versions =
      _get_versions( $function_reference, $mirror_reference, $function_name );
    foreach my $version ( sort { $a->{version_added} <=> $b->{version_added} }
        @versions )
    {
# Example of partial_implementation to allow property to exist HTMLAnchorElement.ping
#                                    next if ( $version->{partial_implementation} );
# Example of note to allow property to exist - AudioBufferSourceNode.buffer
#                                    next if ( $version->{notes} );
        if (   ( $version->{version_added} )
            && ( $version->{version_added} ne 'preview' ) )
        {
            $summary->{"$class_name.$cleaned_function_name"}->{type} =
              'function';
            $summary->{"$class_name.$cleaned_function_name"}->{static} =
              $static ? \1 : \0;
            my %extra = _get_extra_from_flags( $version, $path );
            push @{ $summary->{"$class_name.$cleaned_function_name"}->{browsers}
                  ->{$browser} }, { add => $version->{version_added}, %extra };
        }
        if (   ( $version->{version_removed} )
            && ( $version->{version_removed} ne 'preview' ) )
        {
            push @{ $summary->{"$class_name.$cleaned_function_name"}->{browsers}
                  ->{$browser} }, { rm => $version->{version_removed} + 0 };
        }
    }
    return;
}

sub _get_extra_from_flags {
    my ( $version, $path ) = @_;
    my %extra;
    if ( $version->{flags} ) {
        foreach my $flag ( @{ $version->{flags} } ) {
            if (   ( defined $flag->{type} )
                && ( defined $flag->{name} )
                && ( defined $flag->{value_to_set} )
                && ( ( keys %{$flag} ) == _MAX_KEYS() ) )
            {
            }
            elsif (( defined $flag->{type} )
                && ( defined $flag->{name} )
                && ( !defined $flag->{value_to_set} )
                && ( ( keys %{$flag} ) == 2 ) )
            {
                next;
            }
            else {
                Carp::croak("Unknown flag for $path");
            }
            if ( $flag->{type} eq 'preference' ) {
                %extra = (
                    pref_name  => $flag->{name},
                    pref_value => $flag->{value_to_set}
                );
            }
            else {
                Carp::croak("Unknown type of '$flag->{type}' in $path");
            }
        }
    }
    return %extra;
}

sub _get_root_element {
    my ( $json, $path ) = @_;
    my $root_element;
    my @parts;
    while ( !$root_element ) {
        my $missed;
        foreach my $key ( keys %{$json} ) {
            if ( exists $json->{$key}->{__compat} ) {
                my $full_key = join q[.], @parts, $key;
                $full_key =~ s/^javascript[.]builtins[.]//smx;
                $full_key =~ s/^api[.]//smx;
                $root_element->{$full_key} = $json->{$key};
            }
            else {
                $json = $json->{$key};
                push @parts, $key;
                last;
            }
        }
        if ($root_element) {
            if ($missed) {
                Carp::croak("Failed to navigate JSON in $path for key $missed");
            }
        }
    }
    return $root_element;
}

sub _get_versions {
    my ( $object, $mirror, $name ) = @_;
    my @versions;
    if ($object) {
        if ( $object eq 'mirror' ) {
            $object = $mirror;
        }
        if ( ( ref $object ) eq 'HASH' ) {
            push @versions, _strip_version($object);
        }
        else {
            push @versions, _strip_version( @{$object} );
        }
    }
    return @versions;
}

sub _strip_version {
    my (@possible) = @_;
    my @approved;
    foreach my $version (@possible) {
        if ( $version->{version_added} ) {
            if ( $version->{version_added} eq 'preview' ) {
                next;
            }
            elsif ( $version->{version_added} =~
                s/^\x{2264}(\d+(?:[.]\d+)?)$/$1/smx )
            {
            }
        }
        push @approved, $version;
    }
    return @approved;
}

__END__
=head1 NAME

build-bcd-for-firefox - build user agent data from the @mdn/browser-compat-data repo

=head1 VERSION

Version 1.62

=head1 USAGE

  $ build-bcd-for-firefox
  $ build-bcd-for-firefox --path 

=head1 DESCRIPTION

This program is intended to build a database for the agent method of the Firefox::Marionette class.  It builds this database by cloning the L<@mdn/browser-compat-data|https://github.com/mdn/browser-compat-data> repository on github.com and then summarising this data for the agent method.

The path where the database is stored varies by user and operating system, and can be shown with the --path option.

=head1 REQUIRED ARGUMENTS

None

=head1 OPTIONS

Option names can be abbreviated to uniqueness and can be stated with singe or double dashes, and option values can be separated from the option name by a space or '=' (as with Getopt::Long). Option names are also case-
sensitive.

=over 4

=item * --help - This page.

=item * --version - Print the current version of this binary

=item * --path - Print the path of the local database that is getting built.

=back

=head1 CONFIGURATION

build-bcd-for-firefox requires no configuration files or environment variables.

=head1 DEPENDENCIES

build-bcd-for-firefox requires the following non-core Perl modules
 
=over
 
=item *
L<Pod::Simple::Text|Pod::Simple::Text>
 
=back

=head1 DIAGNOSTICS

None.

=head1 INCOMPATIBILITIES

None known.

=head1 EXIT STATUS

This program will exit with a zero after successfully completing.

=head1 BUGS AND LIMITATIONS

To report a bug, or view the current list of bugs, please visit L<https://github.com/david-dick/firefox-marionette/issues>

=head1 AUTHOR

David Dick  C<< <ddick@cpan.org> >>

=head1 LICENSE AND COPYRIGHT

Copyright (c) 2024, David Dick C<< <ddick@cpan.org> >>. All rights reserved.

This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. See L<perlartistic/perlartistic>.

=head1 DISCLAIMER OF WARRANTY

BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
NECESSARY SERVICING, REPAIR, OR CORRECTION.

IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
SUCH DAMAGES.