diff --git a/app/main.f90 b/app/main.f90 index 4bd3ac5e33..bf11e72a9e 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -11,7 +11,8 @@ program main fpm_update_settings, & fpm_clean_settings, & fpm_publish_settings, & - get_command_line_settings + get_command_line_settings, & + fpm_search_settings use fpm_error, only: error_t use fpm_filesystem, only: exists, parent_dir, join_path use fpm, only: cmd_build, cmd_run, cmd_clean @@ -20,6 +21,7 @@ program main use fpm_cmd_new, only: cmd_new use fpm_cmd_update, only : cmd_update use fpm_cmd_publish, only: cmd_publish +use fpm_cmd_search, only: cmd_search use fpm_os, only: change_directory, get_current_directory implicit none @@ -86,6 +88,8 @@ program main call cmd_update(settings) type is (fpm_clean_settings) call cmd_clean(settings) +type is (fpm_search_settings) + call cmd_search(settings) type is (fpm_publish_settings) call cmd_publish(settings) end select diff --git a/src/fpm/cmd/search.f90 b/src/fpm/cmd/search.f90 new file mode 100644 index 0000000000..68169e3fd7 --- /dev/null +++ b/src/fpm/cmd/search.f90 @@ -0,0 +1,178 @@ +!> Search a package from both local and remote registry using the `search` subcommand. +!> The package can be searched by packagename, namespace, query (description and README.md), and license from the registries (local and remote). +!> the remote registry URL can also be specified by the paramter --registry. +!> It can be used as `fpm search --query q* --page 1 --registry URL --namespace n* --package p* --package_version v* --license l* --limit 10 --sort-by [name] --sort [asc/desc]` +module fpm_cmd_search + use fpm_command_line, only: fpm_search_settings + use fpm_manifest, only: package_config_t, get_package_data + use fpm_model, only: fpm_model_t + use fpm_error, only: error_t, fpm_stop + use fpm_versioning, only: version_t + use fpm_filesystem, only: exists, join_path, get_temp_filename, delete_file, basename, & + canon_path, dirname, list_files, is_hidden_file + use fpm_git, only: git_archive + use fpm_downloader, only: downloader_t + use fpm_strings, only: string_t, string_array_contains, split, str,glob + use fpm, only: build_model + use fpm_error, only : error_t, fatal_error, fpm_stop + use jonquil, only : json_object + use tomlf, only : toml_array, get_value, len, toml_key, toml_loads, toml_table, & + toml_serializer,toml_value + use tomlf_utils_io, only : read_whole_file + use fpm_settings, only: fpm_global_settings, get_global_settings, official_registry_base_url + + implicit none + private + public :: cmd_search + + contains + + !> Search the fpm registry for a package + subroutine cmd_search(settings) + !> Settings for the search command. + class(fpm_search_settings), intent(in) :: settings + type(fpm_global_settings) :: global_settings + character(:), allocatable :: tmp_file, name, namespace, description, query_url, package_version + integer :: stat, unit, ii + type(json_object) :: json + type(json_object), pointer :: p + !> Error handling. + type(error_t), allocatable :: error + type(toml_array), pointer :: array + type(version_t), allocatable :: version + + !> Downloader instance. + class(downloader_t), allocatable :: downloader + allocate (downloader) + + call get_global_settings(global_settings, error) + if (allocated(error)) then + call fpm_stop(1, "Error retrieving global settings"); return + end if + + !> Generate a temporary file to store the downloaded package search data + tmp_file = get_temp_filename() + open (newunit=unit, file=tmp_file, action='readwrite', iostat=stat) + if (stat /= 0) then + call fatal_error(error, "Error creating temporary file for downloading package."); return + end if + query_url = settings%registry//'/packages_cli' & + & // '?query='//settings%query & + & // '&page='//settings%page & + & // '&package='//settings%package & + & // '&namespace='//settings%namespace & + & // '&version='//settings%version & + & // '&license='//settings%license & + & // '&limit='//settings%limit & + & // '&sort_by='//settings%sort_by & + & // '&sort='//settings%sort + + !> Get the package data from the registry + call downloader%get_pkg_data(query_url, version, tmp_file, json, error) + close (unit) + if (allocated(error)) then + call fpm_stop(1, "Error retrieving package data from registry: "//settings%registry); return + end if + print * + print *, "Searching packages in Local Registry:" + print * + call search_package(settings%query, settings%namespace, settings%package, settings%version) + if (json%has_key("packages")) then + call get_value(json, 'packages', array) + print * + print '(A,I0,A)', ' Found ', len(array), ' packages in fpm - registry:' + print * + do ii=1, len(array) + call get_value(array, ii, p) + call get_value(p, 'name', name) + call get_value(p, 'namespace', namespace) + call get_value(p, 'description', description) + call get_value(p, 'version', package_version) + + print *, "Name: ", name + print *, "namespace: ", namespace + print *, "Description: ", description + print *, "version: ", package_version + print * + end do + else + call fpm_stop(1, "Invalid package data returned"); return + end if + end subroutine cmd_search + + subroutine search_package(query,namespace,package,version) + type(fpm_global_settings) :: global_settings + type(error_t), allocatable :: error + character(:), allocatable, intent(in) :: namespace, package, version, query + character(:), allocatable :: path, array(:), versioncheck(:), toml_package_data, print_package(:) + character(:), allocatable :: description, wild + type(string_t), allocatable :: file_names(:) + type(toml_table), allocatable :: table + integer :: i, j, unit, stat + logical :: result + + call get_global_settings(global_settings, error) + if (allocated(error)) then + call fpm_stop(1, "Error retrieving global settings"); return + end if + + path = global_settings%registry_settings%cache_path + + ! Scan directory for packages + call list_files(path, file_names,recurse=.true.) + do i=1,size(file_names) + result = package_search_wild(namespace,package,version,file_names(i)%s) + call split(file_names(i)%s,array,'/') + if (result) then + !> query search for description + call read_whole_file(file_names(i)%s, toml_package_data, stat) + if (stat /= 0) then + call fatal_error(error, "Error reading file: "//file_names(i)%s); return + end if + ! Load TOML data into a table + call toml_loads(table,toml_package_data) + if (allocated(error)) then + call fpm_stop(1, "Error loading toml file"); return + end if + + if (allocated(table)) then + call get_value(table, 'description', description) + if (query /="") then + result = glob(description,query) + if (result) call print_package_data(array,description) + else + call print_package_data(array,description) + end if + else + call fpm_stop(1, "Error Searching for the query"); return + end if + endif + end do + end subroutine search_package + + function package_search_wild(namespace,package,version, file_name) result(result) + character(:), allocatable, intent(in) :: namespace, package, version, file_name + character(:), allocatable :: array(:), versioncheck(:) + logical :: result + + call split(file_name,array,'/') + call split(array(size(array)-1),versioncheck,'.') + result = array(size(array)) == "fpm.toml" + result = result .and. glob(array(size(array)-3),namespace) + result = result .and. glob(array(size(array)-2),package) + result = result .and. glob(array(size(array)-1),version) + result = result .and. size(versioncheck) > 2 + end function package_search_wild + + subroutine print_package_data(package_array,description) + character(:), allocatable, intent(in) :: package_array(:) + character(*), intent(in) :: description + + print *, "Name: ", package_array(size(package_array)-2) + print *, "Namespace: ", package_array(size(package_array)-3) + print *, "Version: ", package_array(size(package_array)-1) + print *, "Description: ", description + print * + end subroutine print_package_data + end + \ No newline at end of file diff --git a/src/fpm/downloader.f90 b/src/fpm/downloader.f90 index 39a3314ccf..45b7bc24c2 100644 --- a/src/fpm/downloader.f90 +++ b/src/fpm/downloader.f90 @@ -62,10 +62,10 @@ subroutine get_file(url, tmp_pkg_file, error) if (which('curl') /= '') then print *, "Downloading '"//url//"' -> '"//tmp_pkg_file//"'" - call execute_command_line('curl '//url//' -s -o '//tmp_pkg_file, exitstat=stat) + call execute_command_line('curl "'//url//'" -s -o '//tmp_pkg_file, exitstat=stat) else if (which('wget') /= '') then print *, "Downloading '"//url//"' -> '"//tmp_pkg_file//"'" - call execute_command_line('wget '//url//' -q -O '//tmp_pkg_file, exitstat=stat) + call execute_command_line('wget "'//url//'" -q -O '//tmp_pkg_file, exitstat=stat) else call fatal_error(error, "Neither 'curl' nor 'wget' installed."); return end if diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index b5655437ec..23a7429812 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -32,6 +32,7 @@ module fpm_command_line string_t, glob use fpm_filesystem, only : basename, canon_path, which, run use fpm_environment, only : get_command_arguments_quoted +use fpm_settings, only : official_registry_base_url use fpm_error, only : fpm_stop, error_t use fpm_os, only : get_current_directory use fpm_release, only : fpm_version, version_t @@ -53,6 +54,7 @@ module fpm_command_line fpm_clean_settings, & fpm_publish_settings, & get_command_line_settings, & + fpm_search_settings, & get_fpm_env type, abstract :: fpm_cmd_settings @@ -133,6 +135,20 @@ module fpm_command_line logical :: registry_cache = .false. end type +!> Settings for searching for packages in local and remote registries +type, extends(fpm_cmd_settings) :: fpm_search_settings + character(len=:),allocatable :: query !> search for packages with a specific query (globbing supported) + character(len=:),allocatable :: page !> return in a specific page of results of remote registry (default: 1) + character(len=:),allocatable :: registry !> search in a specific registry (default: official registry), stores the URL of the registry + character(len=:),allocatable :: namespace !> search for packages with a specific namespace (globbing supported) + character(len=:),allocatable :: package !> search for packages with a specific name (globbing supported) + character(len=:),allocatable :: version !> search for packages with version (globbing supported) + character(len=:),allocatable :: license !> search for packages with a specific license (globbing supported) + character(len=:),allocatable :: limit !> limit the number of results returned (default: 10). + character(len=:),allocatable :: sort_by !> sort the results by name, author, createdat, updatedat, downloads (default: name) + character(len=:),allocatable :: sort !> sort the results in ascending or descending (asc or desc) order (default: asc). +end type + type, extends(fpm_build_settings) :: fpm_publish_settings logical :: show_package_version = .false. logical :: show_upload_data = .false. @@ -150,9 +166,9 @@ module fpm_command_line & help_test(:), help_build(:), help_usage(:), help_runner(:), & & help_text(:), help_install(:), help_help(:), help_update(:), & & help_list(:), help_list_dash(:), help_list_nodash(:), & - & help_clean(:), help_publish(:) + & help_clean(:), help_publish(:), help_search(:) character(len=20),parameter :: manual(*)=[ character(len=20) ::& -& ' ', 'fpm', 'new', 'build', 'run', 'clean', & +& ' ', 'fpm', 'new', 'build', 'run', 'clean', 'search', & & 'test', 'runner', 'install', 'update', 'list', 'help', 'version', 'publish' ] character(len=:), allocatable :: val_runner, val_compiler, val_flag, val_cflag, val_cxxflag, val_ldflag, & @@ -239,7 +255,8 @@ subroutine get_command_line_settings(cmd_settings) type(fpm_export_settings) , allocatable :: export_settings type(version_t) :: version character(len=:), allocatable :: common_args, compiler_args, run_args, working_dir, & - & c_compiler, cxx_compiler, archiver, version_s, token_s + & c_compiler, cxx_compiler, archiver, version_s, token_s, query, page, registry, & + & namespace, license, package, package_version, limit, sort_by, sort character(len=*), parameter :: fc_env = "FC", cc_env = "CC", ar_env = "AR", & & fflags_env = "FFLAGS", cflags_env = "CFLAGS", cxxflags_env = "CXXFLAGS", ldflags_env = "LDFLAGS", & @@ -520,6 +537,8 @@ subroutine get_command_line_settings(cmd_settings) help_text=[character(len=widest) :: help_text, version_text] case('clean' ) help_text=[character(len=widest) :: help_text, help_clean] + case('search' ) + help_text=[character(len=widest) :: help_text, help_search] case('publish') help_text=[character(len=widest) :: help_text, help_publish] case default @@ -702,6 +721,56 @@ subroutine get_command_line_settings(cmd_settings) & clean_all=clean_all) end block + case('search') + call set_args(common_args //'& + & --query " " & + & --page " " & + & --registry " " & + & --namespace " " & + & --package " " & + & --package_version " " & + & --license " " & + & --limit " " & + & --sort-by " " & + & --sort " " & + & --', help_search, version_text) + + query = sget('query') + namespace = sget('namespace') + package = sget('package') + package_version = sget('package_version') + license = sget('license') + registry = sget('registry') + page = sget('page') + limit = sget('limit') + sort_by = sget('sort-by') + sort = sget('sort') + + block + + if (query==' ') query='' + if (page==' ') page='1' + if (package==' ') package='*' + if (license==' ') license='' + if (sort_by==' ') sort_by='name' + if (sort==' ') sort='asc' + if (limit==' ') limit='10' + if (namespace==' ') namespace='*' + if (package_version==' ') package_version='*' + if (.not. registry=='') then + print *, 'Using custom registry for seaching packages: ', registry + registry = trim(adjustl(registry)) + else + registry = official_registry_base_url + end if + allocate(fpm_search_settings :: cmd_settings) + cmd_settings = fpm_search_settings( & + & query=query, page=page, registry=registry, & + & namespace=namespace, package=package, version=package_version, & + & license=license, limit=limit, sort_by=sort_by, & + & sort=sort) + end block + case('publish') call set_args(common_args // compiler_args //'& & --show-package-version F & @@ -721,6 +790,7 @@ subroutine get_command_line_settings(cmd_settings) token_s = sget('token') allocate(fpm_publish_settings :: cmd_settings) + cmd_settings = fpm_publish_settings( & & show_package_version = lget('show-package-version'), & & show_upload_data = lget('show-upload-data'), & @@ -784,7 +854,6 @@ subroutine check_build_vals() val_cxxflag = " "// sget('cxx-flag') val_ldflag = " " // sget('link-flag') val_profile = sget('profile') - end subroutine check_build_vals !> Print help text and stop @@ -820,6 +889,7 @@ subroutine set_help() ' update Update and manage project dependencies ', & ' install Install project ', & ' clean Delete the build ', & + ' search Search for the packages in local registry and fpm-registry ', & ' publish Publish package to the registry ', & ' ', & ' Enter "fpm --list" for a brief list of subcommand options. Enter ', & @@ -841,6 +911,9 @@ subroutine set_help() ' install [--profile PROF] [--flag FFLAGS] [--no-rebuild] [--prefix PATH] ', & ' [options] ', & ' clean [--skip] [--all] [--registry-cache] ', & + ' search [--query query] [--page page] [--registry URL] [--namespace namespace] ', & + ' [--package package] [--package_version version] [--license license] ', & + ' [--limit <10>] [--sort-by ] [--sort ] ', & ' publish [--token TOKEN] [--show-package-version] [--show-upload-data] ', & ' [--dry-run] [--verbose] ', & ' '] @@ -951,6 +1024,7 @@ subroutine set_help() ' + install Install project. ', & ' + clean Delete directories in the "build/" directory, except ', & ' dependencies. Prompts for confirmation to delete. ', & + ' + search Search for packages in local and fpm-registry ', & ' + publish Publish package to the registry. ', & ' ', & ' Their syntax is ', & @@ -970,6 +1044,9 @@ subroutine set_help() ' install [--profile PROF] [--flag FFLAGS] [--no-rebuild] [--prefix PATH] ', & ' [options] ', & ' clean [--skip] [--all] [--registry-cache] ', & + ' search [--query query] [--page page] [--registry URL] [--namespace namespace] ', & + ' [--package package] [--package_version version] [--license license] ', & + ' [--limit <10>] [--sort-by ] [--sort ] ', & ' publish [--token TOKEN] [--show-package-version] [--show-upload-data] ', & ' [--dry-run] [--verbose] ', & ' ', & @@ -1041,6 +1118,7 @@ subroutine set_help() ' fpm run myprogram --profile release -- -x 10 -y 20 --title "my title" ', & ' fpm install --prefix ~/.local ', & ' fpm clean --all ', & + ' fpm search --query fortran --page 2 ', & ' ', & 'SEE ALSO ', & ' ', & @@ -1460,6 +1538,32 @@ subroutine set_help() ' --all Delete the build without prompting including dependencies.', & ' --registry-cache Delete registry cache.', & '' ] + help_search=[character(len=80) :: & + 'NAME', & + ' search(1) - search for the package in local and fpm - registry.', & + '', & + 'SYNOPSIS', & + ' fpm search', & + '', & + 'DESCRIPTION', & + ' Search for packages in the local directory and the fpm-registry, ', & + ' supports package search by name, namespace, query (description and README.md)', & + ' and license from the registries (local and remote).', & + '', & + 'OPTIONS', & + ' --query Search for any term, can be used for searching across parameters like:', & + ' name, namespace, description, and license, version, keywords, ', & + ' README, maintainer, author. (supports globbing)', & + ' --page Page number for results.', & + ' --registry URL of the registry to query.', & + ' --namespace Namespace of the package', & + ' --package Package name to filter results.', & + ' --package_version Version of the package', & + ' --license License type to filter results.', & + ' --limit Maximum number of results to return.', & + ' --sort-by Field to sort results by (e.g., name).', & + ' --sort Sort order (asc for ascending, desc for descending).', & + '' ] help_publish=[character(len=80) :: & 'NAME', & ' publish(1) - publish package to the registry', & @@ -1473,7 +1577,7 @@ subroutine set_help() 'DESCRIPTION', & ' Follow the steps to create a tarball and upload a package to the registry:', & '', & - ' 1. Register on the website (https://registry-phi.vercel.app/).', & + ' 1. Register on the website (TODO: registry url).', & ' 2. Create a namespace. Uploaded packages must be assigned to a unique', & ' namespace to avoid conflicts among packages with similar names. A', & ' namespace can accommodate multiple packages.', & diff --git a/test/help_test/help_test.f90 b/test/help_test/help_test.f90 index 8112b81a37..b0745eaf0b 100644 --- a/test/help_test/help_test.f90 +++ b/test/help_test/help_test.f90 @@ -34,6 +34,7 @@ program help_test 'help list >> fpm_scratch_help.txt',& 'help help >> fpm_scratch_help.txt',& 'help clean >> fpm_scratch_help.txt',& +'help search >> fpm_scratch_help.txt',& 'help publish >> fpm_scratch_help.txt',& '--version >> fpm_scratch_help.txt',& ! generate manual @@ -43,7 +44,7 @@ program help_test !'fpm run -- --list >> fpm_scratch_help.txt',& !'fpm run -- list --list >> fpm_scratch_help.txt',& character(len=*),parameter :: names(*)=[character(len=10) ::& - 'fpm','new','update','build','run','test','runner','install','list','help','clean'] + 'fpm','new','update','build','run','test','runner','install','list','help','clean','search'] character(len=:), allocatable :: prog integer :: length