diff --git a/.github/ISSUE_TEMPLATE/bug_report.md b/.github/ISSUE_TEMPLATE/bug_report.md new file mode 100644 index 00000000000..8b25568b09c --- /dev/null +++ b/.github/ISSUE_TEMPLATE/bug_report.md @@ -0,0 +1,34 @@ +--- +name: Bug report +about: Report a bug report to improve the quality of LMS. +title: '' +labels: bug +assignees: '' + +--- + +**Describe the bug** +A clear and concise description of what the bug is. If you're unsure about the nature of your request, please use [forums.lyrion.org](https://forums.lyrion.org) instead. You'll get better and faster responses there. Thanks! + +**To Reproduce** +Steps to reproduce the behavior: +1. Go to '...' +2. Click on '....' +3. Scroll down to '....' +4. See error + +**Expected behavior** +A clear and concise description of what you expected to happen. + +**Screenshots** +If applicable, add screenshots to help explain your problem. + +**System Information (please complete the following information):** + - OS on which you're running LMS: [e.g. pCP 10] + - Web skin used: [e.g. Material, Default] + - Browser [e.g. chrome, safari] + - LMS Version [e.g. 22] + - Player(s) involved + +**Additional context** +Add any other context about the problem here. E.g. a `server.log` or `scanner.log` snippet (see Settings/Information in your LMS) diff --git a/.github/ISSUE_TEMPLATE/config.yml b/.github/ISSUE_TEMPLATE/config.yml new file mode 100644 index 00000000000..4beccd30a54 --- /dev/null +++ b/.github/ISSUE_TEMPLATE/config.yml @@ -0,0 +1,5 @@ +blank_issues_enabled: true +contact_links: + - name: Lyrion Community Forum + url: https://forums.lyrion.org + about: 👉🏼 Please ask and answer questions here. You'll get faster and better help. diff --git a/.github/actions/build/action.yaml b/.github/actions/build/action.yaml index 57767b6bd7a..30526f8ea15 100644 --- a/.github/actions/build/action.yaml +++ b/.github/actions/build/action.yaml @@ -22,9 +22,9 @@ runs: id: getversion run: | echo "::group::Get LMS version number" - MAJOR=$(grep "\$VERSION" server/slimserver.pl | head -n1 | cut -d"'" -f2 | cut -d. -f1) - MINOR=$(grep "\$VERSION" server/slimserver.pl | head -n1 | cut -d"'" -f2 | cut -d. -f2) - PATCH=$(grep "\$VERSION" server/slimserver.pl | head -n1 | cut -d"'" -f2 | cut -d. -f3) + MAJOR=$(grep "our \$VERSION" -m1 server/slimserver.pl | cut -d"'" -f2 | cut -d. -f1) + MINOR=$(grep "our \$VERSION" -m1 server/slimserver.pl | cut -d"'" -f2 | cut -d. -f2) + PATCH=$(grep "our \$VERSION" -m1 server/slimserver.pl | cut -d"'" -f2 | cut -d. -f3) echo "LMS_VERSION=$MAJOR.$MINOR" >> $GITHUB_OUTPUT echo "LMS_FULL_VERSION=$MAJOR.$MINOR.$PATCH" >> $GITHUB_OUTPUT @@ -40,6 +40,14 @@ runs: ref: ${{ steps.getversion.outputs.GIT_BRANCH }} + - name: Check out pCP platform code + if: ${{ startsWith(inputs.build-params, 'pcp') }} + uses: actions/checkout@v4 + with: + repository: picoreplayer/lms-update-script + path: platforms/pcp + + - name: Set up Docker environment if: ${{ startsWith(inputs.build-params, 'docker') }} id: dockersetup @@ -49,9 +57,9 @@ runs: if [ "${{ inputs.build-type }}" = "release" ]; then echo "LMS_TAG=--tag=rc" >> $GITHUB_OUTPUT elif [ "${{ steps.getversion.outputs.LMS_VERSION }}" = "9.1" ]; then - echo "LMS_TAG=--tag=dev" >> $GITHUB_OUTPUT + echo "LMS_TAG=--tag=dev,${{ steps.getversion.outputs.LMS_FULL_VERSION }}-dev" >> $GITHUB_OUTPUT elif [ "${{ steps.getversion.outputs.LMS_VERSION }}" = "9.0" ]; then - echo "LMS_TAG=--tag=stable" >> $GITHUB_OUTPUT + echo "LMS_TAG=--tag=stable,${{ steps.getversion.outputs.LMS_FULL_VERSION }}-stable" >> $GITHUB_OUTPUT else echo "UNKNOWN DOCKER TARGET TAG" exit 1 @@ -114,6 +122,8 @@ runs: - name: Set-up s5cmd if: ${{ !startsWith(inputs.build-params, 'docker') }} + # don't fail, as we can fall back to aws-cli + continue-on-error: true uses: ./server/.github/actions/setup-s5cmd # uses: peak/action-setup-s5cmd@main with: diff --git a/.github/workflows/00_build.yaml b/.github/workflows/00_build.yaml index 2cce9ea9290..b3c90b071e0 100644 --- a/.github/workflows/00_build.yaml +++ b/.github/workflows/00_build.yaml @@ -22,7 +22,7 @@ on: jobs: mac: - name: Build LMS for Mac (MenuBar Item) + name: Build LMS for Mac runs-on: macos-13 env: BUILD_CERTIFICATE_BASE64: ${{ secrets.BUILD_CERTIFICATE_BASE64 }} @@ -85,6 +85,7 @@ jobs: - [tarball, ""] - [tarball, "--encore"] - [tarball, "--noCPAN"] + - [pcp, ""] steps: # we must check out here, as otherwise the build action is not available @@ -95,10 +96,10 @@ jobs: ref: ${{ inputs.branch }} - name: Prepare build environment - if: ${{ matrix.flavour[0] != 'tarball' }} + if: ${{ matrix.flavour[0] != 'tarball' && matrix.flavour[0] != 'pcp' }} run: | sudo apt update - sudo apt install apt-transport-https debhelper devscripts + sudo apt install -y apt-transport-https debhelper devscripts - name: Launch build process uses: ./server/.github/actions/build @@ -169,3 +170,28 @@ jobs: - env: GH_TOKEN: ${{ secrets.DEPLOYMENT_KEY }} run: gh workflow run update-server-repository.yml -R https://github.com/LMS-Community/lms-server-repository + + tagRelease: + name: Tag the current release + if: ${{ success() && inputs.build_type == 'release' && github.repository_owner == 'LMS-Community' }} + runs-on: ubuntu-latest + needs: + - updateRepoFile + permissions: + actions: write + contents: write + steps: + # no easy way to avoid another checkout? + - name: Check out LMS code + uses: actions/checkout@v4 + with: + path: server + ref: ${{ inputs.branch }} + - name: Tag that thang + run: | + cd server + VERSION=$(grep "our \$VERSION" -m1 slimserver.pl | cut -d"'" -f2) + git config user.name "LMS Server Repository Updater" + git config user.email "gitmaster@lms-community.org" + git tag -a -m -f "$VERSION" + git push origin refs/tags/$VERSION \ No newline at end of file diff --git a/.github/workflows/00_cron.yaml b/.github/workflows/00_cron.yaml index 23e77875917..ffee3791ecf 100644 --- a/.github/workflows/00_cron.yaml +++ b/.github/workflows/00_cron.yaml @@ -2,7 +2,7 @@ name: Build LMS Scheduler on: workflow_dispatch: schedule: - - cron: '40 2 * * *' + - cron: '40 2,3,4 * * *' jobs: check: @@ -13,18 +13,23 @@ jobs: - uses: actions/github-script@v7 with: script: | - const repoStatus = await github.request('GET https://lms-community.github.io/lms-server-repository/servers.json'); + const repoStatus = await github.request('GET https://raw.githubusercontent.com/LMS-Community/lms-server-repository/refs/heads/master/servers.json'); if (repoStatus.status !== 200) { + console.error("Fetching repo file failed?" + JSON.stringify(repoStatus, null, 2)); return false; } // get the oldest timestamp for each version from previous builds const candidates = []; - Object.keys(repoStatus.data).forEach(version => { + const repoData = JSON.parse(repoStatus.data); + + Object.keys(repoData).sort((a, b) => { + return 0.5 - Math.random(); + }).forEach(version => { const matches = version.match(/(\d+\.\d+)\.\d+/); if (matches && matches.length == 2) { - const versionBuilds = repoStatus.data[version]; + const versionBuilds = repoData[version]; candidates.push({ v: matches[1], r: Object.keys(versionBuilds).reduce((accumulator, build) => { @@ -35,16 +40,11 @@ jobs: }) } else { - delete repoStatus.data[version]; + delete repoData[version]; } }); - const sleep = (s) => { - return new Promise(resolve => setTimeout(resolve, s * 1000)); - } - // for each version see whether there's a more recent commit than the revision of the previous build - let buildsRunning = 0; for (let i = 0; i < candidates.length; i++) { const latestBuildTimestamp = candidates[i].r * 1000; @@ -68,24 +68,23 @@ jobs: if (needsBuild) { console.log(`${candidates[i].v}: needs a build (${new Date(needsBuild.commit.committer.date).getTime()} > ${latestBuildTimestamp})`); - if (buildsRunning > 0) { - console.log('Delaying build as there is already a build running'); - // wait about Xs per build - await sleep(buildsRunning * 90); - } - const workflowStatus = await github.rest.actions.createWorkflowDispatch({ owner: context.repo.owner, repo: context.repo.repo, workflow_id: '00_build.yaml', ref: 'public/' + candidates[i].v, + inputs: { + branch: 'public/' + candidates[i].v, + build_type: 'nightly', + }, }); if (workflowStatus.status < 200 || workflowStatus.status > 204) { console.log(workflowStatus); } - buildsRunning++; + // we only want to run one build at a time - we'll re run the check in a bit + break; } else { console.log(`${candidates[i].v}: is up to date (${candidates[i].r})`); diff --git a/Bin/MSWin32-x86-multi-thread/faad.exe b/Bin/MSWin32-x86-multi-thread/faad.exe deleted file mode 100755 index 9f3e6ffb776..00000000000 Binary files a/Bin/MSWin32-x86-multi-thread/faad.exe and /dev/null differ diff --git a/Bin/MSWin32-x86-multi-thread/flac.exe b/Bin/MSWin32-x86-multi-thread/flac.exe deleted file mode 100755 index a581348df21..00000000000 Binary files a/Bin/MSWin32-x86-multi-thread/flac.exe and /dev/null differ diff --git a/Bin/MSWin32-x86-multi-thread/grant.exe b/Bin/MSWin32-x86-multi-thread/grant.exe deleted file mode 100644 index 55e32870fec..00000000000 Binary files a/Bin/MSWin32-x86-multi-thread/grant.exe and /dev/null differ diff --git a/Bin/MSWin32-x86-multi-thread/mac.exe b/Bin/MSWin32-x86-multi-thread/mac.exe deleted file mode 100755 index d30a1ee6e26..00000000000 Binary files a/Bin/MSWin32-x86-multi-thread/mac.exe and /dev/null differ diff --git a/Bin/MSWin32-x86-multi-thread/mppdec.exe b/Bin/MSWin32-x86-multi-thread/mppdec.exe deleted file mode 100755 index 5ec045d1c86..00000000000 Binary files a/Bin/MSWin32-x86-multi-thread/mppdec.exe and /dev/null differ diff --git a/Bin/MSWin32-x86-multi-thread/sls.exe b/Bin/MSWin32-x86-multi-thread/sls.exe deleted file mode 100755 index 2f74c77f3bc..00000000000 Binary files a/Bin/MSWin32-x86-multi-thread/sls.exe and /dev/null differ diff --git a/Bin/MSWin32-x86-multi-thread/socketwrapper.exe b/Bin/MSWin32-x86-multi-thread/socketwrapper.exe deleted file mode 100755 index 46759fdca47..00000000000 Binary files a/Bin/MSWin32-x86-multi-thread/socketwrapper.exe and /dev/null differ diff --git a/Bin/MSWin32-x86-multi-thread/sox.exe b/Bin/MSWin32-x86-multi-thread/sox.exe deleted file mode 100755 index 689eb35c30e..00000000000 Binary files a/Bin/MSWin32-x86-multi-thread/sox.exe and /dev/null differ diff --git a/Bin/MSWin32-x86-multi-thread/wmadec.exe b/Bin/MSWin32-x86-multi-thread/wmadec.exe deleted file mode 100755 index c6cdf07b3da..00000000000 Binary files a/Bin/MSWin32-x86-multi-thread/wmadec.exe and /dev/null differ diff --git a/Bin/MSWin32-x86-multi-thread/wvunpack.exe b/Bin/MSWin32-x86-multi-thread/wvunpack.exe deleted file mode 100644 index 1e49a992ae1..00000000000 Binary files a/Bin/MSWin32-x86-multi-thread/wvunpack.exe and /dev/null differ diff --git a/CPAN/Protocol/WebSocket.pm b/CPAN/Protocol/WebSocket.pm new file mode 100644 index 00000000000..b01a61accd4 --- /dev/null +++ b/CPAN/Protocol/WebSocket.pm @@ -0,0 +1,158 @@ +package Protocol::WebSocket; + +use strict; +use warnings; + +our $VERSION = '0.26'; + +use Protocol::WebSocket::Frame; +use Protocol::WebSocket::Handshake::Client; +use Protocol::WebSocket::Handshake::Server; +use Protocol::WebSocket::URL; + +1; +__END__ + +=encoding UTF-8 + +=head1 NAME + +Protocol::WebSocket - WebSocket protocol + +=head1 SYNOPSIS + + # Server side + my $hs = Protocol::WebSocket::Handshake::Server->new; + + $hs->parse('some data from the client'); + + $hs->is_done; # tells us when handshake is done + + my $frame = $hs->build_frame; + + $frame->append('some data from the client'); + + while (defined(my $message = $frame->next)) { + if ($frame->is_close) { + + # Send close frame back + send( + $hs->build_frame( + type => 'close', + version => $version + )->to_bytes + ); + + return; + } + + # We got a message! + } + +=head1 DESCRIPTION + +Client/server WebSocket message and frame parser/constructor. This module does +not provide a WebSocket server or client, but is made for using in http servers +or clients to provide WebSocket support. + +L supports the following WebSocket protocol versions: + + draft-ietf-hybi-17 (latest) + draft-ietf-hybi-10 + draft-ietf-hybi-00 (with HAProxy support) + draft-hixie-75 + +By default the latest version is used. The WebSocket version is detected +automatically on the server side. On the client side you have set a C +attribute to an appropriate value. + +L itself does not contain any code and cannot be used +directly. Instead the following modules should be used: + +=head2 High-level modules + +=head3 L + +Server helper class. + +=head3 L + +Client helper class. + +=head2 Low-level modules + +=head3 L + +Server handshake parser and constructor. + +=head3 L + +Client handshake parser and constructor. + +=head3 L + +WebSocket frame parser and constructor. + +=head3 L + +Low level WebSocket request parser and constructor. + +=head3 L + +Low level WebSocket response parser and constructor. + +=head3 L + +Low level WebSocket url parser and constructor. + +=head1 EXAMPLES + +For examples on how to use L with various event loops see +C directory in the distribution. + +=head1 CREDITS + +In order of appearance: + +Paul "LeoNerd" Evans + +Jon Gentle + +Lee Aylward + +Chia-liang Kao + +Atomer Ju + +Chuck Bredestege + +Matthew Lien (BlueT) + +Joao Orui + +Toshio Ito (debug-ito) + +Neil Bowers + +Michal Špaček + +Graham Ollis + +Anton Petrusevich + +Eric Wastl + +Greg Kennedy + +=head1 AUTHOR + +Viacheslav Tykhanovskyi, C. + +=head1 COPYRIGHT + +Copyright (C) 2010-2018, Viacheslav Tykhanovskyi. + +This program is free software, you can redistribute it and/or modify it under +the same terms as Perl 5.10. + +=cut diff --git a/CPAN/Protocol/WebSocket/Client.pm b/CPAN/Protocol/WebSocket/Client.pm new file mode 100644 index 00000000000..10732b265af --- /dev/null +++ b/CPAN/Protocol/WebSocket/Client.pm @@ -0,0 +1,509 @@ +package Protocol::WebSocket::Client; + +use strict; +use warnings; + +require Carp; +use Protocol::WebSocket::URL; +use Protocol::WebSocket::Handshake::Client; +use Protocol::WebSocket::Frame; + +sub new { + my $class = shift; + $class = ref $class if ref $class; + my (%params) = @_; + + my $self = {}; + bless $self, $class; + + Carp::croak('url is required') unless $params{url}; + $self->{url} = Protocol::WebSocket::URL->new->parse($params{url}) + or Carp::croak("Can't parse url"); + + $self->{version} = $params{version}; + + # User callbacks. Only write and read are mandatory. + $self->{on_write} = $params{on_write}; + $self->{on_read} = $params{on_read}; + + # Additional callbacks for other WS events + $self->{on_connect} = $params{on_connect}; + $self->{on_eof} = $params{on_eof}; + $self->{on_error} = $params{on_error}; + $self->{on_pong} = $params{on_pong}; + + # register auto-pong by default + if (exists $params{on_ping}) { + $self->{on_ping} = $params{on_ping}; + } else { + $self->{on_ping} = \&pong; + } + + $self->{hs} = + Protocol::WebSocket::Handshake::Client->new(url => $self->{url}); + + # optional parameters for the frame buffer + my %frame_buffer_params; + $frame_buffer_params{max_fragments_amount} = $params{max_fragments_amount} if exists $params{max_fragments_amount}; + $frame_buffer_params{max_payload_size} = $params{max_payload_size} if exists $params{max_payload_size}; + + $self->{frame_buffer} = $self->_build_frame(%frame_buffer_params); + + # Flag indicating current state + # 0 = not connected yet, + # 1 = ready, + # -1 = connection closed. + $self->{state} = 0; + + return $self; +} + +# function stubs around member vars +sub url { shift->{url} } +sub version { shift->{version} } +sub is_ready { shift->{state} > 0 } + +# register callbacks after construction +sub on { + my $self = shift; + my (%handlers) = @_; + + foreach my $event (keys %handlers) + { + $self->{"on_$event"} = $handlers{$event}; + } + + return $self; +} + +sub read { + my $self = shift; + my ($buffer) = @_; + + my $hs = $self->{hs}; + my $frame_buffer = $self->{frame_buffer}; + + # handshake is always the beginning of the WS process + unless ($hs->is_done) { + if (!$hs->parse($buffer)) { + $self->{on_error}->($self, $hs->error); + return $self; + } + + if ($hs->is_done) { + $self->{state} = 1; + $self->{on_connect}->($self) if $self->{on_connect}; + } + } + + # handshake has been completed, this is user-mode now + if ($hs->is_done) { + $frame_buffer->append($buffer); + + while (defined (my $bytes = $frame_buffer->next)) { + if ($frame_buffer->is_close) { + # Remote WebSocket close (TCP socket may stay open for a bit) + $self->disconnect if ($self->is_ready); + # TODO: see message in disconnect() about error code / reason + $self->{on_eof}->($self) if $self->{on_eof}; + } elsif ($frame_buffer->is_pong) { + # Server responded to our ping. + $self->{on_pong}->($self, $bytes) if $self->{on_pong}; + } elsif ($frame_buffer->is_ping) { + # Server sent ping request. + $self->{on_ping}->($self, $bytes) if $self->{on_ping}; + } else { + $self->{on_read}->($self, $bytes); + } + } + } + + return $self; +} + +# Write arbitrary message. +# Takes either a Protocol::WebSocket::Frame object, or +# if given a scalar, builds a standard frame around it. +# In either case, calls user on_write function. +sub write { + my $self = shift; + my ($buffer) = @_; + + if ($self->is_ready) { + my $frame = + ref $buffer + ? $buffer + : $self->_build_frame(masked => 1, buffer => $buffer); + $self->{on_write}->($self, $frame->to_bytes); + } else { + warn "Protocol::WebSocket::Client: write() on " . ($self->{state} ? 'closed' : 'unconnected') . " WebSocket."; + } + + return $self; +} + +# Write preformatted messages +# "connect" (initial handshake) +sub connect { + my $self = shift; + + if ($self->{state} == 0) { + my $hs = $self->{hs}; + + $self->{on_write}->($self, $hs->to_string); + } else { + warn "Protocol::WebSocket::Client: connect() on " . ($self->{state} > 0 ? 'already-connected' : 'closed') . " WebSocket."; + } + + return $self; +} + +# "disconnect" (close frame) +# also sets state to -1 when called +sub disconnect { + my $self = shift; + + # TODO: Spec states 'close' messages may contain a uint16 error code, and a utf-8 reason. + # Clients are supposed to echo back the error code when receiving close from server. + # For now, we just send an empty message. + $self->write( $self->_build_frame(type => 'close', masked => 1) ); + + $self->{state} = -1; + + return $self; +} + +# "ping" (keep-alive, client to server) +sub ping { + my $self = shift; + my ($buffer) = @_; + + $self->write( $self->_build_frame(type => 'ping', masked => 1, buffer => $buffer) ); + + return $self; +} + +# "pong" (keep-alive, server to client) +sub pong { + my $self = shift; + my ($buffer) = @_; + + $self->write( $self->_build_frame(type => 'pong', masked => 1, buffer => $buffer) ); + + return $self; +} + +# Class-specific internal functions +sub _build_frame { + my $self = shift; + + return Protocol::WebSocket::Frame->new(version => $self->{version}, @_); +} + +1; +__END__ + +=head1 NAME + +Protocol::WebSocket::Client - WebSocket client + +=head1 SYNOPSIS + + my $sock = ...get non-blocking socket...; + + my $client = Protocol::WebSocket::Client->new(url => 'ws://localhost:3000'); + $client->on( + write => sub { + my $client = shift; + my ($buf) = @_; + + syswrite $sock, $buf; + }, + read => sub { + my $client = shift; + my ($buf) = @_; + + ...do smth with read data... + } + ); + + # Sends a correct handshake header + $client->connect; + + # Register on connect handler + $client->on( + connect => sub { + $client->write('hi there'); + } + ); + + # Parses incoming data and on every frame calls on_read + $client->read(...data from socket...); + + # Sends correct close header + $client->disconnect; + +=head1 DESCRIPTION + +L is a convenient class for writing a WebSocket +client. It can be used to create the proper handshake to initiate a WebSocket +session with a client, as well as properly encode/decode WS frames from/to +Perl strings. + +This class does not implement its own TCP socket handling. Instead, it +provides callback hooks for the end user to plug in their own read / write +routines. The user should open a (non-)blocking socket with L +or similar, then call C<$client->on()> to attach custom code blocks to handlers +in the object. Later, when decoding packets, the class will call the +appropriate callback so the application can use the data returned. + +=head2 Methods + +=over 12 + +=item C + +Returns a new Protocol::WebSocket::Client object. + +Parameters should be passed to C as hash pairs. The only mandatory +parameter is C, which must be a valid WebSocket URL beginning with +C or C. However, if you don't specify C and +C here, AND you don't provide them later using a call to C, +the object will not actually be usable. + +The list of parameters follows: + +=over 12 + +=item C + +URL of the desired WebSocket server endpoint. This parameter is mandatory, +and is only used to construct the valid handshake for initiating a session. + +This URL is parsed by L, refer to that object for +documentation on allowed URL formatting. + +=item C + +Desired version of the WebSocket protocol to use. See L +for a list of valid version strings, as well as the default used when this +is not provided. + +=item C, C, C, C, C, C, C + +Application callback for various WebSocket events. See C for details. + +Note that C is a special case: if the user does not provide a value, +a default "pong" function will be used automatically. Users may disable the +auto-pong handler by passing C undef>, or supply their own. + +=item C, C + +These parameters are passed to the underlying WebSocket Frame object and control +behavior of the frame decoding. Refer to L for +details on these options. + +=back + +=item C + +Registers a callback with the object, which will be triggered at various points +in the WebSocket control flow. Mandatory callbacks are C and +C: the client will (probably) crash if attempting to connect without +supplying something here. + +Other handlers can be disabled by passing undef. + +C accepts a hash as input, so it is possible to set multiple handlers with +one call. Either call this by passing a function reference (as in +C \&my_read );>) or an anonymous code block (as in +C { print "Connected!\n" } );>). + +The list of available hooks follows: + +=over 12 + +=item C + +Called when the Object wants to write data to the socket. The function receives +a reference to the object, and a buffer (string) to write. For example: + + write => sub { + my $client = shift; + my ($buf) = @_; + + syswrite $sock, $buf; + } + +=item C + +Called when the Object has finished parsing a Frame and has data to return +to the application. The function receives a reference to the object, and +a buffer containing the received data. For example: + + read => sub { + my $client = shift; + my ($buf) = @_; + + print "Received from remote: '$buf'\n"; + } + +=item C + +Called when the Object has completed the handshake with the remote server. +The callback receives a reference to the object. + + connect => sub { + my $client = shift; + + print "Client has finished handshake and is ready to talk!\n"; + } + +=item C + +Called when the Object has terminated the WebSocket connection. This can +happen either at the request of the Server, or because the Client has called +C. The callback function receives a reference to the object. + +A closed WebSocket connection cannot send or receive further packets, though +the TCP socket remains open. In practice, it's wise to close that here. + + eof => sub { + my $client = shift; + + print "WebSocket connection is terminated.\n"; + $sock->close; + } + +=item C + +Called when the Object fails to complete a handshake. The callback function +receives a reference to the object, and a buffer (string) containing any +error info that might be useful. + + error => sub { + my $client = shift; + my ($buf) = @_; + + say "Error establishing WebSocket: $buf"; + $sock->close; + exit; + } + +=item C + +Called when the Object decodes a "ping" request from the server. A built-in +handler for this is supplied by default, but users may wish to provide their +own. The callback function receives a reference to the object, and a buffer +containing any data in the Ping message. The WebSocket spec suggests that +the buffer should simply be returned in the pong response. + + ping => sub { + my $client = shift; + my ($buf) = @_; + + say "Ping? PONG!\n"; + $client->pong($buf); + } + +=item C + +Called when the Object decodes a "pong" response from the server. Because +this can only be triggered by the application sending a "ping", it is probably +safe to ignore this function. + +The callback function receives a reference to the object, and a buffer +containing any data in the Pong message (which, in turn, should be a copy +of the data sent in the initial Ping message). + + pong => sub { + my $client = shift; + my ($buf) = @_; + + say "Good news, everyone! The server is alive.\n"; + } + +=back + +=item C + +Send data to the remote WebService. + +This function takes either a scalar (which will be packaged in correct +WebSocket framing) or a reference to a L object +(in case you need to build a frame yourself). It then calls the user-provided +C method with the encoded data. + +This function tries to B when sending at a time that isn't valid (e.g. +during the connection or after disconnect). See C to determine +if now is an OK time to C. + +=item C + +Decode data retrieved from the remote socket as WebSocket frames. + +This function accepts a scalar containing bytes that should be appended to +the internal object buffer. Because WebSockets is a Frame protocol atop a TCP +stream, data may be retrieved piecemeal until an entire frame is collected. + +If no complete frame is ready after the call, this function will simply return. +However, if a complete frame is ready and decoded, the object will send decoded +data to the appropriate callback hook at this time. + +In other words, call C, and pass the resulting buffer to this +function for parsing. + +=item C + +Initiate a WebSocket connection to the remote service. This will send the +handshake (using the C callback). + +This function tries to B when connecting while a connection already +exists, so don't do that. + +=item C + +Send a Close frame to the remote service, and mark the connection as Closed +internally. Assuming a well-behaved remote service, this should result in a +callback to C fairly quickly. + +This function tries to B when closing an already-closed or not-yet-open +connection, so don't do that either. + +=item C + +Send a Ping frame to the remote service. Accepts a buffer of data to send +with the message (e.g. a timestamp, monotonically increasing ID, etc). + +As with C above, this is only valid in an established connection. + +=item C + +Send a Pong frame to the remote service. Accepts a buffer of data to send +with the message - you should really just reply with whatever was in the +original Ping frame. + +As with C above, this is only valid in an established connection. + +=item C + +Returns / sets the L associated with this object. + +=item C + +Returns / sets the WebSocket protocol version being used by this object. + +=item C + +Returns 1 if the object is ready to accept C / C / C, +0 otherwise. + +=back + +=head1 AUTHOR + +See L for author details. + +=head1 COPYRIGHT + +See L for copyright info. diff --git a/CPAN/Protocol/WebSocket/Cookie.pm b/CPAN/Protocol/WebSocket/Cookie.pm new file mode 100644 index 00000000000..ecfea524a74 --- /dev/null +++ b/CPAN/Protocol/WebSocket/Cookie.pm @@ -0,0 +1,92 @@ +package Protocol::WebSocket::Cookie; + +use strict; +use warnings; + +sub new { + my $class = shift; + $class = ref $class if ref $class; + + my $self = {@_}; + bless $self, $class; + + return $self; +} + +sub pairs { @_ > 1 ? $_[0]->{pairs} = $_[1] : $_[0]->{pairs} } + +my $TOKEN = qr/[^;,\s"]+/; +my $NAME = qr/[^;,\s"=]+/; +my $QUOTED_STRING = qr/"(?:\\"|[^"])+"/; +my $VALUE = qr/(?:$TOKEN|$QUOTED_STRING)/; + +sub parse { + my $self = shift; + my $string = shift; + + $self->{pairs} = []; + + return unless defined $string && $string ne ''; + + while ($string =~ m/\s*($NAME)\s*(?:=\s*($VALUE))?;?/g) { + my ($attr, $value) = ($1, $2); + if (defined $value) { + $value =~ s/^"//; + $value =~ s/"$//; + $value =~ s/\\"/"/g; + } + push @{$self->{pairs}}, [$attr, $value]; + } + + return $self; +} + +sub to_string { + my $self = shift; + + my $string = ''; + + my @pairs; + foreach my $pair (@{$self->pairs}) { + my $string = ''; + $string .= $pair->[0]; + + if (defined $pair->[1]) { + $string .= '='; + $string + .= $pair->[1] !~ m/^$VALUE$/ ? "\"$pair->[1]\"" : $pair->[1]; + } + + push @pairs, $string; + } + + return join '; ' => @pairs; +} + +1; +__END__ + +=head1 NAME + +Protocol::WebSocket::Cookie - Base class for WebSocket cookies + +=head1 DESCRIPTION + +A base class for L and +L. + +=head1 ATTRIBUTES + +=head2 C + +=head1 METHODS + +=head2 C + +Create a new L instance. + +=head2 C + +=head2 C + +=cut diff --git a/CPAN/Protocol/WebSocket/Cookie/Request.pm b/CPAN/Protocol/WebSocket/Cookie/Request.pm new file mode 100644 index 00000000000..17615ad58d6 --- /dev/null +++ b/CPAN/Protocol/WebSocket/Cookie/Request.pm @@ -0,0 +1,97 @@ +package Protocol::WebSocket::Cookie::Request; + +use strict; +use warnings; + +use base 'Protocol::WebSocket::Cookie'; + +sub parse { + my $self = shift; + + $self->SUPER::parse(@_); + + my $cookies = []; + + my $version = 1; + if ($self->pairs->[0] eq '$Version') { + my $pair = shift @{$self->pairs}; + $version = $pair->[1]; + } + + my $cookie; + foreach my $pair (@{$self->pairs}) { + next unless defined $pair->[0]; + + if ($pair->[0] =~ m/^[^\$]/) { + push @$cookies, $cookie if defined $cookie; + + $cookie = $self->_build_cookie( + name => $pair->[0], + value => $pair->[1], + version => $version + ); + } + elsif ($pair->[0] eq '$Path') { + $cookie->path($pair->[1]); + } + elsif ($pair->[0] eq '$Domain') { + $cookie->domain($pair->[1]); + } + } + + push @$cookies, $cookie if defined $cookie; + + return $cookies; +} + +sub name { @_ > 1 ? $_[0]->{name} = $_[1] : $_[0]->{name} } +sub value { @_ > 1 ? $_[0]->{value} = $_[1] : $_[0]->{value} } +sub version { @_ > 1 ? $_[0]->{version} = $_[1] : $_[0]->{version} } +sub path { @_ > 1 ? $_[0]->{path} = $_[1] : $_[0]->{path} } +sub domain { @_ > 1 ? $_[0]->{domain} = $_[1] : $_[0]->{domain} } + +sub _build_cookie { shift; Protocol::WebSocket::Cookie::Request->new(@_) } + +1; +__END__ + +=head1 NAME + +Protocol::WebSocket::Cookie::Request - WebSocket Cookie Request + +=head1 SYNOPSIS + + # Constructor + + # Parser + my $cookie = Protocol::WebSocket::Cookie::Request->new; + $cookies = $cookie->parse( + '$Version=1; foo="bar"; $Path=/; bar=baz; $Domain=.example.com'); + +=head1 DESCRIPTION + +Construct or parse a WebSocket request cookie. + +=head1 ATTRIBUTES + +=head2 C + +=head2 C + +=head2 C + +=head2 C + +=head2 C + +=head1 METHODS + +=head2 C + +Parse a WebSocket request cookie. + +=head2 C + +Construct a WebSocket request cookie. + +=cut diff --git a/CPAN/Protocol/WebSocket/Cookie/Response.pm b/CPAN/Protocol/WebSocket/Cookie/Response.pm new file mode 100644 index 00000000000..28e0022f31a --- /dev/null +++ b/CPAN/Protocol/WebSocket/Cookie/Response.pm @@ -0,0 +1,84 @@ +package Protocol::WebSocket::Cookie::Response; + +use strict; +use warnings; + +use base 'Protocol::WebSocket::Cookie'; + +sub parse { + my $self = shift; + + $self->SUPER::parse(@_); +} + +sub to_string { + my $self = shift; + + my $pairs = []; + + push @$pairs, [$self->{name}, $self->{value}]; + + push @$pairs, ['Comment', $self->{comment}] if defined $self->{comment}; + + push @$pairs, ['CommentURL', $self->{comment_url}] + if defined $self->{comment_url}; + + push @$pairs, ['Discard'] if $self->{discard}; + + push @$pairs, ['Max-Age' => $self->{max_age}] if defined $self->{max_age}; + + push @$pairs, ['Path' => $self->{path}] if defined $self->{path}; + + if (defined $self->{portlist}) { + $self->{portlist} = [$self->{portlist}] + unless ref $self->{portlist} eq 'ARRAY'; + my $list = join ' ' => @{$self->{portlist}}; + push @$pairs, ['Port' => "\"$list\""]; + } + + push @$pairs, ['Secure'] if $self->{secure}; + + push @$pairs, ['Version' => '1']; + + $self->pairs($pairs); + + return $self->SUPER::to_string; +} + +1; +__END__ + +=head1 NAME + +Protocol::WebSocket::Cookie::Response - WebSocket Cookie Response + +=head1 SYNOPSIS + + # Constructor + my $cookie = Protocol::WebSocket::Cookie::Response->new( + name => 'foo', + value => 'bar', + discard => 1, + max_age => 0 + ); + $cookie->to_string; # foo=bar; Discard; Max-Age=0; Version=1 + + # Parser + my $cookie = Protocol::WebSocket::Cookie::Response->new; + $cookie->parse('foo=bar; Discard; Max-Age=0; Version=1'); + +=head1 DESCRIPTION + +Construct or parse a WebSocket response cookie. + +=head1 METHODS + +=head2 C + +Parse a WebSocket response cookie. + +=head2 C + +Construct a WebSocket response cookie. + +=cut diff --git a/CPAN/Protocol/WebSocket/Handshake.pm b/CPAN/Protocol/WebSocket/Handshake.pm new file mode 100644 index 00000000000..4c83caee14d --- /dev/null +++ b/CPAN/Protocol/WebSocket/Handshake.pm @@ -0,0 +1,70 @@ +package Protocol::WebSocket::Handshake; + +use strict; +use warnings; + +use Protocol::WebSocket::Request; +use Protocol::WebSocket::Response; + +sub new { + my $class = shift; + $class = ref $class if ref $class; + + my $self = {@_}; + bless $self, $class; + + return $self; +} + +sub error { @_ > 1 ? $_[0]->{error} = $_[1] : $_[0]->{error} } + +sub version { $_[0]->req->version } + +sub req { shift->{req} ||= Protocol::WebSocket::Request->new } +sub res { shift->{res} ||= Protocol::WebSocket::Response->new } + +1; +__END__ + +=head1 NAME + +Protocol::WebSocket::Handshake - Base WebSocket Handshake class + +=head1 DESCRIPTION + +This is a base class for L and +L. + +=head1 ATTRIBUTES + +=head2 C + + $handshake->error; + +Set or get handshake error. + +=head2 C + + $handshake->version; + +Set or get handshake version. + +=head1 METHODS + +=head2 C + +Create a new L instance. + +=head2 C + + $handshake->req; + +WebSocket request object. + +=head2 C + + $handshake->res; + +WebSocket response object. + +=cut diff --git a/CPAN/Protocol/WebSocket/Handshake/Client.pm b/CPAN/Protocol/WebSocket/Handshake/Client.pm new file mode 100644 index 00000000000..529b3a681e5 --- /dev/null +++ b/CPAN/Protocol/WebSocket/Handshake/Client.pm @@ -0,0 +1,152 @@ +package Protocol::WebSocket::Handshake::Client; + +use strict; +use warnings; + +use base 'Protocol::WebSocket::Handshake'; + +require Carp; + +use Protocol::WebSocket::URL; +use Protocol::WebSocket::Frame; + +sub new { + my $self = shift->SUPER::new(@_); + + $self->_set_url($self->{url}) if defined $self->{url}; + + if (my $version = $self->{version}) { + $self->req->version($version); + $self->res->version($version); + } + + return $self; +} + +sub url { + my $self = shift; + my $url = shift; + + return $self->{url} unless $url; + + $self->_set_url($url); + + return $self; +} + +sub parse { + my $self = shift; + + my $req = $self->req; + my $res = $self->res; + + unless ($res->is_done) { + unless ($res->parse($_[0])) { + $self->error($res->error); + return; + } + + if ($res->is_done) { + if ( $req->version eq 'draft-ietf-hybi-00' + && $req->checksum ne $res->checksum) + { + $self->error('Checksum is wrong.'); + return; + } + } + } + + return 1; +} + +sub is_done { shift->res->is_done } +sub to_string { shift->req->to_string } + +sub build_frame { + my $self = shift; + + return Protocol::WebSocket::Frame->new(masked => 1, version => $self->version, @_); +} + +sub _build_url { Protocol::WebSocket::URL->new } + +sub _set_url { + my $self = shift; + my $url = shift; + + $url = $self->_build_url->parse($url) unless ref $url; + + $self->req->secure(1) if $url->secure; + + my $req = $self->req; + + my $host = $url->host; + $host .= ':' . $url->port + if defined $url->port + && ($url->secure ? $url->port ne '443' : $url->port ne '80'); + $req->host($host); + + $req->resource_name($url->resource_name); + + return $self; +} + +1; +__END__ + +=head1 NAME + +Protocol::WebSocket::Handshake::Client - WebSocket Client Handshake + +=head1 SYNOPSIS + + my $h = + Protocol::WebSocket::Handshake::Client->new(url => 'ws://example.com'); + + # Create request + $h->to_string; + + # Parse server response + $h->parse(<<"EOF"); + WebSocket HTTP message + EOF + + $h->error; # Check if there were any errors + $h->is_done; # Returns 1 + +=head1 DESCRIPTION + +Construct or parse a client WebSocket handshake. This module is written for +convenience, since using request and response directly requires the same code +again and again. + +=head1 ATTRIBUTES + +=head2 C + + $handshake->url('ws://example.com/demo'); + +Set or get WebSocket url. + +=head1 METHODS + +=head2 C + +Create a new L instance. + +=head2 C + + $handshake->parse($buffer); + +Parse a WebSocket server response. Returns C and sets C attribute +on error. Buffer is modified. + +=head2 C + +Construct a WebSocket client request. + +=head2 C + +Check whether handshake is done. + +=cut diff --git a/CPAN/Protocol/WebSocket/Handshake/Server.pm b/CPAN/Protocol/WebSocket/Handshake/Server.pm new file mode 100644 index 00000000000..35deff386d1 --- /dev/null +++ b/CPAN/Protocol/WebSocket/Handshake/Server.pm @@ -0,0 +1,161 @@ +package Protocol::WebSocket::Handshake::Server; + +use strict; +use warnings; + +use base 'Protocol::WebSocket::Handshake'; + +use Protocol::WebSocket::Request; +use Protocol::WebSocket::Frame; + +sub new_from_psgi { + my $class = shift; + + my $req = Protocol::WebSocket::Request->new_from_psgi(@_); + my $self = $class->new(req => $req); + + return $self; +} + +sub parse { + my $self = shift; + + my $req = $self->req; + my $res = $self->res; + + return 1 if $req->is_done; + + unless ($req->parse($_[0])) { + $self->error($req->error); + return; + } + + if ($req->is_body || $req->is_done) { + $res->version($req->version); + $res->host($req->host); + + $res->secure($req->secure); + $res->resource_name($req->resource_name); + $res->origin($req->origin); + } + + if ($req->version eq 'draft-ietf-hybi-00') { + if ($self->is_done) { + $res->checksum(undef); + $res->number1($req->number1); + $res->number2($req->number2); + $res->challenge($req->challenge); + } + else { + $res->checksum(''); + } + } + elsif ($self->is_done && $req->version eq 'draft-ietf-hybi-10' + || $req->version eq 'draft-ietf-hybi-17') + { + $res->key($req->key); + } + + return 1; +} + +sub is_body { shift->req->is_body } +sub is_done { shift->req->is_done } +sub to_string { + my $self = shift; + + if ($self->is_body) { + return $self->{partial} = $self->res->to_string; + } + elsif ($self->{partial}) { + my $to_string = $self->res->to_string; + + $to_string =~ s/^\Q$self->{partial}\E//; + + return $to_string; + } + + return $self->res->to_string; +} + +sub build_frame { + my $self = shift; + + return Protocol::WebSocket::Frame->new(version => $self->version, @_); +} + +1; +__END__ + +=head1 NAME + +Protocol::WebSocket::Handshake::Server - WebSocket Server Handshake + +=head1 SYNOPSIS + + my $h = Protocol::WebSocket::Handshake::Server->new; + + # Parse client request + $h->parse(<<"EOF"); + WebSocket HTTP message + EOF + + $h->error; # Check if there were any errors + $h->is_done; # Returns 1 + + # Create response + $h->to_string; + +=head1 DESCRIPTION + +Construct or parse a server WebSocket handshake. This module is written for +convenience, since using request and response directly requires the same code +again and again. + +=head1 METHODS + +=head2 C + +Create a new L instance. + +=head2 C + + my $env = { + HTTP_HOST => 'example.com', + HTTP_CONNECTION => 'Upgrade', + ... + }; + my $handshake = Protocol::WebSocket::Handshake::Server->new_from_psgi($env); + +Create a new L instance from L +environment. + +=head2 C + + $handshake->parse($buffer); + $handshake->parse($handle); + +Parse a WebSocket client request. Returns C and sets C attribute +on error. + +When buffer is passed it's modified (unless readonly). + +=head2 C + + $handshake->build_frame; + +Builds L with an appropriate version. + +=head2 C + +Construct a WebSocket server response. + +=head2 C + +Check whether handshake is in body state. + +=head2 C + +Check whether handshake is done. + +=cut diff --git a/CPAN/Protocol/WebSocket/Message.pm b/CPAN/Protocol/WebSocket/Message.pm new file mode 100644 index 00000000000..433738143fd --- /dev/null +++ b/CPAN/Protocol/WebSocket/Message.pm @@ -0,0 +1,248 @@ +package Protocol::WebSocket::Message; + +use strict; +use warnings; + +use base 'Protocol::WebSocket::Stateful'; + +use Scalar::Util qw(readonly); +require Digest::MD5; + +our $MAX_MESSAGE_SIZE = 10 * 2048; + +sub new { + my $class = shift; + $class = ref $class if ref $class; + + my $self = {@_}; + bless $self, $class; + + $self->{version} ||= ''; + + $self->{buffer} = ''; + + $self->{fields} ||= {}; + + $self->{max_message_size} ||= $MAX_MESSAGE_SIZE; + + $self->{cookies} ||= []; + + $self->state('first_line'); + + return $self; +} + +sub secure { @_ > 1 ? $_[0]->{secure} = $_[1] : $_[0]->{secure} } + +sub fields { shift->{fields} } + +sub field { + my $self = shift; + my $name = lc shift; + + return $self->fields->{$name} unless @_; + + $self->fields->{$name} = $_[0]; + + return $self; +} + +sub error { + my $self = shift; + + return $self->{error} unless @_; + + my $error = shift; + $self->{error} = $error; + $self->state('error'); + + return $self; +} + +sub subprotocol { + @_ > 1 ? $_[0]->{subprotocol} = $_[1] : $_[0]->{subprotocol}; +} + +sub host { @_ > 1 ? $_[0]->{host} = $_[1] : $_[0]->{host} } +sub origin { @_ > 1 ? $_[0]->{origin} = $_[1] : $_[0]->{origin} } + +sub version { @_ > 1 ? $_[0]->{version} = $_[1] : $_[0]->{version} } + +sub number1 { @_ > 1 ? $_[0]->{number1} = $_[1] : $_[0]->{number1} } +sub number2 { @_ > 1 ? $_[0]->{number2} = $_[1] : $_[0]->{number2} } +sub challenge { @_ > 1 ? $_[0]->{challenge} = $_[1] : $_[0]->{challenge} } + +sub checksum { + my $self = shift; + + if (@_) { + $self->{checksum} = $_[0]; + return $self; + } + + return $self->{checksum} if defined $self->{checksum}; + + Carp::croak(qq/number1 is required/) unless defined $self->number1; + Carp::croak(qq/number2 is required/) unless defined $self->number2; + Carp::croak(qq/challenge is required/) unless defined $self->challenge; + + my $checksum = ''; + $checksum .= pack 'N' => $self->number1; + $checksum .= pack 'N' => $self->number2; + $checksum .= $self->challenge; + $checksum = Digest::MD5::md5($checksum); + + return $self->{checksum} ||= $checksum; +} + +sub parse { + my $self = shift; + + return 1 unless defined $_[0]; + + return if $self->error; + + return unless $self->_append(@_); + + while (!$self->is_state('body') && defined(my $line = $self->_get_line)) { + if ($self->state eq 'first_line') { + return unless defined $self->_parse_first_line($line); + + $self->state('fields'); + } + elsif ($line ne '') { + return unless defined $self->_parse_field($line); + } + else { + $self->state('body'); + last; + } + } + + return 1 unless $self->is_state('body'); + + my $rv = $self->_parse_body; + return unless defined $rv; + + # Need more data + return $rv unless ref $rv; + + $_[0] = $self->{buffer} unless readonly $_[0] || ref $_[0]; + return $self->done; +} + +sub _extract_number { + my $self = shift; + my $key = shift; + + my $number = join '' => $key =~ m/\d+/g; + my $spaces = $key =~ s/ / /g; + + return if $spaces == 0; + + return int($number / $spaces); +} + +sub _append { + my $self = shift; + + return if $self->error; + + if (ref $_[0]) { + $_[0]->read(my $buf, $self->{max_message_size}); + $self->{buffer} .= $buf; + } + else { + $self->{buffer} .= $_[0]; + $_[0] = '' unless readonly $_[0]; + } + + if (length $self->{buffer} > $self->{max_message_size}) { + $self->error('Message is too long'); + return; + } + + return $self; +} + +sub _get_line { + my $self = shift; + + if ($self->{buffer} =~ s/^(.*?)\x0d?\x0a//) { + return $1; + } + + return; +} + +sub _parse_first_line {shift} + +sub _parse_field { + my $self = shift; + my $line = shift; + + my ($name, $value) = split /:\s*/ => $line => 2; + unless (defined $name && defined $value) { + $self->error('Invalid field'); + return; + } + + #$name =~ s/^Sec-WebSocket-Origin$/Origin/i; # FIXME + $self->field($name => $value); + + if ($name =~ m/^x-forwarded-proto$/i) { + $self->secure(1); + } + + return $self; +} + +sub _parse_body {shift} + +1; +__END__ + +=head1 NAME + +Protocol::WebSocket::Message - Base class for WebSocket request and response + +=head1 DESCRIPTION + +A base class for L and +L. + +=head1 ATTRIBUTES + +=head2 C + +=head2 C + +=head2 C + +=head2 C + +=head2 C + +=head2 C + +=head2 C + +=head2 C + +=head2 C + +=head2 C + +=head2 C + +=head1 METHODS + +=head2 C + +Create a new L instance. + +=head2 C + +=head2 C + +=cut diff --git a/CPAN/Protocol/WebSocket/Request.pm b/CPAN/Protocol/WebSocket/Request.pm new file mode 100644 index 00000000000..fef20ee06ce --- /dev/null +++ b/CPAN/Protocol/WebSocket/Request.pm @@ -0,0 +1,530 @@ +package Protocol::WebSocket::Request; + +use strict; +use warnings; + +use base 'Protocol::WebSocket::Message'; + +require Carp; +use MIME::Base64 (); + +use Protocol::WebSocket::Cookie::Request; + +sub new { + my $self = shift->SUPER::new(@_); + my (%params) = @_; + + $self->{headers} = $params{headers} || []; + + return $self; +} + +sub new_from_psgi { + my $class = shift; + my $env = @_ > 1 ? {@_} : shift; + + Carp::croak('env is required') unless keys %$env; + + my $version = ''; + + my $cookies; + + my $fields = { + upgrade => $env->{HTTP_UPGRADE}, + connection => $env->{HTTP_CONNECTION}, + host => $env->{HTTP_HOST}, + }; + + if ($env->{HTTP_WEBSOCKET_PROTOCOL}) { + $fields->{'websocket-protocol'} = + $env->{HTTP_WEBSOCKET_PROTOCOL}; + } + elsif ($env->{HTTP_SEC_WEBSOCKET_PROTOCOL}) { + $fields->{'sec-websocket-protocol'} = + $env->{HTTP_SEC_WEBSOCKET_PROTOCOL}; + } + + if (exists $env->{HTTP_SEC_WEBSOCKET_VERSION}) { + $fields->{'sec-websocket-version'} = + $env->{HTTP_SEC_WEBSOCKET_VERSION}; + if ($env->{HTTP_SEC_WEBSOCKET_VERSION} eq '13') { + $version = 'draft-ietf-hybi-17'; + } + else { + $version = 'draft-ietf-hybi-10'; + } + } + + if ($env->{HTTP_SEC_WEBSOCKET_KEY}) { + $fields->{'sec-websocket-key'} = $env->{HTTP_SEC_WEBSOCKET_KEY}; + } + elsif ($env->{HTTP_SEC_WEBSOCKET_KEY1}) { + $version = 'draft-ietf-hybi-00'; + $fields->{'sec-websocket-key1'} = $env->{HTTP_SEC_WEBSOCKET_KEY1}; + $fields->{'sec-websocket-key2'} = $env->{HTTP_SEC_WEBSOCKET_KEY2}; + } + + if ($version eq 'draft-ietf-hybi-10') { + $fields->{'sec-websocket-origin'} = $env->{HTTP_SEC_WEBSOCKET_ORIGIN}; + } + else { + $fields->{origin} = $env->{HTTP_ORIGIN}; + } + + if ($env->{HTTP_COOKIE}) { + $cookies = Protocol::WebSocket::Cookie->new->parse($env->{HTTP_COOKIE}); + } + + my $self = $class->new( + version => $version, + fields => $fields, + cookies => $cookies, + resource_name => "$env->{SCRIPT_NAME}$env->{PATH_INFO}" + . ($env->{QUERY_STRING} ? "?$env->{QUERY_STRING}" : "") + ); + $self->state('body'); + + if ( $env->{HTTP_X_FORWARDED_PROTO} + && $env->{HTTP_X_FORWARDED_PROTO} eq 'https') + { + $self->secure(1); + } + + return $self; +} + +sub cookies { + if(@_ > 1) { + my $cookie = Protocol::WebSocket::Cookie->new; + return unless $_[1]; + + if (my $cookies = $cookie->parse($_[1])) { + $_[0]->{cookies} = $cookies; + } + } else { + return $_[0]->{cookies}; + } +} + +sub resource_name { + @_ > 1 ? $_[0]->{resource_name} = $_[1] : $_[0]->{resource_name} || '/'; +} + +sub upgrade { shift->field('Upgrade') } +sub connection { shift->field('Connection') } + +sub number1 { shift->_number('number1', 'key1', @_) } +sub number2 { shift->_number('number2', 'key2', @_) } + +sub key { shift->_key('key' => @_) } +sub key1 { shift->_key('key1' => @_) } +sub key2 { shift->_key('key2' => @_) } + +sub to_string { + my $self = shift; + + my $version = $self->version || 'draft-ietf-hybi-17'; + + my $string = ''; + + Carp::croak(qq/resource_name is required/) + unless defined $self->resource_name; + $string .= "GET " . $self->resource_name . " HTTP/1.1\x0d\x0a"; + + $string .= "Upgrade: websocket\x0d\x0a"; + $string .= "Connection: Upgrade\x0d\x0a"; + + Carp::croak(qq/Host is required/) unless defined $self->host; + $string .= "Host: " . $self->host . "\x0d\x0a"; + + if (ref $self->{cookies} eq 'Protocol::WebSocket::Cookie') { + my $cookie_string = $self->{cookies}->to_string; + $string .= 'Cookie: ' . $cookie_string . "\x0d\x0a" + if $cookie_string; + } + + my $origin = $self->origin ? $self->origin : 'http://' . $self->host; + $origin =~ s{^http:}{https:} if $self->secure; + $string .= ( + $version eq 'draft-ietf-hybi-10' + ? "Sec-WebSocket-Origin" + : "Origin" + ) + . ': ' + . $origin + . "\x0d\x0a"; + + if ($version eq 'draft-ietf-hybi-10' || $version eq 'draft-ietf-hybi-17') { + my $key = $self->key; + + if (!$key) { + $key = ''; + $key .= chr(int(rand(256))) for 1 .. 16; + + $key = MIME::Base64::encode_base64($key); + $key =~ s{\s+}{}g; + } + + $string + .= 'Sec-WebSocket-Protocol: ' . $self->subprotocol . "\x0d\x0a" + if defined $self->subprotocol; + + $string .= 'Sec-WebSocket-Key: ' . $key . "\x0d\x0a"; + $string + .= 'Sec-WebSocket-Version: ' + . ($version eq 'draft-ietf-hybi-17' ? 13 : 8) + . "\x0d\x0a"; + } + elsif ($version eq 'draft-ietf-hybi-00') { + $self->_generate_keys; + + $string + .= 'Sec-WebSocket-Protocol: ' . $self->subprotocol . "\x0d\x0a" + if defined $self->subprotocol; + + $string .= 'Sec-WebSocket-Key1: ' . $self->key1 . "\x0d\x0a"; + $string .= 'Sec-WebSocket-Key2: ' . $self->key2 . "\x0d\x0a"; + + $string .= 'Content-Length: ' . length($self->challenge) . "\x0d\x0a"; + } + elsif ($version eq 'draft-hixie-75') { + $string .= 'WebSocket-Protocol: ' . $self->subprotocol . "\x0d\x0a" + if defined $self->subprotocol; + } + else { + Carp::croak('Version ' . $self->version . ' is not supported'); + } + my @headers = @{$self->{headers}}; + while (my ($key, $value) = splice @headers, 0, 2) { + $key =~ s{[\x0d\x0a]}{}gsm; + $value =~ s{[\x0d\x0a]}{}gsm; + + $string .= "$key: $value\x0d\x0a"; + } + + $string .= "\x0d\x0a"; + + $string .= $self->challenge if $version eq 'draft-ietf-hybi-00'; + + return $string; +} + +sub parse { + my $self = shift; + + my $retval = $self->SUPER::parse($_[0]); + + if (!$self->{finalized} && ($self->is_body || $self->is_done)) { + $self->{finalized} = 1; + + if ($self->key1 && $self->key2) { + $self->version('draft-ietf-hybi-00'); + } + elsif ($self->key) { + if ($self->field('sec-websocket-version') eq '13') { + $self->version('draft-ietf-hybi-17'); + } + else { + $self->version('draft-ietf-hybi-10'); + } + } + else { + $self->version('draft-hixie-75'); + } + + if (!$self->_finalize) { + $self->error('Not a valid request'); + return; + } + } + + return $retval; +} + +sub _parse_first_line { + my ($self, $line) = @_; + + my ($req, $resource_name, $http) = split ' ' => $line; + + unless ($req && $resource_name && $http) { + $self->error('Wrong request line'); + return; + } + + unless ($req eq 'GET' && $http eq 'HTTP/1.1') { + $self->error('Wrong method or http version'); + return; + } + + $self->resource_name($resource_name); + + return $self; +} + +sub _parse_body { + my $self = shift; + + if ($self->key1 && $self->key2) { + return 1 if length $self->{buffer} < 8; + + my $challenge = substr $self->{buffer}, 0, 8, ''; + $self->challenge($challenge); + } + + if (length $self->{buffer}) { + $self->error('Leftovers'); + return; + } + + return $self; +} + +sub _number { + my $self = shift; + my ($name, $key, $value) = @_; + + if (defined $value) { + $self->{$name} = $value; + return $self; + } + + return $self->{$name} if defined $self->{$name}; + + return $self->{$name} ||= $self->_extract_number($self->$key); +} + +sub _key { + my $self = shift; + my $name = shift; + my $value = shift; + + unless (defined $value) { + if (my $value = delete $self->{$name}) { + $self->field("Sec-WebSocket-" . ucfirst($name) => $value); + } + + return $self->field("Sec-WebSocket-" . ucfirst($name)); + } + + $self->field("Sec-WebSocket-" . ucfirst($name) => $value); + + return $self; +} + +sub _generate_keys { + my $self = shift; + + unless ($self->key1) { + my ($number, $key) = $self->_generate_key; + $self->number1($number); + $self->key1($key); + } + + unless ($self->key2) { + my ($number, $key) = $self->_generate_key; + $self->number2($number); + $self->key2($key); + } + + $self->challenge($self->_generate_challenge) unless $self->challenge; + + return $self; +} + +sub _generate_key { + my $self = shift; + + # A random integer from 1 to 12 inclusive + my $spaces = int(rand(12)) + 1; + + # The largest integer not greater than 4,294,967,295 divided by spaces + my $max = int(4_294_967_295 / $spaces); + + # A random integer from 0 to $max inclusive + my $number = int(rand($max + 1)); + + # The result of multiplying $number and $spaces together + my $product = $number * $spaces; + + # A string consisting of $product, expressed in base ten + my $key = "$product"; + + # Insert between one and twelve random characters from the ranges U+0021 + # to U+002F and U+003A to U+007E into $key at random positions. + my $random_characters = int(rand(12)) + 1; + + for (1 .. $random_characters) { + + # From 0 to the last position + my $random_position = int(rand(length($key) + 1)); + + # Random character + my $random_character = chr( + int(rand(2)) + ? int(rand(0x2f - 0x21 + 1)) + 0x21 + : int(rand(0x7e - 0x3a + 1)) + 0x3a + ); + + # Insert random character at random position + substr $key, $random_position, 0, $random_character; + } + + # Insert $spaces U+0020 SPACE characters into $key at random positions + # other than the start or end of the string. + for (1 .. $spaces) { + + # From 1 to the last-1 position + my $random_position = int(rand(length($key) - 1)) + 1; + + # Insert + substr $key, $random_position, 0, ' '; + } + + return ($number, $key); +} + +sub _generate_challenge { + my $self = shift; + + # A string consisting of eight random bytes (or equivalently, a random 64 + # bit integer encoded in big-endian order). + my $challenge = ''; + + $challenge .= chr(int(rand(256))) for 1 .. 8; + + return $challenge; +} + +sub _finalize { + my $self = shift; + + return unless $self->upgrade && lc($self->upgrade) eq 'websocket'; + + my $connection = $self->connection; + return unless $connection; + + my @connections = split /\s*,\s*/, $connection; + return unless grep { lc $_ eq 'upgrade' } @connections; + + my $origin = $self->field('Sec-WebSocket-Origin') || $self->field('Origin'); + #return unless $origin; + $self->origin($origin); + + if (defined $self->origin) { + $self->secure(1) if $self->origin =~ m{^https:}; + } + + my $host = $self->field('Host'); + return unless $host; + $self->host($host); + + my $subprotocol = $self->field('Sec-WebSocket-Protocol') + || $self->field('WebSocket-Protocol'); + $self->subprotocol($subprotocol) if $subprotocol; + + $self->cookies($self->field('Cookie')); + return $self; +} + +sub _build_cookie { Protocol::WebSocket::Cookie::Request->new } + +1; +__END__ + +=head1 NAME + +Protocol::WebSocket::Request - WebSocket Request + +=head1 SYNOPSIS + + # Constructor + my $req = Protocol::WebSocket::Request->new( + host => 'example.com', + resource_name => '/demo' + ); + $req->to_string; # GET /demo HTTP/1.1 + # Upgrade: WebSocket + # Connection: Upgrade + # Host: example.com + # Origin: http://example.com + # Sec-WebSocket-Key1: 32 0 3lD& 24+< i u4 8! -6/4 + # Sec-WebSocket-Key2: 2q 4 2 54 09064 + # + # x##### + + # Parser + my $req = Protocol::WebSocket::Request->new; + $req->parse("GET /demo HTTP/1.1\x0d\x0a"); + $req->parse("Upgrade: WebSocket\x0d\x0a"); + $req->parse("Connection: Upgrade\x0d\x0a"); + $req->parse("Host: example.com\x0d\x0a"); + $req->parse("Origin: http://example.com\x0d\x0a"); + $req->parse( + "Sec-WebSocket-Key1: 18x 6]8vM;54 *(5: { U1]8 z [ 8\x0d\x0a"); + $req->parse( + "Sec-WebSocket-Key2: 1_ tx7X d < nw 334J702) 7]o}` 0\x0d\x0a"); + $req->parse("\x0d\x0aTm[K T2u"); + +=head1 DESCRIPTION + +Construct or parse a WebSocket request. + +=head1 ATTRIBUTES + +=head2 C + +=head2 C + +=head2 C + +=head2 C + +=head2 C + +=head2 C + +=head2 C + +=head1 METHODS + +=head2 C + +Create a new L instance. + +=head2 C + + my $env = { + HTTP_HOST => 'example.com', + HTTP_CONNECTION => 'Upgrade', + ... + }; + my $req = Protocol::WebSocket::Request->new_from_psgi($env); + +Create a new L instance from L environment. + +=head2 C + + $req->parse($buffer); + $req->parse($handle); + +Parse a WebSocket request. Incoming buffer is modified. + +=head2 C + +Construct a WebSocket request. + +=head2 C + + $self->connection; + +A shortcut for C<$self->field('Connection')>. + +=head2 C + +=head2 C + + $self->upgrade; + +A shortcut for C<$self->field('Upgrade')>. + +=cut diff --git a/CPAN/Protocol/WebSocket/Response.pm b/CPAN/Protocol/WebSocket/Response.pm new file mode 100644 index 00000000000..2d4f5673432 --- /dev/null +++ b/CPAN/Protocol/WebSocket/Response.pm @@ -0,0 +1,347 @@ +package Protocol::WebSocket::Response; + +use strict; +use warnings; + +use base 'Protocol::WebSocket::Message'; + +require Carp; +use MIME::Base64 (); +use Digest::SHA (); + +use Protocol::WebSocket::URL; +use Protocol::WebSocket::Cookie::Response; + +sub location { @_ > 1 ? $_[0]->{location} = $_[1] : $_[0]->{location} } + +sub resource_name { + @_ > 1 ? $_[0]->{resource_name} = $_[1] : $_[0]->{resource_name}; +} + +sub cookies { @_ > 1 ? $_[0]->{cookies} = $_[1] : $_[0]->{cookies} } + +sub cookie { + my $self = shift; + + push @{$self->{cookies}}, $self->_build_cookie(@_); +} + +sub key { @_ > 1 ? $_[0]->{key} = $_[1] : $_[0]->{key} } + +sub number1 { shift->_number('number1', 'key1', @_) } +sub number2 { shift->_number('number2', 'key2', @_) } + +sub _number { + my $self = shift; + my ($name, $key, $value) = @_; + + my $method = "SUPER::$name"; + return $self->$method($value) if defined $value; + + $value = $self->$method(); + $value = $self->_extract_number($self->$key) if not defined $value; + + return $value; +} + +sub key1 { @_ > 1 ? $_[0]->{key1} = $_[1] : $_[0]->{key1} } +sub key2 { @_ > 1 ? $_[0]->{key2} = $_[1] : $_[0]->{key2} } + +sub status { + return '101'; +} + +sub headers { + my $self = shift; + + my $version = $self->version || 'draft-ietf-hybi-10'; + + my $headers = []; + + push @$headers, Upgrade => 'WebSocket'; + push @$headers, Connection => 'Upgrade'; + + if ($version eq 'draft-hixie-75' || $version eq 'draft-ietf-hybi-00') { + Carp::croak(qq/host is required/) unless defined $self->host; + + my $location = $self->_build_url( + host => $self->host, + secure => $self->secure, + resource_name => $self->resource_name, + ); + my $origin = + $self->origin ? $self->origin : 'http://' . $location->host; + $origin =~ s{^http:}{https:} if !$self->origin && $self->secure; + + if ($version eq 'draft-hixie-75') { + push @$headers, 'WebSocket-Protocol' => $self->subprotocol + if defined $self->subprotocol; + push @$headers, 'WebSocket-Origin' => $origin; + push @$headers, 'WebSocket-Location' => $location->to_string; + } + elsif ($version eq 'draft-ietf-hybi-00') { + push @$headers, 'Sec-WebSocket-Protocol' => $self->subprotocol + if defined $self->subprotocol; + push @$headers, 'Sec-WebSocket-Origin' => $origin; + push @$headers, 'Sec-WebSocket-Location' => $location->to_string; + } + } + elsif ($version eq 'draft-ietf-hybi-10' || $version eq 'draft-ietf-hybi-17') { + Carp::croak(qq/key is required/) unless defined $self->key; + + my $key = $self->key; + $key .= '258EAFA5-E914-47DA-95CA-C5AB0DC85B11'; # WTF + $key = Digest::SHA::sha1($key); + $key = MIME::Base64::encode_base64($key); + $key =~ s{\s+}{}g; + + push @$headers, 'Sec-WebSocket-Accept' => $key; + + push @$headers, 'Sec-WebSocket-Protocol' => $self->subprotocol + if defined $self->subprotocol; + } + else { + Carp::croak('Version ' . $version . ' is not supported'); + } + + if (@{$self->cookies}) { + my $cookie = join ',' => map { $_->to_string } @{$self->cookies}; + push @$headers, 'Set-Cookie' => $cookie; + } + + return $headers; +} + +sub body { + my $self = shift; + + return $self->checksum if $self->version eq 'draft-ietf-hybi-00'; + + return ''; +} + +sub to_string { + my $self = shift; + + my $status = $self->status; + + my $string = ''; + $string .= "HTTP/1.1 $status WebSocket Protocol Handshake\x0d\x0a"; + + for (my $i = 0; $i < @{$self->headers}; $i += 2) { + my $key = $self->headers->[$i]; + my $value = $self->headers->[$i + 1]; + + $string .= "$key: $value\x0d\x0a"; + } + + $string .= "\x0d\x0a"; + + $string .= $self->body; + + return $string; +} + +sub _parse_first_line { + my ($self, $line) = @_; + + my $status = $self->status; + unless ($line =~ m{^HTTP/1\.1 $status }) { + my $vis = $line; + if( length( $vis ) > 80 ) { + substr( $vis, 77 )= '...'; + } + $self->error('Wrong response line. Got [[' . $vis . "]], expected [[HTTP/1.1 $status ]]"); + return; + } + + return $self; +} + +sub _parse_body { + my $self = shift; + + if ($self->field('Sec-WebSocket-Accept')) { + $self->version('draft-ietf-hybi-10'); + } + elsif ($self->field('Sec-WebSocket-Origin')) { + $self->version('draft-ietf-hybi-00'); + + return 1 if length $self->{buffer} < 16; + + my $checksum = substr $self->{buffer}, 0, 16, ''; + $self->checksum($checksum); + } + else { + $self->version('draft-hixie-75'); + } + + return $self if $self->_finalize; + + $self->error('Not a valid response'); + return; +} + +sub _finalize { + my $self = shift; + + if ($self->version eq 'draft-hixie-75') { + my $location = $self->field('WebSocket-Location'); + return unless defined $location; + $self->location($location); + + my $url = $self->_build_url; + return unless $url->parse($self->location); + + $self->secure($url->secure); + $self->host($url->host); + $self->resource_name($url->resource_name); + + $self->origin($self->field('WebSocket-Origin')); + + $self->subprotocol($self->field('WebSocket-Protocol')); + } + elsif ($self->version eq 'draft-ietf-hybi-00') { + my $location = $self->field('Sec-WebSocket-Location'); + return unless defined $location; + $self->location($location); + + my $url = $self->_build_url; + return unless $url->parse($self->location); + + $self->secure($url->secure); + $self->host($url->host); + $self->resource_name($url->resource_name); + + $self->origin($self->field('Sec-WebSocket-Origin')); + $self->subprotocol($self->field('Sec-WebSocket-Protocol')); + } + else { + $self->subprotocol($self->field('Sec-WebSocket-Protocol')); + } + + return 1; +} + +sub _build_url { shift; Protocol::WebSocket::URL->new(@_) } +sub _build_cookie { shift; Protocol::WebSocket::Cookie::Response->new(@_) } + +1; +__END__ + +=head1 NAME + +Protocol::WebSocket::Response - WebSocket Response + +=head1 SYNOPSIS + + # Constructor + $res = Protocol::WebSocket::Response->new( + host => 'example.com', + resource_name => '/demo', + origin => 'file://', + number1 => 777_007_543, + number2 => 114_997_259, + challenge => "\x47\x30\x22\x2D\x5A\x3F\x47\x58" + ); + $res->to_string; # HTTP/1.1 101 WebSocket Protocol Handshake + # Upgrade: WebSocket + # Connection: Upgrade + # Sec-WebSocket-Origin: file:// + # Sec-WebSocket-Location: ws://example.com/demo + # + # 0st3Rl&q-2ZU^weu + + # Parser + $res = Protocol::WebSocket::Response->new; + $res->parse("HTTP/1.1 101 WebSocket Protocol Handshake\x0d\x0a"); + $res->parse("Upgrade: WebSocket\x0d\x0a"); + $res->parse("Connection: Upgrade\x0d\x0a"); + $res->parse("Sec-WebSocket-Origin: file://\x0d\x0a"); + $res->parse("Sec-WebSocket-Location: ws://example.com/demo\x0d\x0a"); + $res->parse("\x0d\x0a"); + $res->parse("0st3Rl&q-2ZU^weu"); + +=head1 DESCRIPTION + +Construct or parse a WebSocket response. + +=head1 ATTRIBUTES + +=head2 C + +=head2 C + +=head2 C + +=head2 C + +=head2 C + +=head1 METHODS + +=head2 C + +Create a new L instance. + +=head2 C + + $res->parse($buffer); + +Parse a WebSocket response. Incoming buffer is modified. + +=head2 C + +Construct a WebSocket response. + +=head2 C + +=head2 C + +=head2 C + +=head2 C + + $self->key1; + +Set or get C field. + +=head2 C + + $self->key2; + +Set or get C field. + +=head2 C + + $self->number1; + $self->number1(123456); + +Set or extract from C generated C value. + +=head2 C + + $self->number2; + $self->number2(123456); + +Set or extract from C generated C value. + +=head2 C + + $self->status; + +Get response status (101). + +=head2 C + + $self->body; + +Get response body. + +=head2 C + + my $arrayref = $self->headers; + +Get response headers. + +=cut diff --git a/CPAN/Protocol/WebSocket/Stateful.pm b/CPAN/Protocol/WebSocket/Stateful.pm new file mode 100644 index 00000000000..c067b0539aa --- /dev/null +++ b/CPAN/Protocol/WebSocket/Stateful.pm @@ -0,0 +1,52 @@ +package Protocol::WebSocket::Stateful; + +use strict; +use warnings; + +sub new { + my $class = shift; + $class = ref $class if ref $class; + + my $self = {@_}; + bless $self, $class; + + return $self; +} + +sub state { @_ > 1 ? $_[0]->{state} = $_[1] : $_[0]->{state} } + +sub done { shift->state('done') } +sub is_state { shift->state eq shift } +sub is_body { shift->is_state('body') } +sub is_done { shift->is_state('done') } + +1; +__END__ + +=head1 NAME + +Protocol::WebSocket::Stateful - Base class for all classes with states + +=head1 DESCRIPTION + +A base class for all classes with states. + +=head1 ATTRIBUTES + +=head2 C + +=head1 METHODS + +=head2 C + +Create a new L instance. + +=head2 C + +=head2 C + +=head2 C + +=head2 C + +=cut diff --git a/CPAN/Protocol/WebSocket/URL.pm b/CPAN/Protocol/WebSocket/URL.pm new file mode 100644 index 00000000000..e2372933fdd --- /dev/null +++ b/CPAN/Protocol/WebSocket/URL.pm @@ -0,0 +1,115 @@ +package Protocol::WebSocket::URL; + +use strict; +use warnings; + +sub new { + my $class = shift; + $class = ref $class if ref $class; + + my $self = {@_}; + bless $self, $class; + + $self->{secure} ||= 0; + + return $self; +} + +sub secure { @_ > 1 ? $_[0]->{secure} = $_[1] : $_[0]->{secure} } + +sub host { @_ > 1 ? $_[0]->{host} = $_[1] : $_[0]->{host} } +sub port { @_ > 1 ? $_[0]->{port} = $_[1] : $_[0]->{port} } + +sub resource_name { + @_ > 1 ? $_[0]->{resource_name} = $_[1] : $_[0]->{resource_name}; +} + +sub parse { + my $self = shift; + my $string = shift; + + my ($scheme) = $string =~ m{^(wss?)://}; + return unless $scheme; + + $self->secure(1) if $scheme =~ m/ss$/; + + my ($host, $port) = $string =~ m{^$scheme://([^:\/]+)(?::(\d+))?(?:|\/|$)}; + $host = '/' unless defined $host && $host ne ''; + $self->host($host); + $port ||= $self->secure ? 443 : 80; + $self->port($port); + + # path and query + my ($pnq) = $string =~ m{^$scheme://(?:.*?)(/.*)$}; + $pnq = '/' unless defined $pnq && $pnq ne ''; + $self->resource_name($pnq); + + return $self; +} + +sub to_string { + my $self = shift; + + my $string = ''; + + $string .= 'ws'; + $string .= 's' if $self->secure; + $string .= '://'; + $string .= $self->host; + $string .= ':' . $self->port if defined $self->port; + $string .= $self->resource_name || '/'; + + return $string; +} + +1; +__END__ + +=head1 NAME + +Protocol::WebSocket::URL - WebSocket URL + +=head1 SYNOPSIS + + # Construct + my $url = Protocol::WebSocket::URL->new; + $url->host('example.com'); + $url->port('3000'); + $url->secure(1); + $url->to_string; # wss://example.com:3000 + + # Parse + my $url = Protocol::WebSocket::URL->new->parse('wss://example.com:3000'); + $url->host; # example.com + $url->port; # 3000 + $url->secure; # 1 + +=head1 DESCRIPTION + +Construct or parse a WebSocket URL. + +=head1 ATTRIBUTES + +=head2 C + +=head2 C + +=head2 C + +=head2 C + +=head1 METHODS + +=head2 C + +Create a new L instance. + +=head2 C + +Parse a WebSocket URL. + +=head2 C + +Construct a WebSocket URL. + +=cut diff --git a/CPAN/URI/ws.pm b/CPAN/URI/ws.pm new file mode 100644 index 00000000000..fe652c4f149 --- /dev/null +++ b/CPAN/URI/ws.pm @@ -0,0 +1,63 @@ +package URI::ws; + +use strict; +use warnings; + +# ABSTRACT: WebSocket support for URI package +our $VERSION = '0.03'; # VERSION + + +use base qw( URI::_server ); + + +sub default_port { 80 } + +1; + +__END__ + +=pod + +=head1 NAME + +URI::ws - WebSocket support for URI package + +=head1 VERSION + +version 0.03 + +=head1 SYNOPSIS + + use URI; + my $uri = URI->new('ws://localhost:3000/foo'); + +=head1 DESCRIPTION + +After this module is installed, the URI package provides the same set +of methods for WebSocket URIs as it does for HTTP ones. For secure +WebSockets, see L. + +=head1 METHODS + +=head2 URI::ws-Edefault_port + +Returns the default port (80) + +=head1 SEE ALSO + +L, L + +=cut + +=head1 AUTHOR + +Graham Ollis + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2013 by Graham Ollis. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/CPAN/URI/wss.pm b/CPAN/URI/wss.pm new file mode 100644 index 00000000000..88e2b89ffd5 --- /dev/null +++ b/CPAN/URI/wss.pm @@ -0,0 +1,70 @@ +package URI::wss; + +use strict; +use warnings; + +# ABSTRACT: Secure WebSocket support for URI package +our $VERSION = '0.03'; # VERSION + + +use base qw( URI::ws ); + + +sub default_port { 443 } + + +sub secure { 1 } + +1; + +__END__ + +=pod + +=head1 NAME + +URI::wss - Secure WebSocket support for URI package + +=head1 VERSION + +version 0.03 + +=head1 SYNOPSIS + + use URI; + my $uri = URI->new('wss://localhost:3000/foo'); + +=head1 DESCRIPTION + +After this module is installed, the URI package provides the same set +of methods for secure WebSocket URIs as it does for insecure WebSocket +URIs. For insecure (unencrypted) WebSockets, see L. + +=head1 METHODS + +=head2 URI::wss->default_port + +Returns the default port (443) + +=head2 $uri->secure + +Returns true. + +=head1 SEE ALSO + +L, L + +=cut + +=head1 AUTHOR + +Graham Ollis + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2013 by Graham Ollis. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/CPAN/arch/5.14/MSWin32-x86-multi-thread/Audio/Scan.pm b/CPAN/arch/5.14/MSWin32-x86-multi-thread/Audio/Scan.pm deleted file mode 100755 index 0dbd6f9156b..00000000000 --- a/CPAN/arch/5.14/MSWin32-x86-multi-thread/Audio/Scan.pm +++ /dev/null @@ -1,938 +0,0 @@ -package Audio::Scan; - -use strict; - -our $VERSION = '1.09'; - -require XSLoader; -XSLoader::load('Audio::Scan', $VERSION); - -use constant FILTER_INFO_ONLY => 1; -use constant FILTER_TAGS_ONLY => 2; - -sub scan_info { - my ( $class, $path, $opts ) = @_; - - $opts ||= {}; - $opts->{filter} = FILTER_INFO_ONLY; - - $class->scan( $path, $opts ); -} - -sub scan_tags { - my ( $class, $path, $opts ) = @_; - - $opts ||= {}; - $opts->{filter} = FILTER_TAGS_ONLY; - - $class->scan( $path, $opts ); -} - -sub scan { - my ( $class, $path, $opts ) = @_; - - my ($filter, $md5_size, $md5_offset); - - open my $fh, '<', $path or do { - warn "Could not open $path for reading: $!\n"; - return; - }; - - binmode $fh; - - my ($suffix) = $path =~ /\.(\w+)$/; - - return if !$suffix; - - if ( defined $opts ) { - if ( !ref $opts ) { - # Back-compat to support filter as normal argument - warn "The Audio::Scan::scan() filter passing method is deprecated, please pass a hashref instead.\n"; - $filter = $opts; - } - else { - $filter = $opts->{filter} || FILTER_INFO_ONLY | FILTER_TAGS_ONLY; - $md5_size = $opts->{md5_size}; - $md5_offset = $opts->{md5_offset}; - } - } - - if ( !defined $filter ) { - $filter = FILTER_INFO_ONLY | FILTER_TAGS_ONLY; - } - - my $ret = $class->_scan( $suffix, $fh, $path, $filter, $md5_size || 0, $md5_offset || 0 ); - - close $fh; - - return $ret; -} - -sub scan_fh { - my ( $class, $suffix, $fh, $opts ) = @_; - - my ($filter, $md5_size, $md5_offset); - - binmode $fh; - - if ( defined $opts ) { - if ( !ref $opts ) { - # Back-compat to support filter as normal argument - warn "The Audio::Scan::scan_fh() filter passing method is deprecated, please pass a hashref instead.\n"; - $filter = $opts; - } - else { - $filter = $opts->{filter} || FILTER_INFO_ONLY | FILTER_TAGS_ONLY; - $md5_size = $opts->{md5_size}; - $md5_offset = $opts->{md5_offset}; - } - } - - if ( !defined $filter ) { - $filter = FILTER_INFO_ONLY | FILTER_TAGS_ONLY; - } - - return $class->_scan( $suffix, $fh, '(filehandle)', $filter, $md5_size || 0, $md5_offset || 0 ); -} - -sub find_frame { - my ( $class, $path, $offset ) = @_; - - open my $fh, '<', $path or do { - warn "Could not open $path for reading: $!\n"; - return; - }; - - binmode $fh; - - my ($suffix) = $path =~ /\.(\w+)$/; - - return -1 if !$suffix; - - my $ret = $class->_find_frame( $suffix, $fh, $path, $offset ); - - close $fh; - - return $ret; -} - -sub find_frame_fh { - my ( $class, $suffix, $fh, $offset ) = @_; - - binmode $fh; - - return $class->_find_frame( $suffix, $fh, '(filehandle)', $offset ); -} - -sub find_frame_return_info { - my ( $class, $path, $offset ) = @_; - - open my $fh, '<', $path or do { - warn "Could not open $path for reading: $!\n"; - return; - }; - - binmode $fh; - - my ($suffix) = $path =~ /\.(\w+)$/; - - return if !$suffix; - - my $ret = $class->_find_frame_return_info( $suffix, $fh, $path, $offset ); - - close $fh; - - return $ret; -} - -sub find_frame_fh_return_info { - my ( $class, $suffix, $fh, $offset ) = @_; - - binmode $fh; - - return $class->_find_frame_return_info( $suffix, $fh, '(filehandle)', $offset ); -} - -1; -__END__ - -=head1 NAME - -Audio::Scan - Fast C metadata and tag reader for all common audio file formats - -=head1 SYNOPSIS - - use Audio::Scan; - - my $data = Audio::Scan->scan('/path/to/file.mp3'); - - # Just file info - my $info = Audio::Scan->scan_info('/path/to/file.mp3'); - - # Just tags - my $tags = Audio::Scan->scan_tags('/path/to/file.mp3'); - - # Scan without reading (possibly large) artwork into memory. - # Instead of binary artwork data, the size of the artwork will be returned instead. - { - local $ENV{AUDIO_SCAN_NO_ARTWORK} = 1; - my $data = Audio::Scan->scan('/path/to/file.mp3'); - } - - # Scan a filehandle - open my $fh, '<', 'my.mp3'; - my $data = Audio::Scan->scan_fh( mp3 => $fh ); - close $fh; - - # Scan and compute an audio MD5 checksum - my $data = Audio::Scan->scan( '/path/to/file.mp3', { md5_size => 100 * 1024 } ); - my $md5 = $data->{info}->{audio_md5}; - -=head1 DESCRIPTION - -Audio::Scan is a C-based scanner for audio file metadata and tag information. It currently -supports MP3, MP4, Ogg Vorbis, FLAC, ASF, WAV, AIFF, Musepack, Monkey's Audio, and WavPack. - -See below for specific details about each file format. - -=head1 METHODS - -=head2 scan( $path, [ \%OPTIONS ] ) - -Scans $path for both metadata and tag information. The type of scan performed is -determined by the file's extension. Supported extensions are: - - MP3: mp3, mp2 - MP4: mp4, m4a, m4b, m4p, m4v, m4r, k3g, skm, 3gp, 3g2, mov - AAC (ADTS): aac - Ogg: ogg, oga - FLAC: flc, flac, fla - ASF: wma, wmv, asf - Musepack: mpc, mpp, mp+ - Monkey's Audio: ape, apl - WAV: wav - AIFF: aiff, aif - WavPack: wv - -This method returns a hashref containing two other hashrefs: info and tags. The -contents of the info and tag hashes vary depending on file format, see below for details. - -An optional hashref may be provided with the following values: - - md5_size => $audio_bytes_to_checksum - -An MD5 will be computed of the first N audio bytes. Any tags in the file are automatically -skipped, so this is a useful way of determining if a file's audio content is the same even -if tags may have been changed. The hex MD5 value is returned in the $info->{audio_md5} -key. This option will reduce performance, so choose a small enough size that works for you, -you should probably avoid using more than 64K for example. - -For FLAC files that already contain an MD5 checksum, this value will be used instead -of calculating a new one. - - md5_offset => $offset - -Begin computing the audio_md5 value starting at $offset. If this value is not specified, -$offset defaults to a point in the middle of the file. - -=head2 scan_info( $path, [ \%OPTIONS ] ) - -If you only need file metadata and don't care about tags, you can use this method. - -=head2 scan_tags( $path, [ \%OPTIONS ] ) - -If you only need the tags and don't care about the metadata, use this method. - -=head2 scan_fh( $type => $fh, [ \%OPTIONS ] ) - -Scans a filehandle. $type is the type of file to scan as, i.e. "mp3" or "ogg". -Note that FLAC does not support reading from a filehandle. - -=head2 find_frame( $path, $timestamp_in_ms ) - -Returns the byte offset to the first audio frame starting from the given timestamp -(in milliseconds). - -=over 4 - -=item MP3, Ogg, FLAC, ASF, MP4 - -The byte offset to the data packet containing this timestamp will be returned. For -file formats that don't provide timestamp information such as MP3, the best estimate for -the location of the timestamp will be returned. This will be more accurate if the -file has a Xing header or is CBR for example. - -=item WAV, AIFF, Musepack, Monkey's Audio, WavPack - -Not yet supported by find_frame. - -=back - -=head2 find_frame_return_info( $mp4_path, $timestamp_in_ms ) - -The header of an MP4 file contains various metadata that refers to the structure of -the audio data, making seeking more difficult to perform. This method will return -the usual $info hash with 2 additional keys: - - seek_offset - The seek offset in bytes - seek_header - A rewritten MP4 header that can be prepended to the audio data - found at seek_offset to construct a valid bitstream. Specifically, - the following boxes are rewritten: stts, stsc, stsz, stco - -For example, to seek 30 seconds into a file and write out a new MP4 file seeked to -this point: - - my $info = Audio::Scan->find_frame_return_info( $file, 30000 ); - - open my $f, '<', $file; - sysseek $f, $info->{seek_offset}, 1; - - open my $fh, '>', 'seeked.m4a'; - print $fh $info->{seek_header}; - - while ( sysread( $f, my $buf, 65536 ) ) { - print $fh $buf; - } - - close $f; - close $fh; - -=head2 find_frame_fh( $type => $fh, $offset ) - -Same as C, but with a filehandle. - -=head2 find_frame_fh_return_info( $type => $fh, $offset ) - -Same as C, but with a filehandle. - -=head2 has_flac() - -Deprecated. Always returns 1 now that FLAC is always enabled. - -=head2 is_supported( $path ) - -Returns 1 if the given path can be scanned by Audio::Scan, or 0 if not. - -=head2 get_types() - -Returns an array of strings of the file types supported by Audio::Scan. - -=head2 extensions_for( $type ) - -Returns an array of strings of the file extensions that are considered to -be the file type I<$type>. - -=head2 type_for( $extension ) - -Returns file type for a given extension. Returns I for unsupported -extensions. - -=head1 SKIPPING ARTWORK - -To save memory while reading tags, you can opt to skip potentially large -embedded artwork. To do this, set the environment variable AUDIO_SCAN_NO_ARTWORK: - - local $ENV{AUDIO_SCAN_NO_ARTWORK} = 1; - my $tags = Audio::Scan->scan_tags($file); - -This will return the length of the embedded artwork instead of the actual image data. -In some cases it will also return a byte offset to the image data, which can be used -to extract the image using more efficient means. Note that the offset is not always -returned so if you want to use this data make sure to check for offset. If offset -is not present, the only way to get the image data is to perform a normal tag scan -without the environment variable set. - -One limitation that currently exists is that memory for embedded images is still -allocated for ASF and Ogg Vorbis files. - -This information is returned in different ways depending on the format: - -ID3 (MP3, AAC, WAV, AIFF): - - $tags->{APIC}->[3]: image length - $tags->{APIC}->[4]: image offset (unless APIC would need unsynchronization) - -MP4: - - $tags->{COVR}: image length - $tags->{COVR_offset}: image offset (always available) - -Ogg Vorbis: - - $tags->{ALLPICTURES}->[0]->{image_data}: image length - Image offset is not supported with Vorbis because the data is always base64-encoded. - -FLAC: - - $tags->{ALLPICTURES}->[0]->{image_data}: image length - $tags->{ALLPICTURES}->[0]->{offset}: image offset (always available) - -ASF: - - $tags->{'WM/Picture'}->{image}: image length - $tags->{'WM/Picture'}->{offset}: image offset (always available) - -APE, Musepack, WavPack, MP3 with APEv2: - - $tags->{'COVER ART (FRONT)'}: image length - $tags->{'COVER ART (FRONT)_offset'}: image offset (always available) - -=head1 MP3 - -=head2 INFO - -The following metadata about a file may be returned: - - id3_version (i.e. "ID3v2.4.0") - id3_was_unsynced (if a v2.2/v2.3 file needed whole-tag unsynchronization) - song_length_ms (duration in milliseconds) - layer (i.e. 3) - stereo - samples_per_frame - padding - audio_size (size of all audio frames) - audio_offset (byte offset to first audio frame) - bitrate (in bps, determined using Xing/LAME/VBRI if possible, or average in the worst case) - samplerate (in kHz) - vbr (1 if file is VBR) - dlna_profile (if file is compliant) - - If a Xing header is found: - xing_frames - xing_bytes - xing_quality - - If a VBRI header is found: - vbri_delay - vbri_frames - vbri_bytes - vbri_quality - - If a LAME header is found: - lame_encoder_version - lame_tag_revision - lame_vbr_method - lame_lowpass - lame_replay_gain_radio - lame_replay_gain_audiophile - lame_encoder_delay - lame_encoder_padding - lame_noise_shaping - lame_stereo_mode - lame_unwise_settings - lame_source_freq - lame_surround - lame_preset - -=head2 TAGS - -Raw tags are returned as found. This means older tags such as ID3v1 and ID3v2.2/v2.3 -are converted to ID3v2.4 tag names. Multiple instances of a tag in a file will be returned -as arrays. Complex tags such as APIC and COMM are returned as arrays. All tag fields are -converted to upper-case. All text is converted to UTF-8. - -Sample tag data: - - tags => { - ALBUMARTISTSORT => "Solar Fields", - APIC => [ "image/jpeg", 3, "", ], - CATALOGNUMBER => "INRE 017", - COMM => ["eng", "", "Amazon.com Song ID: 202981429"], - "MUSICBRAINZ ALBUM ARTIST ID" => "a2af1f31-c9eb-4fff-990c-c4f547a11b75", - "MUSICBRAINZ ALBUM ID" => "282143c9-6191-474d-a31a-1117b8c88cc0", - "MUSICBRAINZ ALBUM RELEASE COUNTRY" => "FR", - "MUSICBRAINZ ALBUM STATUS" => "official", - "MUSICBRAINZ ALBUM TYPE" => "album", - "MUSICBRAINZ ARTIST ID" => "a2af1f31-c9eb-4fff-990c-c4f547a11b75", - "REPLAYGAIN_ALBUM_GAIN" => "-2.96 dB", - "REPLAYGAIN_ALBUM_PEAK" => "1.045736", - "REPLAYGAIN_TRACK_GAIN" => "+3.60 dB", - "REPLAYGAIN_TRACK_PEAK" => "0.892606", - TALB => "Leaving Home", - TCOM => "Magnus Birgersson", - TCON => "Ambient", - TCOP => "2005 ULTIMAE RECORDS", - TDRC => "2004-10", - TIT2 => "Home", - TPE1 => "Solar Fields", - TPE2 => "Solar Fields", - TPOS => "1/1", - TPUB => "Ultimae Records", - TRCK => "1/11", - TSOP => "Solar Fields", - UFID => [ - "http://musicbrainz.org", - "1084278a-2254-4613-a03c-9fed7a8937ca", - ], - }, - - -=head1 MP4 - -=head2 INFO - -The following metadata about a file may be returned: - - audio_offset (byte offset to start of mdat) - audio_size - compatible_brands - file_size - leading_mdat (if file has mdat before moov) - major_brand - minor_version - song_length_ms - timescale - dlna_profile (if file is compliant) - tracks (array of tracks in the file) - Each track may contain: - - audio_type - avg_bitrate - bits_per_sample - channels - duration - encoding - handler_name - handler_type - id - max_bitrate - samplerate - -=head2 TAGS - -Tags are returned in a hash with all keys converted to upper-case. Keys starting with -0xA9 (copyright symbol) will have this character stripped out. Sample tag data: - - tags => { - AART => "Album Artist", - ALB => "Album", - ART => "Artist", - CMT => "Comments", - COVR => , - CPIL => 1, - DAY => 2009, - DESC => "Video Description", - DISK => "1/2", - "ENCODING PARAMS" => "vers\0\0\0\1acbf\0\0\0\2brat\0\1w\0cdcv\0\1\6\5", - GNRE => "Jazz", - GRP => "Grouping", - ITUNNORM => " 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000", - ITUNSMPB => " 00000000 00000840 000001E4 00000000000001DC 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000", - LYR => "Lyrics", - NAM => "Name", - PGAP => 1, - SOAA => "Sort Album Artist", - SOAL => "Sort Album", - SOAR => "Sort Artist", - SOCO => "Sort Composer", - SONM => "Sort Name", - SOSN => "Sort Show", - TMPO => 120, - TOO => "iTunes 8.1.1, QuickTime 7.6", - TRKN => "1/10", - TVEN => "Episode ID", - TVES => 12, - TVSH => "Show", - TVSN => 12, - WRT => "Composer", - }, - -=head1 AAC (ADTS) - -=head2 INFO - -The following metadata about a file is returned: - - audio_offset - audio_size - bitrate (in bps) - channels - file_size - profile (Main, LC, or SSR) - samplerate (in kHz) - song_length_ms (duration in milliseconds) - dlna_profile (if file is compliant) - -=head1 OGG VORBIS - -=head2 INFO - -The following metadata about a file is returned: - - version - channels - stereo - samplerate (in kHz) - bitrate_average (in bps) - bitrate_upper - bitrate_nominal - bitrate_lower - blocksize_0 - blocksize_1 - audio_offset (byte offset to audio) - audio_size - song_length_ms (duration in milliseconds) - -=head2 TAGS - -Raw Vorbis comments are returned. All comment keys are capitalized. - -=head1 FLAC - -=head2 INFO - -The following metadata about a file is returned: - - channels - samplerate (in kHz) - bitrate (in bps) - file_size - audio_offset (byte offset to first audio frame) - audio_size - song_length_ms (duration in milliseconds) - bits_per_sample - frames - minimum_blocksize - maximum_blocksize - minimum_framesize - maximum_framesize - audio_md5 - total_samples - -=head2 TAGS - -Raw FLAC comments are returned. All comment keys are capitalized. Some data returned is special: - -APPLICATION - - Each application block is returned in the APPLICATION tag keyed by application ID. - -CUESHEET_BLOCK - - The CUESHEET_BLOCK tag is an array containing each line of the cue sheet. - -ALLPICTURES - - Embedded pictures are returned in an ALLPICTURES array. Each picture has the following metadata: - - mime_type - description - width - height - depth - color_index - image_data - picture_type - -=head1 ASF (Windows Media Audio/Video) - -=head2 INFO - -The following metadata about a file may be returned. Reading the ASF spec is encouraged if you -want to find out more about any of these values. - - audio_offset (byte offset to first data packet) - audio_size - broadcast (boolean, whether the file is a live broadcast or not) - codec_list (array of information about codecs used in the file) - creation_date (UNIX timestamp when file was created) - data_packets - drm_key - drm_license_url - drm_protection_type - drm_data - file_id (unique file ID) - file_size - index_blocks - index_entry_interval (in milliseconds) - index_offsets (byte offsets for each second of audio, per stream. Useful for seeking) - index_specifiers (indicates which stream a given index_offset points to) - language_list (array of languages referenced by the file's metadata) - lossless (boolean) - max_bitrate - max_packet_size - min_packet_size - mutex_list (mutually exclusive stream information) - play_duration_ms - preroll - script_commands - script_types - seekable (boolean, whether the file is seekable or not) - send_duration_ms - song_length_ms (the actual length of the audio, in milliseconds) - dlna_profile (if file is compliant) - -STREAMS - -The streams array contains metadata related to an individul stream within the file. -The following metadata may be returned: - - DeviceConformanceTemplate - IsVBR - alt_bitrate - alt_buffer_fullness - alt_buffer_size - avg_bitrate (most accurate bitrate for this stream) - avg_bytes_per_sec (audio only) - bitrate - bits_per_sample (audio only) - block_alignment (audio only) - bpp (video only) - buffer_fullness - buffer_size - channels (audio only) - codec_id (audio only) - compression_id (video only) - encode_options - encrypted (boolean) - error_correction_type - flag_seekable (boolean) - height (video only) - index_type - language_index (offset into language_list array) - max_object_size - samplerate (in kHz) (audio only) - samples_per_block - stream_number - stream_type - super_block_align - time_offset - width (video only) - -=head2 TAGS - -Raw tags are returned. Tags that occur more than once are returned as arrays. -In contrast to the other formats, tag keys are NOT capitalized. There is one special key: - -WM/Picture - -Pictures are returned as a hash with the following keys: - - image_type (numeric type, same as ID3v2 APIC) - mime_type - description - image - -=head1 WAV - -=head2 INFO - -The following metadata about a file may be returned. - - audio_offset - audio_size - bitrate (in bps) - bits_per_sample - block_align - channels - dlna_profile (if file is compliant) - file_size - format (WAV format code, 1 == PCM) - id3_version (if an ID3v2 tag is found) - samplerate (in kHz) - song_length_ms - -=head2 TAGS - -WAV files can contain several different types of tags. "Native" WAV tags -found in a LIST block may include these and others: - - IARL - Archival Location - IART - Artist - ICMS - Commissioned - ICMT - Comment - ICOP - Copyright - ICRD - Creation Date - ICRP - Cropped - IENG - Engineer - IGNR - Genre - IKEY - Keywords - IMED - Medium - INAM - Name (Title) - IPRD - Product (Album) - ISBJ - Subject - ISFT - Software - ISRC - Source - ISRF - Source Form - TORG - Label - LOCA - Location - TVER - Version - TURL - URL - TLEN - Length - ITCH - Technician - TRCK - Track - ITRK - Track - -ID3v2 tags can also be embedded within WAV files. These are returned exactly as for MP3 files. - -=head1 AIFF - -=head2 INFO - -The following metadata about a file may be returned. - - audio_offset - audio_size - bitrate (in bps) - bits_per_sample - block_align - channels - compression_name (if AIFC) - compression_type (if AIFC) - dlna_profile (if file is compliant) - file_size - id3_version (if an ID3v2 tag is found) - samplerate (in kHz) - song_length_ms - -=head2 TAGS - -ID3v2 tags can be embedded within AIFF files. These are returned exactly as for MP3 files. - -=head1 MONKEY'S AUDIO (APE) - -=head2 INFO - -The following metadata about a file may be returned. - - audio_offset - audio_size - bitrate (in bps) - channels - compression - file_size - samplerate (in kHz) - song_length_ms - version - -=head2 TAGS - -APEv2 tags are returned as a hash of key/value pairs. - -=head1 MUSEPACK - -=head2 INFO - -The following metadata about a file may be returned. - - audio_offset - audio_size - bitrate (in bps) - channels - encoder - file_size - profile - samplerate (in kHz) - song_length_ms - -=head2 TAGS - -Musepack uses APEv2 tags. They are returned as a hash of key/value pairs. - -=head1 WAVPACK - -=head2 INFO - -The following metadata about a file may be returned. - - audio_offset - audio_size - bitrate (in bps) - bits_per_sample - channels - encoder_version - file_size - hybrid (1 if file is lossy) (v4 only) - lossless (1 if file is lossless) (v4 only) - samplerate - song_length_ms - total_samples - -=head2 TAGS - -WavPack uses APEv2 tags. They are returned as a hash of key/value pairs. - -=head1 DSF - -=head2 INFO - -The following metadata about a file may be returned. - - audio_offset - audio_size - bits_per_sample - channels - song_length_ms - samplerate - block_size_per_channel - -=head2 TAGS - -ID3v2 tags can be embedded within DSF files. These are returned exactly as for MP3 files. - -=head1 DSDIFF (DFF) - -=head2 INFO - -The following metadata about a file may be returned. - - audio_offset - audio_size - bits_per_sample - channels - song_length_ms - samplerate - tag_diti_title - tag_diar_artist - -=head2 TAGS - -No separate tags are supported by the DSDIFF format. - -=head1 - -=head1 THANKS - -Logitech & Slim Devices, for letting us release so much of our code to the world. -Long live Squeezebox! - -Kimmo Taskinen, Adrian Smith, Clive Messer, and Jurgen Kramer for -DSF/DSDIFF support and various other fixes. - -Some code from the Rockbox project was very helpful in implementing ASF and -MP4 seeking. - -Some of the file format parsing code was derived from the mt-daapd project, -and adapted by Netgear. It has been heavily rewritten to fix bugs and add -more features. - -The source to the original Netgear C scanner for SqueezeCenter is located -at L - -The audio MD5 feature uses an MD5 implementation by L. Peter Deutsch, -Eghost@aladdin.comE. - -=head1 SEE ALSO - -ASF Spec L - -MP4 Info: -L -L - -=head1 AUTHORS - -Andy Grundman, Eandy@hybridized.orgE - -Dan Sully, Edaniel@cpan.orgE - -=head1 COPYRIGHT AND LICENSE - -Copyright (C) 2010-2011 Logitech, Inc. - -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 2 of the License, or -(at your option) any later version. - -=cut diff --git a/CPAN/arch/5.14/MSWin32-x86-multi-thread/Crypt/Blowfish.pm b/CPAN/arch/5.14/MSWin32-x86-multi-thread/Crypt/Blowfish.pm deleted file mode 100755 index 7cbc118f848..00000000000 --- a/CPAN/arch/5.14/MSWin32-x86-multi-thread/Crypt/Blowfish.pm +++ /dev/null @@ -1,194 +0,0 @@ -package Crypt::Blowfish; - -require Exporter; -require DynaLoader; -use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); - -@ISA = qw(Exporter DynaLoader); -# @ISA = qw(Exporter DynaLoader Crypt::BlockCipher); - -# Items to export into callers namespace by default -@EXPORT = qw(); - -# Other items we are prepared to export if requested -@EXPORT_OK = qw( - blocksize keysize min_keysize max_keysize - new encrypt decrypt -); - -$VERSION = '2.14'; -bootstrap Crypt::Blowfish $VERSION; - -use strict; -use Carp; - -sub usage -{ - my ($package, $filename, $line, $subr) = caller(1); - $Carp::CarpLevel = 2; - croak "Usage: $subr(@_)"; -} - - -sub blocksize { 8; } # /* byte my shiny metal.. */ -sub keysize { 0; } # /* we'll leave this at 8 .. for now. */ -sub min_keysize { 8; } -sub max_keysize { 56; } - -sub new -{ - usage("new Blowfish key") unless @_ == 2; - my $type = shift; my $self = {}; bless $self, $type; - $self->{'ks'} = Crypt::Blowfish::init(shift); - return $self; -} - -sub encrypt -{ - usage("encrypt data[8 bytes]") unless @_ == 2; - my ($self,$data) = @_; - Crypt::Blowfish::crypt($data, $data, $self->{'ks'}, 0); - return $data; -} - -sub decrypt -{ - usage("decrypt data[8 bytes]") unless @_ == 2; - my ($self,$data) = @_; - Crypt::Blowfish::crypt($data, $data, $self->{'ks'}, 1); - return $data; -} - -1; - -__END__ -# -# Parts Copyright (C) 1995, 1996 Systemics Ltd (http://www.systemics.com/) -# New Parts Copyright (C) 1999, 2001 W3Works, LLC (http://www.w3works.com/) -# All rights reserved. -# - -=head1 NAME - -Crypt::Blowfish - Perl Blowfish encryption module - -=head1 SYNOPSIS - - use Crypt::Blowfish; - my $cipher = new Crypt::Blowfish $key; - my $ciphertext = $cipher->encrypt($plaintext); - my $plaintext = $cipher->decrypt($ciphertext); - - You probably want to use this in conjunction with - a block chaining module like Crypt::CBC. - -=head1 DESCRIPTION - -Blowfish is capable of strong encryption and can use key sizes up -to 56 bytes (a 448 bit key). You're encouraged to take advantage -of the full key size to ensure the strongest encryption possible -from this module. - -Crypt::Blowfish has the following methods: - -=over 4 - - blocksize() - keysize() - encrypt() - decrypt() - -=back - -=head1 FUNCTIONS - -=over 4 - -=item blocksize - -Returns the size (in bytes) of the block cipher. - -Crypt::Blowfish doesn't return a key size due to its ability -to use variable-length keys. More accurately, it shouldn't, -but it does anyway to play nicely with others. - -=item new - - my $cipher = new Crypt::Blowfish $key; - -This creates a new Crypt::Blowfish BlockCipher object, using $key, -where $key is a key of C bytes (minimum of eight bytes). - -=item encrypt - - my $cipher = new Crypt::Blowfish $key; - my $ciphertext = $cipher->encrypt($plaintext); - -This function encrypts $plaintext and returns the $ciphertext -where $plaintext and $ciphertext must be of C bytes. -(hint: Blowfish is an 8 byte block cipher) - -=item decrypt - - my $cipher = new Crypt::Blowfish $key; - my $plaintext = $cipher->decrypt($ciphertext); - -This function decrypts $ciphertext and returns the $plaintext -where $plaintext and $ciphertext must be of C bytes. -(hint: see previous hint) - -=back - -=head1 EXAMPLE - - my $key = pack("H16", "0123456789ABCDEF"); # min. 8 bytes - my $cipher = new Crypt::Blowfish $key; - my $ciphertext = $cipher->encrypt("plaintex"); # SEE NOTES - print unpack("H16", $ciphertext), "\n"; - -=head1 PLATFORMS - - Please see the README document for platforms and performance - tests. - -=head1 NOTES - -The module is capable of being used with Crypt::CBC. You're -encouraged to read the perldoc for Crypt::CBC if you intend to -use this module for Cipher Block Chaining modes. In fact, if -you have any intentions of encrypting more than eight bytes of -data with this, or any other block cipher, you're going to need -B type of block chaining help. Crypt::CBC tends to be -very good at this. If you're not going to encrypt more than -eight bytes, your data B be B eight bytes long. -If need be, do your own padding. "\0" as a null byte is perfectly -valid to use for this. - -=head1 SEE ALSO - -Crypt::CBC, -Crypt::DES, -Crypt::IDEA - -Bruce Schneier, I, 1995, Second Edition, -published by John Wiley & Sons, Inc. - -=head1 COPYRIGHT - -The implementation of the Blowfish algorithm was developed by, -and is copyright of, A.M. Kuchling. - -Other parts of the perl extension and module are -copyright of Systemics Ltd ( http://www.systemics.com/ ). - -Code revisions, updates, and standalone release are copyright -1999-2010 W3Works, LLC. - -=head1 AUTHOR - -Original algorithm, Bruce Shneier. Original implementation, A.M. -Kuchling. Original Perl implementation, Systemics Ltd. Current -maintenance by W3Works, LLC. - -Current revision and maintainer: Dave Paris - diff --git a/CPAN/arch/5.14/MSWin32-x86-multi-thread/DBD/SQLite.pm b/CPAN/arch/5.14/MSWin32-x86-multi-thread/DBD/SQLite.pm deleted file mode 100755 index a719c10ea75..00000000000 --- a/CPAN/arch/5.14/MSWin32-x86-multi-thread/DBD/SQLite.pm +++ /dev/null @@ -1,2611 +0,0 @@ -package DBD::SQLite; - -use 5.006; -use strict; -use DBI 1.57 (); -use DynaLoader (); - -our $VERSION = '1.58'; -our @ISA = 'DynaLoader'; - -# sqlite_version cache (set in the XS bootstrap) -our ($sqlite_version, $sqlite_version_number); - -# not sure if we still need these... -our ($err, $errstr); - -__PACKAGE__->bootstrap($VERSION); - -# New or old API? -use constant NEWAPI => ($DBI::VERSION >= 1.608); - -# global registry of collation functions, initialized with 2 builtins -our %COLLATION; -tie %COLLATION, 'DBD::SQLite::_WriteOnceHash'; -$COLLATION{perl} = sub { $_[0] cmp $_[1] }; -$COLLATION{perllocale} = sub { use locale; $_[0] cmp $_[1] }; - -our $drh; -my $methods_are_installed = 0; - -sub driver { - return $drh if $drh; - - if (!$methods_are_installed && DBD::SQLite::NEWAPI ) { - DBI->setup_driver('DBD::SQLite'); - - DBD::SQLite::db->install_method('sqlite_last_insert_rowid'); - DBD::SQLite::db->install_method('sqlite_busy_timeout'); - DBD::SQLite::db->install_method('sqlite_create_function'); - DBD::SQLite::db->install_method('sqlite_create_aggregate'); - DBD::SQLite::db->install_method('sqlite_create_collation'); - DBD::SQLite::db->install_method('sqlite_collation_needed'); - DBD::SQLite::db->install_method('sqlite_progress_handler'); - DBD::SQLite::db->install_method('sqlite_commit_hook'); - DBD::SQLite::db->install_method('sqlite_rollback_hook'); - DBD::SQLite::db->install_method('sqlite_update_hook'); - DBD::SQLite::db->install_method('sqlite_set_authorizer'); - DBD::SQLite::db->install_method('sqlite_backup_from_file'); - DBD::SQLite::db->install_method('sqlite_backup_to_file'); - DBD::SQLite::db->install_method('sqlite_enable_load_extension'); - DBD::SQLite::db->install_method('sqlite_load_extension'); - DBD::SQLite::db->install_method('sqlite_register_fts3_perl_tokenizer'); - DBD::SQLite::db->install_method('sqlite_trace', { O => 0x0004 }); - DBD::SQLite::db->install_method('sqlite_profile', { O => 0x0004 }); - DBD::SQLite::db->install_method('sqlite_table_column_metadata', { O => 0x0004 }); - DBD::SQLite::db->install_method('sqlite_db_filename', { O => 0x0004 }); - DBD::SQLite::db->install_method('sqlite_db_status', { O => 0x0004 }); - DBD::SQLite::st->install_method('sqlite_st_status', { O => 0x0004 }); - DBD::SQLite::db->install_method('sqlite_create_module'); - - $methods_are_installed++; - } - - $drh = DBI::_new_drh( "$_[0]::dr", { - Name => 'SQLite', - Version => $VERSION, - Attribution => 'DBD::SQLite by Matt Sergeant et al', - } ); - - return $drh; -} - -sub CLONE { - undef $drh; -} - - -package # hide from PAUSE - DBD::SQLite::dr; - -sub connect { - my ($drh, $dbname, $user, $auth, $attr) = @_; - - # Default PrintWarn to the value of $^W - # unless ( defined $attr->{PrintWarn} ) { - # $attr->{PrintWarn} = $^W ? 1 : 0; - # } - - my $dbh = DBI::_new_dbh( $drh, { - Name => $dbname, - } ); - - my $real = $dbname; - if ( $dbname =~ /=/ ) { - foreach my $attrib ( split(/;/, $dbname) ) { - my ($key, $value) = split(/=/, $attrib, 2); - if ( $key =~ /^(?:db(?:name)?|database)$/ ) { - $real = $value; - } elsif ( $key eq 'uri' ) { - $real = $value; - $attr->{sqlite_open_flags} |= DBD::SQLite::OPEN_URI(); - } else { - $attr->{$key} = $value; - } - } - } - - if (my $flags = $attr->{sqlite_open_flags}) { - unless ($flags & (DBD::SQLite::OPEN_READONLY() | DBD::SQLite::OPEN_READWRITE())) { - $attr->{sqlite_open_flags} |= DBD::SQLite::OPEN_READWRITE() | DBD::SQLite::OPEN_CREATE(); - } - } - - # To avoid unicode and long file name problems on Windows, - # convert to the shortname if the file (or parent directory) exists. - if ( $^O =~ /MSWin32/ and $real ne ':memory:' and $real ne '' and $real !~ /^file:/ and !-f $real ) { - require File::Basename; - my ($file, $dir, $suffix) = File::Basename::fileparse($real); - # We are creating a new file. - # Does the directory it's in at least exist? - if ( -d $dir ) { - require Win32; - $real = join '', grep { defined } Win32::GetShortPathName($dir), $file, $suffix; - } else { - # SQLite can't do mkpath anyway. - # So let it go through as it and fail. - } - } - - # Hand off to the actual login function - DBD::SQLite::db::_login($dbh, $real, $user, $auth, $attr) or return undef; - - # Register the on-demand collation installer, REGEXP function and - # perl tokenizer - if ( DBD::SQLite::NEWAPI ) { - $dbh->sqlite_collation_needed( \&install_collation ); - $dbh->sqlite_create_function( "REGEXP", 2, \®exp ); - $dbh->sqlite_register_fts3_perl_tokenizer(); - } else { - $dbh->func( \&install_collation, "collation_needed" ); - $dbh->func( "REGEXP", 2, \®exp, "create_function" ); - $dbh->func( "register_fts3_perl_tokenizer" ); - } - - # HACK: Since PrintWarn = 0 doesn't seem to actually prevent warnings - # in DBD::SQLite we set Warn to false if PrintWarn is false. - - # NOTE: According to the explanation by timbunce, - # "Warn is meant to report on bad practices or problems with - # the DBI itself (hence always on by default), while PrintWarn - # is meant to report warnings coming from the database." - # That is, if you want to disable an ineffective rollback warning - # etc (due to bad practices), you should turn off Warn, - # and to silence other warnings, turn off PrintWarn. - # Warn and PrintWarn are independent, and turning off PrintWarn - # does not silence those warnings that should be controlled by - # Warn. - - # unless ( $attr->{PrintWarn} ) { - # $attr->{Warn} = 0; - # } - - return $dbh; -} - -sub install_collation { - my $dbh = shift; - my $name = shift; - my $collation = $DBD::SQLite::COLLATION{$name}; - unless ($collation) { - warn "Can't install unknown collation: $name" if $dbh->{PrintWarn}; - return; - } - if ( DBD::SQLite::NEWAPI ) { - $dbh->sqlite_create_collation( $name => $collation ); - } else { - $dbh->func( $name => $collation, "create_collation" ); - } -} - -# default implementation for sqlite 'REGEXP' infix operator. -# Note : args are reversed, i.e. "a REGEXP b" calls REGEXP(b, a) -# (see http://www.sqlite.org/vtab.html#xfindfunction) -sub regexp { - use locale; - return if !defined $_[0] || !defined $_[1]; - return scalar($_[1] =~ $_[0]); -} - -package # hide from PAUSE - DBD::SQLite::db; - -sub prepare { - my $dbh = shift; - my $sql = shift; - $sql = '' unless defined $sql; - - my $sth = DBI::_new_sth( $dbh, { - Statement => $sql, - } ); - - DBD::SQLite::st::_prepare($sth, $sql, @_) or return undef; - - return $sth; -} - -sub do { - my ($dbh, $statement, $attr, @bind_values) = @_; - - # shortcut - my $allow_multiple_statements = $dbh->FETCH('sqlite_allow_multiple_statements'); - if (defined $statement && !defined $attr && !@bind_values) { - # _do() (i.e. sqlite3_exec()) runs semicolon-separate SQL - # statements, which is handy but insecure sometimes. - # Use this only when it's safe or explicitly allowed. - if (index($statement, ';') == -1 or $allow_multiple_statements) { - return DBD::SQLite::db::_do($dbh, $statement); - } - } - - my @copy = @{[@bind_values]}; - my $rows = 0; - - while ($statement) { - my $sth = $dbh->prepare($statement, $attr) or return undef; - $sth->execute(splice @copy, 0, $sth->{NUM_OF_PARAMS}) or return undef; - $rows += $sth->rows; - # XXX: not sure why but $dbh->{sqlite...} wouldn't work here - last unless $allow_multiple_statements; - $statement = $sth->{sqlite_unprepared_statements}; - } - - # always return true if no error - return ($rows == 0) ? "0E0" : $rows; -} - -sub ping { - my $dbh = shift; - - # $file may be undef (ie. in-memory/temporary database) - my $file = DBD::SQLite::NEWAPI ? $dbh->sqlite_db_filename - : $dbh->func("db_filename"); - - return 0 if $file && !-f $file; - return $dbh->FETCH('Active') ? 1 : 0; -} - -sub _get_version { - return ( DBD::SQLite::db::FETCH($_[0], 'sqlite_version') ); -} - -my %info = ( - 17 => 'SQLite', # SQL_DBMS_NAME - 18 => \&_get_version, # SQL_DBMS_VER - 29 => '"', # SQL_IDENTIFIER_QUOTE_CHAR -); - -sub get_info { - my($dbh, $info_type) = @_; - my $v = $info{int($info_type)}; - $v = $v->($dbh) if ref $v eq 'CODE'; - return $v; -} - -sub _attached_database_list { - my $dbh = shift; - my @attached; - - my $sth_databases = $dbh->prepare( 'PRAGMA database_list' ) or return; - $sth_databases->execute or return; - while ( my $db_info = $sth_databases->fetchrow_hashref ) { - push @attached, $db_info->{name} if $db_info->{seq} >= 2; - } - return @attached; -} - -# SQL/CLI (ISO/IEC JTC 1/SC 32 N 0595), 6.63 Tables -# Based on DBD::Oracle's -# See also http://www.ch-werner.de/sqliteodbc/html/sqlite3odbc_8c.html#a213 -sub table_info { - my ($dbh, $cat_val, $sch_val, $tbl_val, $typ_val, $attr) = @_; - - my @where = (); - my $sql; - if ( defined($cat_val) && $cat_val eq '%' - && defined($sch_val) && $sch_val eq '' - && defined($tbl_val) && $tbl_val eq '') { # Rule 19a - $sql = <<'END_SQL'; -SELECT NULL TABLE_CAT - , NULL TABLE_SCHEM - , NULL TABLE_NAME - , NULL TABLE_TYPE - , NULL REMARKS -END_SQL - } - elsif ( defined($cat_val) && $cat_val eq '' - && defined($sch_val) && $sch_val eq '%' - && defined($tbl_val) && $tbl_val eq '') { # Rule 19b - $sql = <<'END_SQL'; -SELECT NULL TABLE_CAT - , t.tn TABLE_SCHEM - , NULL TABLE_NAME - , NULL TABLE_TYPE - , NULL REMARKS -FROM ( - SELECT 'main' tn - UNION SELECT 'temp' tn -END_SQL - for my $db_name (_attached_database_list($dbh)) { - $sql .= " UNION SELECT '$db_name' tn\n"; - } - $sql .= ") t\n"; - } - elsif ( defined($cat_val) && $cat_val eq '' - && defined($sch_val) && $sch_val eq '' - && defined($tbl_val) && $tbl_val eq '' - && defined($typ_val) && $typ_val eq '%') { # Rule 19c - $sql = <<'END_SQL'; -SELECT NULL TABLE_CAT - , NULL TABLE_SCHEM - , NULL TABLE_NAME - , t.tt TABLE_TYPE - , NULL REMARKS -FROM ( - SELECT 'TABLE' tt UNION - SELECT 'VIEW' tt UNION - SELECT 'LOCAL TEMPORARY' tt UNION - SELECT 'SYSTEM TABLE' tt -) t -ORDER BY TABLE_TYPE -END_SQL - } - else { - $sql = <<'END_SQL'; -SELECT * -FROM -( -SELECT NULL TABLE_CAT - , TABLE_SCHEM - , tbl_name TABLE_NAME - , TABLE_TYPE - , NULL REMARKS - , sql sqlite_sql -FROM ( - SELECT 'main' TABLE_SCHEM, tbl_name, upper(type) TABLE_TYPE, sql - FROM sqlite_master -UNION ALL - SELECT 'temp' TABLE_SCHEM, tbl_name, 'LOCAL TEMPORARY' TABLE_TYPE, sql - FROM sqlite_temp_master -END_SQL - - for my $db_name (_attached_database_list($dbh)) { - $sql .= <<"END_SQL"; -UNION ALL - SELECT '$db_name' TABLE_SCHEM, tbl_name, upper(type) TABLE_TYPE, sql - FROM "$db_name".sqlite_master -END_SQL - } - - $sql .= <<'END_SQL'; -UNION ALL - SELECT 'main' TABLE_SCHEM, 'sqlite_master' tbl_name, 'SYSTEM TABLE' TABLE_TYPE, NULL sql -UNION ALL - SELECT 'temp' TABLE_SCHEM, 'sqlite_temp_master' tbl_name, 'SYSTEM TABLE' TABLE_TYPE, NULL sql -) -) -END_SQL - $attr = {} unless ref $attr eq 'HASH'; - my $escape = defined $attr->{Escape} ? " ESCAPE '$attr->{Escape}'" : ''; - if ( defined $sch_val ) { - push @where, "TABLE_SCHEM LIKE '$sch_val'$escape"; - } - if ( defined $tbl_val ) { - push @where, "TABLE_NAME LIKE '$tbl_val'$escape"; - } - if ( defined $typ_val ) { - my $table_type_list; - $typ_val =~ s/^\s+//; - $typ_val =~ s/\s+$//; - my @ttype_list = split (/\s*,\s*/, $typ_val); - foreach my $table_type (@ttype_list) { - if ($table_type !~ /^'.*'$/) { - $table_type = "'" . $table_type . "'"; - } - } - $table_type_list = join(', ', @ttype_list); - push @where, "TABLE_TYPE IN (\U$table_type_list)" if $table_type_list; - } - $sql .= ' WHERE ' . join("\n AND ", @where ) . "\n" if @where; - $sql .= " ORDER BY TABLE_TYPE, TABLE_SCHEM, TABLE_NAME\n"; - } - my $sth = $dbh->prepare($sql) or return undef; - $sth->execute or return undef; - $sth; -} - -sub primary_key_info { - my ($dbh, $catalog, $schema, $table, $attr) = @_; - - my $databases = $dbh->selectall_arrayref("PRAGMA database_list", {Slice => {}}); - - my @pk_info; - for my $database (@$databases) { - my $dbname = $database->{name}; - next if defined $schema && $schema ne '%' && $schema ne $dbname; - - my $quoted_dbname = $dbh->quote_identifier($dbname); - - my $master_table = - ($dbname eq 'main') ? 'sqlite_master' : - ($dbname eq 'temp') ? 'sqlite_temp_master' : - $quoted_dbname.'.sqlite_master'; - - my $sth = $dbh->prepare("SELECT name, sql FROM $master_table WHERE type = ?") or return; - $sth->execute("table") or return; - while(my $row = $sth->fetchrow_hashref) { - my $tbname = $row->{name}; - next if defined $table && $table ne '%' && $table ne $tbname; - - my $quoted_tbname = $dbh->quote_identifier($tbname); - my $t_sth = $dbh->prepare("PRAGMA $quoted_dbname.table_info($quoted_tbname)") or return; - $t_sth->execute or return; - my @pk; - while(my $col = $t_sth->fetchrow_hashref) { - push @pk, $col->{name} if $col->{pk}; - } - - # If there're multiple primary key columns, we need to - # find their order from one of the auto-generated unique - # indices (note that single column integer primary key - # doesn't create an index). - if (@pk > 1 and $row->{sql} =~ /\bPRIMARY\s+KEY\s*\(\s* - ( - (?: - ( - [a-z_][a-z0-9_]* - | (["'`])(?:\3\3|(?!\3).)+?\3(?!\3) - | \[[^\]]+\] - ) - \s*,\s* - )+ - ( - [a-z_][a-z0-9_]* - | (["'`])(?:\5\5|(?!\5).)+?\5(?!\5) - | \[[^\]]+\] - ) - ) - \s*\)/six) { - my $pk_sql = $1; - @pk = (); - while($pk_sql =~ / - ( - [a-z_][a-z0-9_]* - | (["'`])(?:\2\2|(?!\2).)+?\2(?!\2) - | \[([^\]]+)\] - ) - (?:\s*,\s*|$) - /sixg) { - my($col, $quote, $brack) = ($1, $2, $3); - if ( defined $quote ) { - # Dequote "'` - $col = substr $col, 1, -1; - $col =~ s/$quote$quote/$quote/g; - } elsif ( defined $brack ) { - # Dequote [] - $col = $brack; - } - push @pk, $col; - } - } - - my $key_name = $row->{sql} =~ /\bCONSTRAINT\s+(\S+|"[^"]+")\s+PRIMARY\s+KEY\s*\(/i ? $1 : 'PRIMARY KEY'; - my $key_seq = 0; - foreach my $pk_field (@pk) { - push @pk_info, { - TABLE_SCHEM => $dbname, - TABLE_NAME => $tbname, - COLUMN_NAME => $pk_field, - KEY_SEQ => ++$key_seq, - PK_NAME => $key_name, - }; - } - } - } - - my $sponge = DBI->connect("DBI:Sponge:", '','') - or return $dbh->DBI::set_err($DBI::err, "DBI::Sponge: $DBI::errstr"); - my @names = qw(TABLE_CAT TABLE_SCHEM TABLE_NAME COLUMN_NAME KEY_SEQ PK_NAME); - my $sth = $sponge->prepare( "primary_key_info", { - rows => [ map { [ @{$_}{@names} ] } @pk_info ], - NUM_OF_FIELDS => scalar @names, - NAME => \@names, - }) or return $dbh->DBI::set_err( - $sponge->err, - $sponge->errstr, - ); - return $sth; -} - - -our %DBI_code_for_rule = ( # from DBI doc; curiously, they are not exported - # by the DBI module. - # codes for update/delete constraints - 'CASCADE' => 0, - 'RESTRICT' => 1, - 'SET NULL' => 2, - 'NO ACTION' => 3, - 'SET DEFAULT' => 4, - - # codes for deferrability - 'INITIALLY DEFERRED' => 5, - 'INITIALLY IMMEDIATE' => 6, - 'NOT DEFERRABLE' => 7, - ); - - -my @FOREIGN_KEY_INFO_ODBC = ( - 'PKTABLE_CAT', # The primary (unique) key table catalog identifier. - 'PKTABLE_SCHEM', # The primary (unique) key table schema identifier. - 'PKTABLE_NAME', # The primary (unique) key table identifier. - 'PKCOLUMN_NAME', # The primary (unique) key column identifier. - 'FKTABLE_CAT', # The foreign key table catalog identifier. - 'FKTABLE_SCHEM', # The foreign key table schema identifier. - 'FKTABLE_NAME', # The foreign key table identifier. - 'FKCOLUMN_NAME', # The foreign key column identifier. - 'KEY_SEQ', # The column sequence number (starting with 1). - 'UPDATE_RULE', # The referential action for the UPDATE rule. - 'DELETE_RULE', # The referential action for the DELETE rule. - 'FK_NAME', # The foreign key name. - 'PK_NAME', # The primary (unique) key name. - 'DEFERRABILITY', # The deferrability of the foreign key constraint. - 'UNIQUE_OR_PRIMARY', # qualifies the key referenced by the foreign key -); - -# Column names below are not used, but listed just for completeness's sake. -# Maybe we could add an option so that the user can choose which field -# names will be returned; the DBI spec is not very clear about ODBC vs. CLI. -my @FOREIGN_KEY_INFO_SQL_CLI = qw( - UK_TABLE_CAT - UK_TABLE_SCHEM - UK_TABLE_NAME - UK_COLUMN_NAME - FK_TABLE_CAT - FK_TABLE_SCHEM - FK_TABLE_NAME - FK_COLUMN_NAME - ORDINAL_POSITION - UPDATE_RULE - DELETE_RULE - FK_NAME - UK_NAME - DEFERABILITY - UNIQUE_OR_PRIMARY - ); - -sub foreign_key_info { - my ($dbh, $pk_catalog, $pk_schema, $pk_table, $fk_catalog, $fk_schema, $fk_table) = @_; - - my $databases = $dbh->selectall_arrayref("PRAGMA database_list", {Slice => {}}) or return; - - my @fk_info; - my %table_info; - for my $database (@$databases) { - my $dbname = $database->{name}; - next if defined $fk_schema && $fk_schema ne '%' && $fk_schema ne $dbname; - - my $quoted_dbname = $dbh->quote_identifier($dbname); - my $master_table = - ($dbname eq 'main') ? 'sqlite_master' : - ($dbname eq 'temp') ? 'sqlite_temp_master' : - $quoted_dbname.'.sqlite_master'; - - my $tables = $dbh->selectall_arrayref("SELECT name FROM $master_table WHERE type = ?", undef, "table") or return; - for my $table (@$tables) { - my $tbname = $table->[0]; - next if defined $fk_table && $fk_table ne '%' && $fk_table ne $tbname; - - my $quoted_tbname = $dbh->quote_identifier($tbname); - my $sth = $dbh->prepare("PRAGMA $quoted_dbname.foreign_key_list($quoted_tbname)") or return; - $sth->execute or return; - while(my $row = $sth->fetchrow_hashref) { - next if defined $pk_table && $pk_table ne '%' && $pk_table ne $row->{table}; - - unless ($table_info{$row->{table}}) { - my $quoted_tb = $dbh->quote_identifier($row->{table}); - for my $db (@$databases) { - my $quoted_db = $dbh->quote_identifier($db->{name}); - my $t_sth = $dbh->prepare("PRAGMA $quoted_db.table_info($quoted_tb)") or return; - $t_sth->execute or return; - my $cols = {}; - while(my $r = $t_sth->fetchrow_hashref) { - $cols->{$r->{name}} = $r->{pk}; - } - if (keys %$cols) { - $table_info{$row->{table}} = { - schema => $db->{name}, - columns => $cols, - }; - last; - } - } - } - - next if defined $pk_schema && $pk_schema ne '%' && $pk_schema ne $table_info{$row->{table}}{schema}; - - push @fk_info, { - PKTABLE_CAT => undef, - PKTABLE_SCHEM => $table_info{$row->{table}}{schema}, - PKTABLE_NAME => $row->{table}, - PKCOLUMN_NAME => $row->{to}, - FKTABLE_CAT => undef, - FKTABLE_SCHEM => $dbname, - FKTABLE_NAME => $tbname, - FKCOLUMN_NAME => $row->{from}, - KEY_SEQ => $row->{seq} + 1, - UPDATE_RULE => $DBI_code_for_rule{$row->{on_update}}, - DELETE_RULE => $DBI_code_for_rule{$row->{on_delete}}, - FK_NAME => undef, - PK_NAME => undef, - DEFERRABILITY => undef, - UNIQUE_OR_PRIMARY => $table_info{$row->{table}}{columns}{$row->{to}} ? 'PRIMARY' : 'UNIQUE', - }; - } - } - } - - my $sponge_dbh = DBI->connect("DBI:Sponge:", "", "") - or return $dbh->DBI::set_err($DBI::err, "DBI::Sponge: $DBI::errstr"); - my $sponge_sth = $sponge_dbh->prepare("foreign_key_info", { - NAME => \@FOREIGN_KEY_INFO_ODBC, - rows => [ map { [@{$_}{@FOREIGN_KEY_INFO_ODBC} ] } @fk_info ], - NUM_OF_FIELDS => scalar(@FOREIGN_KEY_INFO_ODBC), - }) or return $dbh->DBI::set_err( - $sponge_dbh->err, - $sponge_dbh->errstr, - ); - return $sponge_sth; -} - -my @STATISTICS_INFO_ODBC = ( - 'TABLE_CAT', # The catalog identifier. - 'TABLE_SCHEM', # The schema identifier. - 'TABLE_NAME', # The table identifier. - 'NON_UNIQUE', # Unique index indicator. - 'INDEX_QUALIFIER', # Index qualifier identifier. - 'INDEX_NAME', # The index identifier. - 'TYPE', # The type of information being returned. - 'ORDINAL_POSITION', # Column sequence number (starting with 1). - 'COLUMN_NAME', # The column identifier. - 'ASC_OR_DESC', # Column sort sequence. - 'CARDINALITY', # Cardinality of the table or index. - 'PAGES', # Number of storage pages used by this table or index. - 'FILTER_CONDITION', # The index filter condition as a string. -); - -sub statistics_info { - my ($dbh, $catalog, $schema, $table, $unique_only, $quick) = @_; - - my $databases = $dbh->selectall_arrayref("PRAGMA database_list", {Slice => {}}) or return; - - my @statistics_info; - for my $database (@$databases) { - my $dbname = $database->{name}; - next if defined $schema && $schema ne '%' && $schema ne $dbname; - - my $quoted_dbname = $dbh->quote_identifier($dbname); - my $master_table = - ($dbname eq 'main') ? 'sqlite_master' : - ($dbname eq 'temp') ? 'sqlite_temp_master' : - $quoted_dbname.'.sqlite_master'; - - my $tables = $dbh->selectall_arrayref("SELECT name FROM $master_table WHERE type = ?", undef, "table") or return; - for my $table_ref (@$tables) { - my $tbname = $table_ref->[0]; - next if defined $table && $table ne '%' && uc($table) ne uc($tbname); - - my $quoted_tbname = $dbh->quote_identifier($tbname); - my $sth = $dbh->prepare("PRAGMA $quoted_dbname.index_list($quoted_tbname)") or return; - $sth->execute or return; - while(my $row = $sth->fetchrow_hashref) { - - next if $unique_only && !$row->{unique}; - my $quoted_idx = $dbh->quote_identifier($row->{name}); - for my $db (@$databases) { - my $quoted_db = $dbh->quote_identifier($db->{name}); - my $i_sth = $dbh->prepare("PRAGMA $quoted_db.index_info($quoted_idx)") or return; - $i_sth->execute or return; - my $cols = {}; - while(my $info = $i_sth->fetchrow_hashref) { - push @statistics_info, { - TABLE_CAT => undef, - TABLE_SCHEM => $db->{name}, - TABLE_NAME => $tbname, - NON_UNIQUE => $row->{unique} ? 0 : 1, - INDEX_QUALIFIER => undef, - INDEX_NAME => $row->{name}, - TYPE => 'btree', # see http://www.sqlite.org/version3.html esp. "Traditional B-trees are still used for indices" - ORDINAL_POSITION => $info->{seqno} + 1, - COLUMN_NAME => $info->{name}, - ASC_OR_DESC => undef, - CARDINALITY => undef, - PAGES => undef, - FILTER_CONDITION => undef, - }; - } - } - } - } - } - - my $sponge_dbh = DBI->connect("DBI:Sponge:", "", "") - or return $dbh->DBI::set_err($DBI::err, "DBI::Sponge: $DBI::errstr"); - my $sponge_sth = $sponge_dbh->prepare("statistics_info", { - NAME => \@STATISTICS_INFO_ODBC, - rows => [ map { [@{$_}{@STATISTICS_INFO_ODBC} ] } @statistics_info ], - NUM_OF_FIELDS => scalar(@STATISTICS_INFO_ODBC), - }) or return $dbh->DBI::set_err( - $sponge_dbh->err, - $sponge_dbh->errstr, - ); - return $sponge_sth; -} - -sub type_info_all { - return; # XXX code just copied from DBD::Oracle, not yet thought about -# return [ -# { -# TYPE_NAME => 0, -# DATA_TYPE => 1, -# COLUMN_SIZE => 2, -# LITERAL_PREFIX => 3, -# LITERAL_SUFFIX => 4, -# CREATE_PARAMS => 5, -# NULLABLE => 6, -# CASE_SENSITIVE => 7, -# SEARCHABLE => 8, -# UNSIGNED_ATTRIBUTE => 9, -# FIXED_PREC_SCALE => 10, -# AUTO_UNIQUE_VALUE => 11, -# LOCAL_TYPE_NAME => 12, -# MINIMUM_SCALE => 13, -# MAXIMUM_SCALE => 14, -# SQL_DATA_TYPE => 15, -# SQL_DATETIME_SUB => 16, -# NUM_PREC_RADIX => 17, -# }, -# [ 'CHAR', 1, 255, '\'', '\'', 'max length', 1, 1, 3, -# undef, '0', '0', undef, undef, undef, 1, undef, undef -# ], -# [ 'NUMBER', 3, 38, undef, undef, 'precision,scale', 1, '0', 3, -# '0', '0', '0', undef, '0', 38, 3, undef, 10 -# ], -# [ 'DOUBLE', 8, 15, undef, undef, undef, 1, '0', 3, -# '0', '0', '0', undef, undef, undef, 8, undef, 10 -# ], -# [ 'DATE', 9, 19, '\'', '\'', undef, 1, '0', 3, -# undef, '0', '0', undef, '0', '0', 11, undef, undef -# ], -# [ 'VARCHAR', 12, 1024*1024, '\'', '\'', 'max length', 1, 1, 3, -# undef, '0', '0', undef, undef, undef, 12, undef, undef -# ] -# ]; -} - -my @COLUMN_INFO = qw( - TABLE_CAT - TABLE_SCHEM - TABLE_NAME - COLUMN_NAME - DATA_TYPE - TYPE_NAME - COLUMN_SIZE - BUFFER_LENGTH - DECIMAL_DIGITS - NUM_PREC_RADIX - NULLABLE - REMARKS - COLUMN_DEF - SQL_DATA_TYPE - SQL_DATETIME_SUB - CHAR_OCTET_LENGTH - ORDINAL_POSITION - IS_NULLABLE -); - -sub column_info { - my ($dbh, $cat_val, $sch_val, $tbl_val, $col_val) = @_; - - if ( defined $col_val and $col_val eq '%' ) { - $col_val = undef; - } - - # Get a list of all tables ordered by TABLE_SCHEM, TABLE_NAME - my $sql = <<'END_SQL'; -SELECT TABLE_SCHEM, tbl_name TABLE_NAME -FROM ( - SELECT 'main' TABLE_SCHEM, tbl_name - FROM sqlite_master - WHERE type IN ('table','view') -UNION ALL - SELECT 'temp' TABLE_SCHEM, tbl_name - FROM sqlite_temp_master - WHERE type IN ('table','view') -END_SQL - - for my $db_name (_attached_database_list($dbh)) { - $sql .= <<"END_SQL"; -UNION ALL - SELECT '$db_name' TABLE_SCHEM, tbl_name - FROM "$db_name".sqlite_master - WHERE type IN ('table','view') -END_SQL - } - - $sql .= <<'END_SQL'; -UNION ALL - SELECT 'main' TABLE_SCHEM, 'sqlite_master' tbl_name -UNION ALL - SELECT 'temp' TABLE_SCHEM, 'sqlite_temp_master' tbl_name -) -END_SQL - - my @where; - if ( defined $sch_val ) { - push @where, "TABLE_SCHEM LIKE '$sch_val'"; - } - if ( defined $tbl_val ) { - push @where, "TABLE_NAME LIKE '$tbl_val'"; - } - $sql .= ' WHERE ' . join("\n AND ", @where ) . "\n" if @where; - $sql .= " ORDER BY TABLE_SCHEM, TABLE_NAME\n"; - my $sth_tables = $dbh->prepare($sql) or return undef; - $sth_tables->execute or return undef; - - # Taken from Fey::Loader::SQLite - my @cols; - while ( my ($schema, $table) = $sth_tables->fetchrow_array ) { - my $sth_columns = $dbh->prepare(qq{PRAGMA "$schema".table_info("$table")}) or return; - $sth_columns->execute or return; - - for ( my $position = 1; my $col_info = $sth_columns->fetchrow_hashref; $position++ ) { - if ( defined $col_val ) { - # This must do a LIKE comparison - my $sth = $dbh->prepare("SELECT '$col_info->{name}' LIKE '$col_val'") or return undef; - $sth->execute or return undef; - # Skip columns that don't match $col_val - next unless ($sth->fetchrow_array)[0]; - } - - my %col = ( - TABLE_SCHEM => $schema, - TABLE_NAME => $table, - COLUMN_NAME => $col_info->{name}, - ORDINAL_POSITION => $position, - ); - - my $type = $col_info->{type}; - if ( $type =~ s/(\w+)\s*\(\s*(\d+)(?:\s*,\s*(\d+))?\s*\)/$1/ ) { - $col{COLUMN_SIZE} = $2; - $col{DECIMAL_DIGITS} = $3; - } - - $col{TYPE_NAME} = $type; - - if ( defined $col_info->{dflt_value} ) { - $col{COLUMN_DEF} = $col_info->{dflt_value} - } - - if ( $col_info->{notnull} ) { - $col{NULLABLE} = 0; - $col{IS_NULLABLE} = 'NO'; - } else { - $col{NULLABLE} = 1; - $col{IS_NULLABLE} = 'YES'; - } - - push @cols, \%col; - } - $sth_columns->finish; - } - $sth_tables->finish; - - my $sponge = DBI->connect("DBI:Sponge:", '','') - or return $dbh->DBI::set_err($DBI::err, "DBI::Sponge: $DBI::errstr"); - $sponge->prepare( "column_info", { - rows => [ map { [ @{$_}{@COLUMN_INFO} ] } @cols ], - NUM_OF_FIELDS => scalar @COLUMN_INFO, - NAME => [ @COLUMN_INFO ], - } ) or return $dbh->DBI::set_err( - $sponge->err, - $sponge->errstr, - ); -} - -#====================================================================== -# An internal tied hash package used for %DBD::SQLite::COLLATION, to -# prevent people from unintentionally overriding globally registered collations. - -package # hide from PAUSE - DBD::SQLite::_WriteOnceHash; - -require Tie::Hash; - -our @ISA = qw(Tie::StdHash); - -sub TIEHASH { - bless {}, $_[0]; -} - -sub STORE { - ! exists $_[0]->{$_[1]} or die "entry $_[1] already registered"; - $_[0]->{$_[1]} = $_[2]; -} - -sub DELETE { - die "deletion of entry $_[1] is forbidden"; -} - -1; - -__END__ - -=pod - -=encoding utf-8 - -=head1 NAME - -DBD::SQLite - Self-contained RDBMS in a DBI Driver - -=head1 SYNOPSIS - - use DBI; - my $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile","",""); - -=head1 DESCRIPTION - -SQLite is a public domain file-based relational database engine that -you can find at L. - -B is a Perl DBI driver for SQLite, that includes -the entire thing in the distribution. -So in order to get a fast transaction capable RDBMS working for your -perl project you simply have to install this module, and B -else. - -SQLite supports the following features: - -=over 4 - -=item Implements a large subset of SQL92 - -See L for details. - -=item A complete DB in a single disk file - -Everything for your database is stored in a single disk file, making it -easier to move things around than with L. - -=item Atomic commit and rollback - -Yes, B is small and light, but it supports full transactions! - -=item Extensible - -User-defined aggregate or regular functions can be registered with the -SQL parser. - -=back - -There's lots more to it, so please refer to the docs on the SQLite web -page, listed above, for SQL details. Also refer to L for details -on how to use DBI itself. The API works like every DBI module does. -However, currently many statement attributes are not implemented or -are limited by the typeless nature of the SQLite database. - -=head1 SQLITE VERSION - -DBD::SQLite is usually compiled with a bundled SQLite library -(SQLite version S<3.22.0> as of this release) for consistency. -However, a different version of SQLite may sometimes be used for -some reasons like security, or some new experimental features. - -You can look at C<$DBD::SQLite::sqlite_version> (C<3.x.y> format) or -C<$DBD::SQLite::sqlite_version_number> (C<3xxxyyy> format) -to find which version of SQLite is actually used. You can also -check C. - -You can also find how the library is compiled by calling -C (see below). - -=head1 NOTABLE DIFFERENCES FROM OTHER DRIVERS - -=head2 Database Name Is A File Name - -SQLite creates a file per a database. You should pass the C of -the database file (with or without a parent directory) in the DBI -connection string (as a database C): - - my $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile","",""); - -The file is opened in read/write mode, and will be created if -it does not exist yet. - -Although the database is stored in a single file, the directory -containing the database file must be writable by SQLite because the -library will create several temporary files there. - -If the filename C<$dbfile> is ":memory:", then a private, temporary -in-memory database is created for the connection. This in-memory -database will vanish when the database connection is closed. -It is handy for your library tests. - -Note that future versions of SQLite might make use of additional -special filenames that begin with the ":" character. It is recommended -that when a database filename actually does begin with a ":" character -you should prefix the filename with a pathname such as "./" to avoid -ambiguity. - -If the filename C<$dbfile> is an empty string, then a private, -temporary on-disk database will be created. This private database will -be automatically deleted as soon as the database connection is closed. - -As of 1.41_01, you can pass URI filename (see L) -as well for finer control: - - my $dbh = DBI->connect("dbi:SQLite:uri=file:$path_to_dbfile?mode=rwc"); - -Note that this is not for remote SQLite database connection. You can -only connect to a local database. - -=head2 Read-Only Database - -You can set sqlite_open_flags (only) when you connect to a database: - - use DBD::SQLite::Constants qw/:file_open/; - my $dbh = DBI->connect("dbi:SQLite:$dbfile", undef, undef, { - sqlite_open_flags => SQLITE_OPEN_READONLY, - }); - -See L for details. - -As of 1.49_05, you can also make a database read-only by setting -C attribute to true (only) when you connect to a database. -Actually you can set it after you connect, but in that case, it -can't make the database read-only, and you'll see a warning (which -you can hide by turning C off). - -=head2 DBD::SQLite And File::Temp - -When you use L to create a temporary file/directory for -SQLite databases, you need to remember: - -=over 4 - -=item tempfile may be locked exclusively - -You may want to use C to create a temporary database -filename for DBD::SQLite, but as noted in L's POD, -this file may have an exclusive lock under some operating systems -(notably Mac OSX), and result in a "database is locked" error. -To avoid this, set EXLOCK option to false when you call tempfile(). - - ($fh, $filename) = tempfile($template, EXLOCK => 0); - -=item CLEANUP may not work unless a database is disconnected - -When you set CLEANUP option to true when you create a temporary -directory with C or C, you may have to -disconnect databases explicitly before the temporary directory -is gone (notably under MS Windows). - -=back - -(The above is quoted from the pod of File::Temp.) - -If you don't need to keep or share a temporary database, -use ":memory:" database instead. It's much handier and cleaner -for ordinary testing. - -=head2 DBD::SQLite and fork() - -Follow the advice in the SQLite FAQ (L). - -=over 4 - -Under Unix, you should not carry an open SQLite database across -a fork() system call into the child process. Problems will result -if you do. - -=back - -You shouldn't (re)use a database handle you created (probably to -set up a database schema etc) before you fork(). Otherwise, you -might see a database corruption in the worst case. - -If you need to fork(), (re)open a database after you fork(). -You might also want to tweak C and -C (see below), depending -on your needs. - -If you need a higher level of concurrency than SQLite supports, -consider using other client/server database engines. - -=head2 Accessing A Database With Other Tools - -To access the database from the command line, try using C -which comes with the L module. Just type: - - dbish dbi:SQLite:foo.db - -On the command line to access the file F. - -Alternatively you can install SQLite from the link above without -conflicting with B and use the supplied C -command line tool. - -=head2 Blobs - -As of version 1.11, blobs should "just work" in SQLite as text columns. -However this will cause the data to be treated as a string, so SQL -statements such as length(x) will return the length of the column as a NUL -terminated string, rather than the size of the blob in bytes. In order to -store natively as a BLOB use the following code: - - use DBI qw(:sql_types); - my $dbh = DBI->connect("dbi:SQLite:dbfile","",""); - - my $blob = `cat foo.jpg`; - my $sth = $dbh->prepare("INSERT INTO mytable VALUES (1, ?)"); - $sth->bind_param(1, $blob, SQL_BLOB); - $sth->execute(); - -And then retrieval just works: - - $sth = $dbh->prepare("SELECT * FROM mytable WHERE id = 1"); - $sth->execute(); - my $row = $sth->fetch; - my $blobo = $row->[1]; - - # now $blobo == $blob - -=head2 Functions And Bind Parameters - -As of this writing, a SQL that compares a return value of a function -with a numeric bind value like this doesn't work as you might expect. - - my $sth = $dbh->prepare(q{ - SELECT bar FROM foo GROUP BY bar HAVING count(*) > ?; - }); - $sth->execute(5); - -This is because DBD::SQLite assumes that all the bind values are text -(and should be quoted) by default. Thus the above statement becomes -like this while executing: - - SELECT bar FROM foo GROUP BY bar HAVING count(*) > "5"; - -There are three workarounds for this. - -=over 4 - -=item Use bind_param() explicitly - -As shown above in the C section, you can always use -C to tell the type of a bind value. - - use DBI qw(:sql_types); # Don't forget this - - my $sth = $dbh->prepare(q{ - SELECT bar FROM foo GROUP BY bar HAVING count(*) > ?; - }); - $sth->bind_param(1, 5, SQL_INTEGER); - $sth->execute(); - -=item Add zero to make it a number - -This is somewhat weird, but works anyway. - - my $sth = $dbh->prepare(q{ - SELECT bar FROM foo GROUP BY bar HAVING count(*) > (? + 0); - }); - $sth->execute(5); - -=item Set C database handle attribute - -As of version 1.32_02, you can use C -to let DBD::SQLite to see if the bind values are numbers or not. - - $dbh->{sqlite_see_if_its_a_number} = 1; - my $sth = $dbh->prepare(q{ - SELECT bar FROM foo GROUP BY bar HAVING count(*) > ?; - }); - $sth->execute(5); - -You can set it to true when you connect to a database. - - my $dbh = DBI->connect('dbi:SQLite:foo', undef, undef, { - AutoCommit => 1, - RaiseError => 1, - sqlite_see_if_its_a_number => 1, - }); - -This is the most straightforward solution, but as noted above, -existing data in your databases created by DBD::SQLite have not -always been stored as numbers, so this *might* cause other obscure -problems. Use this sparingly when you handle existing databases. -If you handle databases created by other tools like native C -command line tool, this attribute would help you. - -As of 1.41_04, C works only for -bind values with no explicit type. - - my $dbh = DBI->connect('dbi:SQLite:foo', undef, undef, { - AutoCommit => 1, - RaiseError => 1, - sqlite_see_if_its_a_number => 1, - }); - my $sth = $dbh->prepare('INSERT INTO foo VALUES(?)'); - # '1.230' will be inserted as a text, instead of 1.23 as a number, - # even though sqlite_see_if_its_a_number is set. - $sth->bind_param(1, '1.230', SQL_VARCHAR); - $sth->execute; - -=back - -=head2 Placeholders - -SQLite supports several placeholder expressions, including C -and C<:AAAA>. Consult the L and SQLite documentation for -details. - -L - -Note that a question mark actually means a next unused (numbered) -placeholder. You're advised not to use it with other (numbered or -named) placeholders to avoid confusion. - - my $sth = $dbh->prepare( - 'update TABLE set a=?1 where b=?2 and a IS NOT ?1' - ); - $sth->execute(1, 2); - -=head2 Pragma - -SQLite has a set of "Pragma"s to modify its operation or to query -for its internal data. These are specific to SQLite and are not -likely to work with other DBD libraries, but you may find some of -these are quite useful, including: - -=over 4 - -=item journal_mode - -You can use this pragma to change the journal mode for SQLite -databases, maybe for better performance, or for compatibility. - -Its default mode is C, which means SQLite uses a rollback -journal to implement transactions, and the journal is deleted -at the conclusion of each transaction. If you use C -instead of C, the journal will be truncated, which is -usually much faster. - -A C (write-ahead log) mode is introduced as of SQLite 3.7.0. -This mode is persistent, and it stays in effect even after -closing and reopening the database. In other words, once the C -mode is set in an application or in a test script, the database -becomes inaccessible by older clients. This tends to be an issue -when you use a system C executable under a conservative -operating system. - -To fix this, You need to issue C -(or C) beforehand, or install a newer version of -C. - -=item legacy_file_format - -If you happen to need to create a SQLite database that will also -be accessed by a very old SQLite client (prior to 3.3.0 released -in Jan. 2006), you need to set this pragma to ON before you create -a database. - -=item reverse_unordered_selects - -You can set this pragma to ON to reverse the order of results of -SELECT statements without an ORDER BY clause so that you can see -if applications are making invalid assumptions about the result -order. - -Note that SQLite 3.7.15 (bundled with DBD::SQLite 1.38_02) enhanced -its query optimizer and the order of results of a SELECT statement -without an ORDER BY clause may be different from the one of the -previous versions. - -=item synchronous - -You can set set this pragma to OFF to make some of the operations -in SQLite faster with a possible risk of database corruption -in the worst case. See also L section below. - -=back - -See L for more details. - -=head2 Foreign Keys - -SQLite has started supporting foreign key constraints since 3.6.19 -(released on Oct 14, 2009; bundled in DBD::SQLite 1.26_05). -To be exact, SQLite has long been able to parse a schema with foreign -keys, but the constraints has not been enforced. Now you can issue -a C pragma to enable this feature and enforce the -constraints, preferably as soon as you connect to a database and -you're not in a transaction: - - $dbh->do("PRAGMA foreign_keys = ON"); - -And you can explicitly disable the feature whenever you like by -turning the pragma off: - - $dbh->do("PRAGMA foreign_keys = OFF"); - -As of this writing, this feature is disabled by default by the -SQLite team, and by us, to secure backward compatibility, as -this feature may break your applications, and actually broke -some for us. If you have used a schema with foreign key constraints -but haven't cared them much and supposed they're always ignored for -SQLite, be prepared, and please do extensive testing to ensure -that your applications will continue to work when the foreign keys -support is enabled by default. - -See L for details. - -=head2 Transactions - -DBI/DBD::SQLite's transactions may be a bit confusing. They behave -differently according to the status of the C flag: - -=over 4 - -=item When the AutoCommit flag is on - -You're supposed to always use the auto-commit mode, except you -explicitly begin a transaction, and when the transaction ended, -you're supposed to go back to the auto-commit mode. To begin a -transaction, call C method, or issue a C -statement. To end it, call C methods, or issue -the corresponding statements. - - $dbh->{AutoCommit} = 1; - - $dbh->begin_work; # or $dbh->do('BEGIN TRANSACTION'); - - # $dbh->{AutoCommit} is turned off temporarily during a transaction; - - $dbh->commit; # or $dbh->do('COMMIT'); - - # $dbh->{AutoCommit} is turned on again; - -=item When the AutoCommit flag is off - -You're supposed to always use the transactional mode, until you -explicitly turn on the AutoCommit flag. You can explicitly issue -a C statement (only when an actual transaction has not -begun yet) but you're not allowed to call C method -(if you don't issue a C, it will be issued internally). -You can commit or roll it back freely. Another transaction will -automatically begin if you execute another statement. - - $dbh->{AutoCommit} = 0; - - # $dbh->do('BEGIN TRANSACTION') is not necessary, but possible - - ... - - $dbh->commit; # or $dbh->do('COMMIT'); - - # $dbh->{AutoCommit} stays intact; - - $dbh->{AutoCommit} = 1; # ends the transactional mode - -=back - -This C mode is independent from the autocommit mode -of the internal SQLite library, which always begins by a C -statement, and ends by a C or a . - -=head2 Transaction and Database Locking - -The default transaction behavior of SQLite is C, that -means, locks are not acquired until the first read or write -operation, and thus it is possible that another thread or process -could create a separate transaction and write to the database after -the C on the current thread has executed, and eventually -cause a "deadlock". To avoid this, DBD::SQLite internally issues -a C if you begin a transaction by calling -C or by turning off C (since 1.38_01). - -If you really need to turn off this feature for some reasons, -set C database handle attribute -to false, and the default C transaction will be used. - - my $dbh = DBI->connect("dbi:SQLite::memory:", "", "", { - sqlite_use_immediate_transaction => 0, - }); - -Or, issue a C statement explicitly each time you begin -a transaction. - -See L for locking details. - -=head2 C<< $sth->finish >> and Transaction Rollback - -As the L doc says, you almost certainly do B need to -call L method if you fetch all rows (probably in a loop). -However, there are several exceptions to this rule, and rolling-back -of an unfinished C statements in -a transaction (See L for -details). So you need to call C before you issue a rollback. - - $sth = $dbh->prepare("SELECT * FROM t"); - $dbh->begin_work; - eval { - $sth->execute; - $row = $sth->fetch; - ... - die "For some reason"; - ... - }; - if($@) { - $sth->finish; # You need this for SQLite - $dbh->rollback; - } else { - $dbh->commit; - } - -=head2 Processing Multiple Statements At A Time - -L's statement handle is not supposed to process multiple -statements at a time. So if you pass a string that contains multiple -statements (a C) to a statement handle (via C or C), -L only processes the first statement, and discards the -rest. - -If you need to process multiple statements at a time, set -a C attribute of a database handle -to true when you connect to a database, and C method takes care -of the rest (since 1.30_01, and without creating DBI's statement -handles internally since 1.47_01). If you do need to use C -or C (which I don't recommend in this case, because -typically there's no placeholder nor reusable part in a dump), -you can look at << $sth->{sqlite_unprepared_statements} >> to retrieve -what's left, though it usually contains nothing but white spaces. - -=head2 Performance - -SQLite is fast, very fast. Matt processed his 72MB log file with it, -inserting the data (400,000+ rows) by using transactions and only -committing every 1000 rows (otherwise the insertion is quite slow), -and then performing queries on the data. - -Queries like count(*) and avg(bytes) took fractions of a second to -return, but what surprised him most of all was: - - SELECT url, count(*) as count - FROM access_log - GROUP BY url - ORDER BY count desc - LIMIT 20 - -To discover the top 20 hit URLs on the site (L), -and it returned within 2 seconds. He was seriously considering -switching his log analysis code to use this little speed demon! - -Oh yeah, and that was with no indexes on the table, on a 400MHz PIII. - -For best performance be sure to tune your hdparm settings if you -are using linux. Also you might want to set: - - PRAGMA synchronous = OFF - -Which will prevent SQLite from doing fsync's when writing (which -slows down non-transactional writes significantly) at the expense -of some peace of mind. Also try playing with the cache_size pragma. - -The memory usage of SQLite can also be tuned using the cache_size -pragma. - - $dbh->do("PRAGMA cache_size = 800000"); - -The above will allocate 800M for DB cache; the default is 2M. -Your sweet spot probably lies somewhere in between. - -=head1 DRIVER PRIVATE ATTRIBUTES - -=head2 Database Handle Attributes - -=over 4 - -=item sqlite_version - -Returns the version of the SQLite library which B is using, -e.g., "2.8.0". Can only be read. - -=item sqlite_unicode - -If set to a true value, B will turn the UTF-8 flag on for all -text strings coming out of the database (this feature is currently disabled -for perl < 5.8.5). For more details on the UTF-8 flag see -L. The default is for the UTF-8 flag to be turned off. - -Also note that due to some bizarreness in SQLite's type system (see -L), if you want to retain -blob-style behavior for B columns under C<< $dbh->{sqlite_unicode} = 1 ->> (say, to store images in the database), you have to state so -explicitly using the 3-argument form of L when doing -updates: - - use DBI qw(:sql_types); - $dbh->{sqlite_unicode} = 1; - my $sth = $dbh->prepare("INSERT INTO mytable (blobcolumn) VALUES (?)"); - - # Binary_data will be stored as is. - $sth->bind_param(1, $binary_data, SQL_BLOB); - -Defining the column type as C in the DDL is B sufficient. - -This attribute was originally named as C, and renamed to -C for integrity since version 1.26_06. Old C -attribute is still accessible but will be deprecated in the near future. - -=item sqlite_allow_multiple_statements - -If you set this to true, C method will process multiple -statements at one go. This may be handy, but with performance -penalty. See above for details. - -=item sqlite_use_immediate_transaction - -If you set this to true, DBD::SQLite tries to issue a C (instead of C) when -necessary. See above for details. - -As of version 1.38_01, this attribute is set to true by default. -If you really need to use C transactions for some reasons, -set this to false explicitly. - -=item sqlite_see_if_its_a_number - -If you set this to true, DBD::SQLite tries to see if the bind values -are number or not, and does not quote if they are numbers. See above -for details. - -=item sqlite_extended_result_codes - -If set to true, DBD::SQLite uses extended result codes where appropriate -(see L). - -=back - -=head2 Statement Handle Attributes - -=over 4 - -=item sqlite_unprepared_statements - -Returns an unprepared part of the statement you pass to C. -Typically this contains nothing but white spaces after a semicolon. -See above for details. - -=back - -=head1 METHODS - -See also to the L documentation for the details of other common -methods. - -=head2 table_info - - $sth = $dbh->table_info(undef, $schema, $table, $type, \%attr); - -Returns all tables and schemas (databases) as specified in L. -The schema and table arguments will do a C search. You can specify an -ESCAPE character by including an 'Escape' attribute in \%attr. The C<$type> -argument accepts a comma separated list of the following types 'TABLE', -'VIEW', 'LOCAL TEMPORARY' and 'SYSTEM TABLE' (by default all are returned). -Note that a statement handle is returned, and not a direct list of tables. - -The following fields are returned: - -B: Always NULL, as SQLite does not have the concept of catalogs. - -B: The name of the schema (database) that the table or view is -in. The default schema is 'main', temporary tables are in 'temp' and other -databases will be in the name given when the database was attached. - -B: The name of the table or view. - -B: The type of object returned. Will be one of 'TABLE', 'VIEW', -'LOCAL TEMPORARY' or 'SYSTEM TABLE'. - -=head2 primary_key, primary_key_info - - @names = $dbh->primary_key(undef, $schema, $table); - $sth = $dbh->primary_key_info(undef, $schema, $table, \%attr); - -You can retrieve primary key names or more detailed information. -As noted above, SQLite does not have the concept of catalogs, so the -first argument of the methods is usually C, and you'll usually -set C for the second one (unless you want to know the primary -keys of temporary tables). - - -=head2 foreign_key_info - - $sth = $dbh->foreign_key_info(undef, $pk_schema, $pk_table, - undef, $fk_schema, $fk_table); - -Returns information about foreign key constraints, as specified in -L, but with some limitations : - -=over - -=item * - -information in rows returned by the C<$sth> is incomplete with -respect to the L specification. All requested fields -are present, but the content is C for some of them. - -=back - -The following nonempty fields are returned : - -B: -The primary (unique) key table identifier. - -B: -The primary (unique) key column identifier. - -B: -The foreign key table identifier. - -B: -The foreign key column identifier. - -B: -The column sequence number (starting with 1), when -several columns belong to a same constraint. - -B: -The referential action for the UPDATE rule. -The following codes are defined: - - CASCADE 0 - RESTRICT 1 - SET NULL 2 - NO ACTION 3 - SET DEFAULT 4 - -Default is 3 ('NO ACTION'). - -B: -The referential action for the DELETE rule. -The codes are the same as for UPDATE_RULE. - -Unfortunately, the B field is always C; -as a matter of fact, deferrability clauses are supported by SQLite, -but they can't be reported because the C -tells nothing about them. - -B: -Whether the column is primary or unique. - -B: foreign key support in SQLite must be explicitly turned on through -a C command; see L earlier in this manual. - -=head2 statistics_info - - $sth = $dbh->statistics_info(undef, $schema, $table, - $unique_only, $quick); - -Returns information about a table and it's indexes, as specified in -L, but with some limitations : - -=over - -=item * - -information in rows returned by the C<$sth> is incomplete with -respect to the L specification. All requested fields -are present, but the content is C for some of them. - -=back - -The following nonempty fields are returned : - -B: -The name of the schema (database) that the table is in. The default schema is 'main', temporary tables are in 'temp' and other databases will be in the name given when the database was attached. - -B: -The name of the table - -B: -Contains 0 for unique indexes, 1 for non-unique indexes - -B: -The name of the index - -B: -SQLite uses 'btree' for all it's indexes - -B: -Column sequence number (starting with 1). - -B: -The name of the column - -=head2 ping - - my $bool = $dbh->ping; - -returns true if the database file exists (or the database is in-memory), and the database connection is active. - -=head1 DRIVER PRIVATE METHODS - -The following methods can be called via the func() method with a little -tweak, but the use of func() method is now discouraged by the L author -for various reasons (see DBI's document -L -for details). So, if you're using L >= 1.608, use these C -methods. If you need to use an older L, you can call these like this: - - $dbh->func( ..., "(method name without sqlite_ prefix)" ); - -Exception: C should always be called as is, even with C -method (to avoid conflict with DBI's trace() method). - - $dbh->func( ..., "sqlite_trace"); - -=head2 $dbh->sqlite_last_insert_rowid() - -This method returns the last inserted rowid. If you specify an INTEGER PRIMARY -KEY as the first column in your table, that is the column that is returned. -Otherwise, it is the hidden ROWID column. See the SQLite docs for details. - -Generally you should not be using this method. Use the L last_insert_id -method instead. The usage of this is: - - $h->last_insert_id($catalog, $schema, $table_name, $field_name [, \%attr ]) - -Running C<$h-Elast_insert_id("","","","")> is the equivalent of running -C<$dbh-Esqlite_last_insert_rowid()> directly. - -=head2 $dbh->sqlite_db_filename() - -Retrieve the current (main) database filename. If the database is in-memory or temporary, this returns C. - -=head2 $dbh->sqlite_busy_timeout() - -Retrieve the current busy timeout. - -=head2 $dbh->sqlite_busy_timeout( $ms ) - -Set the current busy timeout. The timeout is in milliseconds. - -=head2 $dbh->sqlite_create_function( $name, $argc, $code_ref, $flags ) - -This method will register a new function which will be usable in an SQL -query. The method's parameters are: - -=over - -=item $name - -The name of the function. This is the name of the function as it will -be used from SQL. - -=item $argc - -The number of arguments taken by the function. If this number is -1, -the function can take any number of arguments. - -=item $code_ref - -This should be a reference to the function's implementation. - -=item $flags - -You can optionally pass an extra flag bit to create_function, which then would be ORed with SQLITE_UTF8 (default). As of 1.47_02 (SQLite 3.8.9), only meaning bit is SQLITE_DETERMINISTIC (introduced at SQLite 3.8.3), which can make the function perform better. See C API documentation at L for details. - -=back - -For example, here is how to define a now() function which returns the -current number of seconds since the epoch: - - $dbh->sqlite_create_function( 'now', 0, sub { return time } ); - -After this, it could be used from SQL as: - - INSERT INTO mytable ( now() ); - -=head3 REGEXP function - -SQLite includes syntactic support for an infix operator 'REGEXP', but -without any implementation. The C driver -automatically registers an implementation that performs standard -perl regular expression matching, using current locale. So for example -you can search for words starting with an 'A' with a query like - - SELECT * from table WHERE column REGEXP '\bA\w+' - -If you want case-insensitive searching, use perl regex flags, like this : - - SELECT * from table WHERE column REGEXP '(?i:\bA\w+)' - -The default REGEXP implementation can be overridden through the -C API described above. - -Note that regexp matching will B use SQLite indices, but will iterate -over all rows, so it could be quite costly in terms of performance. - -=head2 $dbh->sqlite_create_collation( $name, $code_ref ) - -This method manually registers a new function which will be usable in an SQL -query as a COLLATE option for sorting. Such functions can also be registered -automatically on demand: see section L below. - -The method's parameters are: - -=over - -=item $name - -The name of the function exposed to SQL. - -=item $code_ref - -Reference to the function's implementation. -The driver will check that this is a proper sorting function. - -=back - -=head2 $dbh->sqlite_collation_needed( $code_ref ) - -This method manually registers a callback function that will -be invoked whenever an undefined collation sequence is required -from an SQL statement. The callback is invoked as - - $code_ref->($dbh, $collation_name) - -and should register the desired collation using -L. - -An initial callback is already registered by C, -so for most common cases it will be simpler to just -add your collation sequences in the C<%DBD::SQLite::COLLATION> -hash (see section L below). - -=head2 $dbh->sqlite_create_aggregate( $name, $argc, $pkg, $flags ) - -This method will register a new aggregate function which can then be used -from SQL. The method's parameters are: - -=over - -=item $name - -The name of the aggregate function, this is the name under which the -function will be available from SQL. - -=item $argc - -This is an integer which tells the SQL parser how many arguments the -function takes. If that number is -1, the function can take any number -of arguments. - -=item $pkg - -This is the package which implements the aggregator interface. - -=item $flags - -You can optionally pass an extra flag bit to create_aggregate, which then would be ORed with SQLITE_UTF8 (default). As of 1.47_02 (SQLite 3.8.9), only meaning bit is SQLITE_DETERMINISTIC (introduced at SQLite 3.8.3), which can make the function perform better. See C API documentation at L for details. - -=back - -The aggregator interface consists of defining three methods: - -=over - -=item new() - -This method will be called once to create an object which should -be used to aggregate the rows in a particular group. The step() and -finalize() methods will be called upon the reference return by -the method. - -=item step(@_) - -This method will be called once for each row in the aggregate. - -=item finalize() - -This method will be called once all rows in the aggregate were -processed and it should return the aggregate function's result. When -there is no rows in the aggregate, finalize() will be called right -after new(). - -=back - -Here is a simple aggregate function which returns the variance -(example adapted from pysqlite): - - package variance; - - sub new { bless [], shift; } - - sub step { - my ( $self, $value ) = @_; - - push @$self, $value; - } - - sub finalize { - my $self = $_[0]; - - my $n = @$self; - - # Variance is NULL unless there is more than one row - return undef unless $n || $n == 1; - - my $mu = 0; - foreach my $v ( @$self ) { - $mu += $v; - } - $mu /= $n; - - my $sigma = 0; - foreach my $v ( @$self ) { - $sigma += ($v - $mu)**2; - } - $sigma = $sigma / ($n - 1); - - return $sigma; - } - - $dbh->sqlite_create_aggregate( "variance", 1, 'variance' ); - -The aggregate function can then be used as: - - SELECT group_name, variance(score) - FROM results - GROUP BY group_name; - -For more examples, see the L. - -=head2 $dbh->sqlite_progress_handler( $n_opcodes, $code_ref ) - -This method registers a handler to be invoked periodically during long -running calls to SQLite. - -An example use for this interface is to keep a GUI updated during a -large query. The parameters are: - -=over - -=item $n_opcodes - -The progress handler is invoked once for every C<$n_opcodes> -virtual machine opcodes in SQLite. - -=item $code_ref - -Reference to the handler subroutine. If the progress handler returns -non-zero, the SQLite operation is interrupted. This feature can be used to -implement a "Cancel" button on a GUI dialog box. - -Set this argument to C if you want to unregister a previous -progress handler. - -=back - -=head2 $dbh->sqlite_commit_hook( $code_ref ) - -This method registers a callback function to be invoked whenever a -transaction is committed. Any callback set by a previous call to -C is overridden. A reference to the previous -callback (if any) is returned. Registering an C disables the -callback. - -When the commit hook callback returns zero, the commit operation is -allowed to continue normally. If the callback returns non-zero, then -the commit is converted into a rollback (in that case, any attempt to -I call C<< $dbh->rollback() >> afterwards would yield an -error). - -=head2 $dbh->sqlite_rollback_hook( $code_ref ) - -This method registers a callback function to be invoked whenever a -transaction is rolled back. Any callback set by a previous call to -C is overridden. A reference to the previous -callback (if any) is returned. Registering an C disables the -callback. - -=head2 $dbh->sqlite_update_hook( $code_ref ) - -This method registers a callback function to be invoked whenever a row -is updated, inserted or deleted. Any callback set by a previous call to -C is overridden. A reference to the previous -callback (if any) is returned. Registering an C disables the -callback. - -The callback will be called as - - $code_ref->($action_code, $database, $table, $rowid) - -where - -=over - -=item $action_code - -is an integer equal to either C, -C or C -(see L); - -=item $database - -is the name of the database containing the affected row; - -=item $table - -is the name of the table containing the affected row; - -=item $rowid - -is the unique 64-bit signed integer key of the affected row within -that table. - -=back - -=head2 $dbh->sqlite_set_authorizer( $code_ref ) - -This method registers an authorizer callback to be invoked whenever -SQL statements are being compiled by the L method. The -authorizer callback should return C to allow the -action, C to disallow the specific action but -allow the SQL statement to continue to be compiled, or -C to cause the entire SQL statement to be rejected -with an error. If the authorizer callback returns any other value, -then C call that triggered the authorizer will fail with -an error message. - -An authorizer is used when preparing SQL statements from an untrusted -source, to ensure that the SQL statements do not try to access data -they are not allowed to see, or that they do not try to execute -malicious statements that damage the database. For example, an -application may allow a user to enter arbitrary SQL queries for -evaluation by a database. But the application does not want the user -to be able to make arbitrary changes to the database. An authorizer -could then be put in place while the user-entered SQL is being -prepared that disallows everything except SELECT statements. - -The callback will be called as - - $code_ref->($action_code, $string1, $string2, $database, $trigger_or_view) - -where - -=over - -=item $action_code - -is an integer that specifies what action is being authorized -(see L). - -=item $string1, $string2 - -are strings that depend on the action code -(see L). - -=item $database - -is the name of the database (C
, C, etc.) if applicable. - -=item $trigger_or_view - -is the name of the inner-most trigger or view that is responsible for -the access attempt, or C if this access attempt is directly from -top-level SQL code. - -=back - -=head2 $dbh->sqlite_backup_from_file( $filename ) - -This method accesses the SQLite Online Backup API, and will take a backup of -the named database file, copying it to, and overwriting, your current database -connection. This can be particularly handy if your current connection is to the -special :memory: database, and you wish to populate it from an existing DB. - -=head2 $dbh->sqlite_backup_to_file( $filename ) - -This method accesses the SQLite Online Backup API, and will take a backup of -the currently connected database, and write it out to the named file. - -=head2 $dbh->sqlite_enable_load_extension( $bool ) - -Calling this method with a true value enables loading (external) -SQLite3 extensions. After the call, you can load extensions like this: - - $dbh->sqlite_enable_load_extension(1); - $sth = $dbh->prepare("select load_extension('libsqlitefunctions.so')") - or die "Cannot prepare: " . $dbh->errstr(); - -=head2 $dbh->sqlite_load_extension( $file, $proc ) - -Loading an extension by a select statement (with the "load_extension" SQLite3 function like above) has some limitations. If you need to, say, create other functions from an extension, use this method. $file (a path to the extension) is mandatory, and $proc (an entry point name) is optional. You need to call C before calling C. - -=head2 $dbh->sqlite_trace( $code_ref ) - -This method registers a trace callback to be invoked whenever -SQL statements are being run. - -The callback will be called as - - $code_ref->($statement) - -where - -=over - -=item $statement - -is a UTF-8 rendering of the SQL statement text as the statement -first begins executing. - -=back - -Additional callbacks might occur as each triggered subprogram is -entered. The callbacks for triggers contain a UTF-8 SQL comment -that identifies the trigger. - -See also L for better tracing options. - -=head2 $dbh->sqlite_profile( $code_ref ) - -This method registers a profile callback to be invoked whenever -a SQL statement finishes. - -The callback will be called as - - $code_ref->($statement, $elapsed_time) - -where - -=over - -=item $statement - -is the original statement text (without bind parameters). - -=item $elapsed_time - -is an estimate of wall-clock time of how long that statement took to run (in milliseconds). - -=back - -This method is considered experimental and is subject to change in future versions of SQLite. - -See also L for better profiling options. - -=head2 $dbh->sqlite_table_column_metadata( $dbname, $tablename, $columnname ) - -is for internal use only. - -=head2 $dbh->sqlite_db_status() - -Returns a hash reference that holds a set of status information of database connection such as cache usage. See L for details. You may also pass 0 as an argument to reset the status. - -=head2 $sth->sqlite_st_status() - -Returns a hash reference that holds a set of status information of SQLite statement handle such as full table scan count. See L for details. Statement status only holds the current value. - - my $status = $sth->sqlite_st_status(); - my $cur = $status->{fullscan_step}; - -You may also pass 0 as an argument to reset the status. - -=head2 $dbh->sqlite_create_module() - -Registers a name for a I. Module names must be -registered before creating a new virtual table using the module and -before using a preexisting virtual table for the module. -Virtual tables are explained in L. - -=head1 DRIVER FUNCTIONS - -=head2 DBD::SQLite::compile_options() - -Returns an array of compile options (available since SQLite 3.6.23, -bundled in DBD::SQLite 1.30_01), or an empty array if the bundled -library is old or compiled with SQLITE_OMIT_COMPILEOPTION_DIAGS. - -=head2 DBD::SQLite::sqlite_status() - -Returns a hash reference that holds a set of status information of SQLite runtime such as memory usage or page cache usage (see L for details). Each of the entry contains the current value and the highwater value. - - my $status = DBD::SQLite::sqlite_status(); - my $cur = $status->{memory_used}{current}; - my $high = $status->{memory_used}{highwater}; - -You may also pass 0 as an argument to reset the status. - -=head2 DBD::SQLite::strlike($pattern, $string, $escape_char), DBD::SQLite::strglob($pattern, $string) - -As of 1.49_05 (SQLite 3.10.0), you can use these two functions to -see if a string matches a pattern. These may be useful when you -create a virtual table or a custom function. -See L and -L for details. - -=head1 DRIVER CONSTANTS - -A subset of SQLite C constants are made available to Perl, -because they may be needed when writing -hooks or authorizer callbacks. For accessing such constants, -the C module must be explicitly Cd at compile -time. For example, an authorizer that forbids any -DELETE operation would be written as follows : - - use DBD::SQLite; - $dbh->sqlite_set_authorizer(sub { - my $action_code = shift; - return $action_code == DBD::SQLite::DELETE ? DBD::SQLite::DENY - : DBD::SQLite::OK; - }); - -The list of constants implemented in C is given -below; more information can be found ad -at L. - -=head2 Authorizer Return Codes - - OK - DENY - IGNORE - -=head2 Action Codes - -The L method registers a callback function that is -invoked to authorize certain SQL statement actions. The first -parameter to the callback is an integer code that specifies what -action is being authorized. The second and third parameters to the -callback are strings, the meaning of which varies according to the -action code. Below is the list of action codes, together with their -associated strings. - - # constant string1 string2 - # ======== ======= ======= - CREATE_INDEX Index Name Table Name - CREATE_TABLE Table Name undef - CREATE_TEMP_INDEX Index Name Table Name - CREATE_TEMP_TABLE Table Name undef - CREATE_TEMP_TRIGGER Trigger Name Table Name - CREATE_TEMP_VIEW View Name undef - CREATE_TRIGGER Trigger Name Table Name - CREATE_VIEW View Name undef - DELETE Table Name undef - DROP_INDEX Index Name Table Name - DROP_TABLE Table Name undef - DROP_TEMP_INDEX Index Name Table Name - DROP_TEMP_TABLE Table Name undef - DROP_TEMP_TRIGGER Trigger Name Table Name - DROP_TEMP_VIEW View Name undef - DROP_TRIGGER Trigger Name Table Name - DROP_VIEW View Name undef - INSERT Table Name undef - PRAGMA Pragma Name 1st arg or undef - READ Table Name Column Name - SELECT undef undef - TRANSACTION Operation undef - UPDATE Table Name Column Name - ATTACH Filename undef - DETACH Database Name undef - ALTER_TABLE Database Name Table Name - REINDEX Index Name undef - ANALYZE Table Name undef - CREATE_VTABLE Table Name Module Name - DROP_VTABLE Table Name Module Name - FUNCTION undef Function Name - SAVEPOINT Operation Savepoint Name - -=head1 COLLATION FUNCTIONS - -=head2 Definition - -SQLite v3 provides the ability for users to supply arbitrary -comparison functions, known as user-defined "collation sequences" or -"collating functions", to be used for comparing two text values. -L -explains how collations are used in various SQL expressions. - -=head2 Builtin collation sequences - -The following collation sequences are builtin within SQLite : - -=over - -=item B - -Compares string data using memcmp(), regardless of text encoding. - -=item B - -The same as binary, except the 26 upper case characters of ASCII are -folded to their lower case equivalents before the comparison is -performed. Note that only ASCII characters are case folded. SQLite -does not attempt to do full UTF case folding due to the size of the -tables required. - -=item B - -The same as binary, except that trailing space characters are ignored. - -=back - -In addition, C automatically installs the -following collation sequences : - -=over - -=item B - -corresponds to the Perl C operator - -=item B - -Perl C operator, in a context where C is activated. - -=back - -=head2 Usage - -You can write for example - - CREATE TABLE foo( - txt1 COLLATE perl, - txt2 COLLATE perllocale, - txt3 COLLATE nocase - ) - -or - - SELECT * FROM foo ORDER BY name COLLATE perllocale - -=head2 Unicode handling - -If the attribute C<< $dbh->{sqlite_unicode} >> is set, strings coming from -the database and passed to the collation function will be properly -tagged with the utf8 flag; but this only works if the -C attribute is set B the first call to -a perl collation sequence . The recommended way to activate unicode -is to set the parameter at connection time : - - my $dbh = DBI->connect( - "dbi:SQLite:dbname=foo", "", "", - { - RaiseError => 1, - sqlite_unicode => 1, - } - ); - -=head2 Adding user-defined collations - -The native SQLite API for adding user-defined collations is -exposed through methods L and -L. - -To avoid calling these functions every time a C<$dbh> handle is -created, C offers a simpler interface through the -C<%DBD::SQLite::COLLATION> hash : just insert your own -collation functions in that hash, and whenever an unknown -collation name is encountered in SQL, the appropriate collation -function will be loaded on demand from the hash. For example, -here is a way to sort text values regardless of their accented -characters : - - use DBD::SQLite; - $DBD::SQLite::COLLATION{no_accents} = sub { - my ( $a, $b ) = map lc, @_; - tr[] - [aaaaaacdeeeeiiiinoooooouuuuy] for $a, $b; - $a cmp $b; - }; - my $dbh = DBI->connect("dbi:SQLite:dbname=dbfile"); - my $sql = "SELECT ... FROM ... ORDER BY ... COLLATE no_accents"); - my $rows = $dbh->selectall_arrayref($sql); - -The builtin C or C collations are predefined -in that same hash. - -The COLLATION hash is a global registry within the current process; -hence there is a risk of undesired side-effects. Therefore, to -prevent action at distance, the hash is implemented as a "write-only" -hash, that will happily accept new entries, but will raise an -exception if any attempt is made to override or delete a existing -entry (including the builtin C and C). - -If you really, really need to change or delete an entry, you can -always grab the tied object underneath C<%DBD::SQLite::COLLATION> --- -but don't do that unless you really know what you are doing. Also -observe that changes in the global hash will not modify existing -collations in existing database handles: it will only affect new -I for collations. In other words, if you want to change -the behaviour of a collation within an existing C<$dbh>, you -need to call the L method directly. - -=head1 FULLTEXT SEARCH - -SQLite is bundled with an extension module for full-text -indexing. Tables with this feature enabled can be efficiently queried -to find rows that contain one or more instances of some specified -words, in any column, even if the table contains many large documents. - -Explanations for using this feature are provided in a separate document: -see L. - - -=head1 R* TREE SUPPORT - -The RTREE extension module within SQLite adds support for creating -a R-Tree, a special index for range and multidimensional queries. This -allows users to create tables that can be loaded with (as an example) -geospatial data such as latitude/longitude coordinates for buildings within -a city : - - CREATE VIRTUAL TABLE city_buildings USING rtree( - id, -- Integer primary key - minLong, maxLong, -- Minimum and maximum longitude - minLat, maxLat -- Minimum and maximum latitude - ); - -then query which buildings overlap or are contained within a specified region: - - # IDs that are contained within query coordinates - my $contained_sql = <<""; - SELECT id FROM city_buildings - WHERE minLong >= ? AND maxLong <= ? - AND minLat >= ? AND maxLat <= ? - - # ... and those that overlap query coordinates - my $overlap_sql = <<""; - SELECT id FROM city_buildings - WHERE maxLong >= ? AND minLong <= ? - AND maxLat >= ? AND minLat <= ? - - my $contained = $dbh->selectcol_arrayref($contained_sql,undef, - $minLong, $maxLong, $minLat, $maxLat); - - my $overlapping = $dbh->selectcol_arrayref($overlap_sql,undef, - $minLong, $maxLong, $minLat, $maxLat); - -For more detail, please see the SQLite R-Tree page -(L). Note that custom R-Tree -queries using callbacks, as mentioned in the prior link, have not been -implemented yet. - -=head1 VIRTUAL TABLES IMPLEMENTED IN PERL - -SQLite has a concept of "virtual tables" which look like regular -tables but are implemented internally through specific functions. -The fulltext or R* tree features described in the previous chapters -are examples of such virtual tables, implemented in C code. - -C also supports virtual tables implemented in I: -see L for using or implementing such -virtual tables. These can have many interesting uses -for joining regular DBMS data with some other kind of data within your -Perl programs. Bundled with the present distribution are : - -=over - -=item * - -L : implements a virtual -column that exposes file contents. This is especially useful -in conjunction with a fulltext index; see L. - -=item * - -L : binds to a Perl array -within the Perl program. This can be used for simple import/export -operations, for debugging purposes, for joining data from different -sources, etc. - -=back - -Other Perl virtual tables may also be published separately on CPAN. - -=head1 FOR DBD::SQLITE EXTENSION AUTHORS - -Since 1.30_01, you can retrieve the bundled SQLite C source and/or -header like this: - - use File::ShareDir 'dist_dir'; - use File::Spec::Functions 'catfile'; - - # the whole sqlite3.h header - my $sqlite3_h = catfile(dist_dir('DBD-SQLite'), 'sqlite3.h'); - - # or only a particular header, amalgamated in sqlite3.c - my $what_i_want = 'parse.h'; - my $sqlite3_c = catfile(dist_dir('DBD-SQLite'), 'sqlite3.c'); - open my $fh, '<', $sqlite3_c or die $!; - my $code = do { local $/; <$fh> }; - my ($parse_h) = $code =~ m{( - /\*+[ ]Begin[ ]file[ ]$what_i_want[ ]\*+ - .+? - /\*+[ ]End[ ]of[ ]$what_i_want[ ]\*+/ - )}sx; - open my $out, '>', $what_i_want or die $!; - print $out $parse_h; - close $out; - -You usually want to use this in your extension's C, -and you may want to add DBD::SQLite to your extension's C -to ensure your extension users use the same C source/header they use -to build DBD::SQLite itself (instead of the ones installed in their -system). - -=head1 TO DO - -The following items remain to be done. - -=head2 Leak Detection - -Implement one or more leak detection tests that only run during -AUTOMATED_TESTING and RELEASE_TESTING and validate that none of the C -code we work with leaks. - -=head2 Stream API for Blobs - -Reading/writing into blobs using C / C. - -=head2 Support for custom callbacks for R-Tree queries - -Custom queries of a R-Tree index using a callback are possible with -the SQLite C API (L), so one could -potentially use a callback that narrowed the result set down based -on a specific need, such as querying for overlapping circles. - -=head1 SUPPORT - -Bugs should be reported via the CPAN bug tracker at - -L - -Note that bugs of bundled SQLite library (i.e. bugs in C) -should be reported to the SQLite developers at sqlite.org via their bug -tracker or via their mailing list. - -The master repository is on GitHub: - -L. - -We also have a mailing list: - -L - -=head1 AUTHORS - -Matt Sergeant Ematt@sergeant.orgE - -Francis J. Lacoste Eflacoste@logreport.orgE - -Wolfgang Sourdeau Ewolfgang@logreport.orgE - -Adam Kennedy Eadamk@cpan.orgE - -Max Maischein Ecorion@cpan.orgE - -Laurent Dami Edami@cpan.orgE - -Kenichi Ishigaki Eishigaki@cpan.orgE - -=head1 COPYRIGHT - -The bundled SQLite code in this distribution is Public Domain. - -DBD::SQLite is copyright 2002 - 2007 Matt Sergeant. - -Some parts copyright 2008 Francis J. Lacoste. - -Some parts copyright 2008 Wolfgang Sourdeau. - -Some parts copyright 2008 - 2013 Adam Kennedy. - -Some parts copyright 2009 - 2013 Kenichi Ishigaki. - -Some parts derived from L -copyright 2008 Audrey Tang. - -This program is free software; you can redistribute -it and/or modify it under the same terms as Perl itself. - -The full text of the license can be found in the -LICENSE file included with this module. - -=cut diff --git a/CPAN/arch/5.14/MSWin32-x86-multi-thread/Win32/Locale.pm b/CPAN/arch/5.14/MSWin32-x86-multi-thread/Win32/Locale.pm deleted file mode 100644 index f6cda1d1327..00000000000 --- a/CPAN/arch/5.14/MSWin32-x86-multi-thread/Win32/Locale.pm +++ /dev/null @@ -1,371 +0,0 @@ - -package Win32::Locale; -# Time-stamp: "2004-01-11 18:56:06 AST" -use strict; -use vars qw($VERSION %MSLocale2LangTag); -$VERSION = '0.04'; -%MSLocale2LangTag = ( - - 0x0436 => 'af' , # - 0x041c => 'sq' , # - - 0x0401 => 'ar-sa', # - 0x0801 => 'ar-iq', # - 0x0C01 => 'ar-eg', # - 0x1001 => 'ar-ly', # - 0x1401 => 'ar-dz', # - 0x1801 => 'ar-ma', # - 0x1C01 => 'ar-tn', # - 0x2001 => 'ar-om', # - 0x2401 => 'ar-ye', # - 0x2801 => 'ar-sy', # - 0x2C01 => 'ar-jo', # - 0x3001 => 'ar-lb', # - 0x3401 => 'ar-kw', # - 0x3801 => 'ar-ae', # - 0x3C01 => 'ar-bh', # - 0x4001 => 'ar-qa', # - - 0x042b => 'hy' , # - 0x044d => 'as' , # - 0x042c => 'az-latn', # - 0x082c => 'az-cyrl', # - 0x042D => 'eu' , # - 0x0423 => 'be' , # - 0x0445 => 'bn' , # - 0x0402 => 'bg' , # - 0x0403 => 'ca' , # - - # Chinese is zh, not cn! - 0x0404 => 'zh-tw', # - 0x0804 => 'zh-cn', # - 0x0C04 => 'zh-hk', # - 0x1004 => 'zh-sg', # - 0x1404 => 'zh-mo', # - - 0x041a => 'hr' , # - 0x0405 => 'cs' , # - 0x0406 => 'da' , # - 0x0413 => 'nl-nl', # - 0x0813 => 'nl-be', # - - 0x0409 => 'en-us', # - 0x0809 => 'en-gb', # - 0x0c09 => 'en-au', # - 0x1009 => 'en-ca', # - 0x1409 => 'en-nz', # - 0x1809 => 'en-ie', # - 0x1c09 => 'en-za', # - 0x2009 => 'en-jm', # - 0x2409 => 'en-jm', # # a hack - 0x2809 => 'en-bz', # - 0x2c09 => 'en-tt', # - 0x3009 => 'en-zw', # - 0x3409 => 'en-ph', # - - 0x0425 => 'et' , # - 0x0438 => 'fo' , # - 0x0429 => 'pa' , # # =Persian - 0x040b => 'fi' , # - - 0x040c => 'fr-fr', # - 0x080c => 'fr-be', # - 0x0c0c => 'fr-ca', # - 0x100c => 'fr-ch', # - 0x140c => 'fr-lu', # - 0x180c => 'fr-mc', # - - 0x0437 => 'ka' , # - - 0x0407 => 'de-de', # - 0x0807 => 'de-ch', # - 0x0c07 => 'de-at', # - 0x1007 => 'de-lu', # - 0x1407 => 'de-li', # - - 0x0408 => 'el' , # - 0x0447 => 'gu' , # - 0x040D => 'he' , # # formerly 'iw' - 0x0439 => 'hi' , # - 0x040e => 'hu' , # - 0x040F => 'is' , # - 0x0421 => 'id' , # # formerly 'in' - 0x0410 => 'it-it', # - 0x0810 => 'it-ch', # - 0x0411 => 'ja' , # # not "jp"! - 0x044b => 'kn' , # - 0x0860 => 'ks' , # - 0x043f => 'kk' , # - 0x0457 => 'kok' , # 3-letters! - 0x0412 => 'ko' , # - 0x0812 => 'ko' , # ? - 0x0426 => 'lv' , # # = lettish - 0x0427 => 'lt' , # - 0x0827 => 'lt' , # ? - 0x042f => 'mk' , # - 0x043e => 'ms' , # - 0x083e => 'ms-bn', # - 0x044c => 'ml' , # - 0x044e => 'mr' , # - 0x0461 => 'ne-np', # - 0x0861 => 'ne-in', # - 0x0414 => 'nb' , # #was no-bok - 0x0814 => 'nn' , # #was no-nyn - # note that this leaves nothing using "no" ("Norwegian") - 0x0448 => 'or' , # - 0x0415 => 'pl' , # - 0x0416 => 'pt-br', # - 0x0816 => 'pt-pt', # - 0x0446 => 'pa' , # - 0x0417 => 'rm' , # - 0x0418 => 'ro' , # - 0x0818 => 'ro-md', # - 0x0419 => 'ru' , # - 0x0819 => 'ru-md', # - 0x043b => 'se' , # assuming == "Northern Sami" - 0x044f => 'sa' , # - 0x0c1a => 'sr-cyrl', # - 0x081a => 'sr-latn', # - 0x0459 => 'sd' , # - 0x041b => 'sk' , # - 0x0424 => 'sl' , # - 0x042e => 'wen' , # # !!! 3 letters - - 0x040a => 'es-es', # - 0x080a => 'es-mx', # - 0x0c0a => 'es-es', # - 0x100a => 'es-gt', # - 0x140a => 'es-cr', # - 0x180a => 'es-pa', # - 0x1c0a => 'es-do', # - 0x200a => 'es-ve', # - 0x240a => 'es-co', # - 0x280a => 'es-pe', # - 0x2c0a => 'es-ar', # - 0x300a => 'es-ec', # - 0x340a => 'es-cl', # - 0x380a => 'es-uy', # - 0x3c0a => 'es-py', # - 0x400a => 'es-bo', # - 0x440a => 'es-sv', # - 0x480a => 'es-hn', # - 0x4c0a => 'es-ni', # - 0x500a => 'es-pr', # - - 0x0430 => 'st' , # == soto, sesotho - 0x0441 => 'sw-ke', # - 0x041D => 'sv' , # - 0x081d => 'sv-fi', # - 0x0449 => 'ta' , # - 0x0444 => 'tt' , # - 0x044a => 'te' , # - 0x041E => 'th' , # - 0x0431 => 'ts' , # (not Tonga!) - 0x0432 => 'tn' , # == Setswana - 0x041f => 'tr' , # - 0x0422 => 'uk' , # - 0x0420 => 'ur-pk', # - 0x0820 => 'ur-in', # - 0x0443 => 'uz-latn', # - 0x0843 => 'uz-cyrl', # - 0x0433 => 'ven' , # - 0x042a => 'vi' , # - 0x0434 => 'xh' , # - 0x043d => 'yi' , # # formetly ji - 0x0435 => 'zu' , # -); -#----------------------------------------------------------------------------- - -sub get_ms_locale { - my $locale; - return unless defined do { - # see if there's a W32 registry on this machine, and if so, look in it - local $SIG{"__DIE__"} = ""; - eval ' - use Win32::TieRegistry (); - my $i18n = Win32::TieRegistry->new( - "HKEY_CURRENT_USER/Control Panel/International", - { Delimiter => "/" } - ); - #print "no key!" unless $i18n; - $locale = $i18n->GetValue("Locale") if $i18n; - undef $i18n; - '; - #print "<$@>\n" if $@; - $locale; - }; - return unless $locale =~ m/^[0-9a-fA-F]+$/s; - return hex($locale); -} - -sub get_language { - my $lang = $MSLocale2LangTag{ $_[0] || get_ms_locale() || '' }; - return unless $lang; - return $lang; -} - -sub get_locale { - # I guess this is right. - my $lang = get_language(@_); - return unless $lang and $lang =~ m/^[a-z]{2}(?:-[a-z]{2})?$/s; - - # should we try to turn "fi" into "fi_FI"? - - $lang =~ tr/-/_/; - return $lang; -} -#----------------------------------------------------------------------------- - -# If we're just executed... -unless(caller) { - my $locale = get_ms_locale(); - if($locale) { - printf "Locale 0x%08x (%s => %s) => Lang %s\n", - $locale, $locale, - get_locale($locale) || '?', - get_language($locale) || '?', - } else { - print "Can't get ms-locale\n"; - } -} - -#----------------------------------------------------------------------------- -1; - -__END__ - -=head1 NAME - -Win32::Locale - get the current MSWin locale or language - -=head1 SYNOPSIS - - use Win32::Locale; - my $language = Win32::Locale::get_language(); - if($language eq 'en-us') { - print "Wasaaap homeslice!\n"; - } else { - print "You $language people ain't FROM around here, are ya?\n"; - } - -=head1 DESCRIPTION - -This library provides some simple functions allowing Perl under MSWin -to ask what the current locale/language setting is. (Yes, MSWin -conflates locales and languages, it seems; and the way it's -conflated is even stranger after MSWin98.) - -Note that you should be able to safely use this module under any -OS; the functions just won't be able to access any current -locale value. - -=head1 FUNCTIONS - -Note that these functions are not exported, -nor are they exportable: - -=over - -=item Win32::Locale::get_language() - -Returns the (all-lowercase) RFC3066 language tag corresponding -to the currently currently selected MS locale. - -Returns nothing if the MS locale value isn't accessible -(notably, if you're not running under MSWin!), or if it -corresponds to no known language tag. Example: "en-us". - -In list context, this may in the future be made to return -multiple values. - -=item Win32::Locale::get_locale() - -Returns the (all-lowercase) Unixish locale tag corresponding -to the currently currently selected MS locale. Example: "en_us". - -Returns nothing if the MS locale value isn't accessible -(notably, if you're not running under MSWin!), or if it -corresponds to no locale. - -In list context, this may in the future be made to return -multiple values. - -Note that this function is B, and I greatly welcome -suggestions. - -=item Win32::Locale::get_ms_locale() - -Returns the MS locale ID code for the currently selected MSWindows -locale. For example, returns the number 1033 for "US -English". (You may know the number 1033 better as 0x00000409, -as these numbers are usually given in hex in MS documents). - -Returns nothing if the value isn't accessible (notably, if you're -not running under MSWin!). - -=item Win32::Locale::get_language($msid) - -Returns the (all-lowercase) RFC3066 language tag corresponding -to the given MS locale code, or nothing if none. - -In list context, this may in the future be made to return -multiple values. - -=item Win32::Locale::get_locale($msid) - -Returns the (all-lowercase) Unixish locale tag corresponding -to the given MS locale code, or nothing if none. - -In list context, this may in the future be made to return -multiple values. - -=back - -("Nothing", above, means "in scalar context, undef; in list -context, empty-list".) - -=head1 AND MORE - -This module provides an (unexported) public hash, -%Win32::Locale::MSLocale2LangTag, that maps -from the MS locale ID code to my idea of the single best corresponding -RFC3066 language tag. - -The hash's contents are relatively certain for well-known -languages (US English is "en-us"), but are still experimental -in its finer details (like Konkani being "kok"). - -=head1 SEE ALSO - -L, -L, -L. - -=head1 COPYRIGHT AND DISCLAIMER - -Copyright (c) 2001,2003 Sean M. Burke. All rights reserved. - -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - -This program is distributed in the hope that it will be useful, but -without any warranty; without even the implied warranty of -merchantability or fitness for a particular purpose. - -I am not affiliated with the Microsoft corporation, nor the ActiveState -corporation. - -Product and company names mentioned in this document may be the -trademarks or service marks of their respective owners. Trademarks -and service marks might not be identified as such, although -this must not be construed as anyone's expression of validity -or invalidity of each trademark or service mark. - -=head1 AUTHOR - -Sean M. Burke C - -=cut - -# No big whoop. - diff --git a/CPAN/arch/5.14/MSWin32-x86-multi-thread/Win32/Process/List.pm b/CPAN/arch/5.14/MSWin32-x86-multi-thread/Win32/Process/List.pm deleted file mode 100644 index 53147e936ac..00000000000 --- a/CPAN/arch/5.14/MSWin32-x86-multi-thread/Win32/Process/List.pm +++ /dev/null @@ -1,272 +0,0 @@ -package Win32::Process::List; - -use 5.006; -use strict; -use warnings; -use Carp; -use Data::Dumper; - -require Exporter; -require DynaLoader; -use AutoLoader; - -our @ISA = qw(Exporter DynaLoader); - -# Items to export into callers namespace by default. Note: do not export -# names by default without a very good reason. Use EXPORT_OK instead. -# Do not simply export all your public functions/methods/constants. - -# This allows declaration use Win32::Process::List ':all'; -# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK -# will save memory. -our %EXPORT_TAGS = ( 'all' => [ qw( - -) ] ); - -our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); - -our @EXPORT = qw( - -); -our $VERSION = '0.09'; - -#sub AUTOLOAD { - # This AUTOLOAD is used to 'autoload' constants from the constant() - # XS function. If a constant is not found then control is passed - # to the AUTOLOAD in AutoLoader. - -# my $constname; -# our $AUTOLOAD; -# ($constname = $AUTOLOAD) =~ s/.*:://; -# croak "& not defined" if $constname eq 'constant'; -# local $! = 0; -# my $val = constant($constname, @_ ? $_[0] : 0); -# if ($! != 0) { -# if ($! =~ /Invalid/ || $!{EINVAL}) { -# $AutoLoader::AUTOLOAD = $AUTOLOAD; -# goto &AutoLoader::AUTOLOAD; -# } -# else { -# croak "Your vendor has not defined Win32::Process::List macro $constname"; -# } -# } -# { -# no strict 'refs'; - # Fixed between 5.005_53 and 5.005_61 -# if ($] >= 5.00561) { -# *$AUTOLOAD = sub () { $val }; -# } -# else { -# *$AUTOLOAD = sub { $val }; -# } -# } -# goto &$AUTOLOAD; -#} - -bootstrap Win32::Process::List $VERSION; - -# Preloaded methods go here. - -sub new -{ - my $class = shift; - my $self = { - nProcesses=>0, - processes=>[], - isError=>0, - Error=>undef - }; - bless $self, $class; - my $error = undef; - my $err = ListProcesses($error); - if($error) { - $self->{isError} = 1; - $self->{Error} = $error; - } - #my @arr = @{ $err }; - # $self->{processes} = [ @arr ]; - $self->{processes} = [ $err ]; - my %h = %{ $err }; - my $nProcesses = (scalar keys %h); - $self->{nProcesses} = $nProcesses; - return $self; - -} - -sub ProcessAliveNa -{ - my $self = shift; - my $process =shift; - if($process !~ /\.exe$/ ) - { - $process .= '.exe'; - } - - $self->{Error}=""; - $self->{isError}=0; - my $ret =ProcessAliveN($process, $self->{Error}); - if($ret == -1) { $self->{isError}=1; } - return $ret; - - -} - -sub ProcessAlivePid -{ - my $self = shift; - $self->{Error}=""; - $self->{isError}=0; - my $ret = ProcessAliveP(shift,$self->{Error}); - if($ret == -1) { $self->{isError}=1; } - return $ret; - -} - -sub ProcessAliveName -{ - my $self = shift; - my $process=shift; - $process=lc($process); - my @procArr=(); - my $alive = 0; - my %ret; - $self->{isError}=0; - $self->{Error}=""; - if(ref($process) eq "ARRAY") - { - #my $count=0; - #@procArr=@{$process}; - #foreach (@procArr) - #{ - # if($procArr[$count] !~ /\.exe$/ && $usePID == 0) - # { - # $procArr[$count]= $procArr[$count] . '.exe'; - # } - # $count++; - #} - $self->{isError} = 1; - $self->{Error} = "ARRAY of processes not yet supported!"; - return; - } else { - if($process !~ /\.exe$/ ) - { - $process .= '.exe'; - } - push(@procArr, $process); - } - my $error = undef; - my $y = undef; - my $processes=ListProcesses($error); - my %h=%{$processes}; - foreach my $p (keys %h) - { - if(lc($h{$p}) eq $process) { $ret{$process} = 1; $alive=1; } - } - return %ret; -} - -sub GetNProcesses -{ - my $self = shift; - return $self->{nProcesses}; -} - -sub GetProcessPid -{ - my $self = shift; - my $pr = shift; - my %ret; - $pr=lc($pr); - $self->{isError} = 0; - my @a = @{ $self->{processes} }; - my %h = %{ $a[0] }; - my $count = 0; - foreach my $key (keys %h) - { - if(lc($h{$key}) =~ /$pr/) { - #$a[$count] = $key; - $ret{$h{$key}}=$key; - $count++; - } - } - if($count > 0) { - return %ret; - } - $self->{isError} = 1; - $self->{Error} = "Error: no PID found for $pr"; - return; -} - -sub GetProcesses -{ - my $self = shift; - $self->{isError} = 0; - my @tmp = @{ $self->{processes} }; - my %h = %{ $tmp[0] }; - return %h; - -} - -sub IsError -{ - my $self = shift; - return $self->{isError}; -} - -sub GetErrorText -{ - my $self = shift; - if($self->{isError} == 1) - { - return $self->{Error}; - } - return; -} - -DESTROY -{ - my $self = shift; - #print "destroying!\n"; -} - -# Autoload methods go after =cut, and are processed by the autosplit program. - -1; -__END__ -# Below is stub documentation for your module. You better edit it! - -=head1 NAME - -Win32::Process::List - Perl extension to get all processes and thier PID on a Win32 system - -=head1 SYNOPSIS - - use Win32::Process::List; - my $P = Win32::Process::List->new(); constructor - my %list = $P->GetProcesses(); returns the hashes with PID and process name - foreach my $key ( keys %list ) { - # $list{$key} is now the process name and $key is the PID - print sprintf("%30s has PID %15s", $list{$key}, $key) . "\n"; - } - my $PID = $P->GetProcessPid("explorer"); get the PID of process explorer.exe - my $np = $P->GetNProcesses(); returns the number of processes - -=head1 DESCRIPTION - - Win32::Process::List is a module to get the running processes with their PID's from - a Win32 System. Please look at Win32/Process/List/processes.pl. - -=head2 EXPORT - -None by default. - - -=head1 AUTHOR - -Reinhard Pagitsch, Erpirpag@gmx.atE - -=head1 SEE ALSO - -L. - -=cut diff --git a/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/Audio/Scan/Scan.dll b/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/Audio/Scan/Scan.dll deleted file mode 100755 index 68da4c309ad..00000000000 Binary files a/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/Audio/Scan/Scan.dll and /dev/null differ diff --git a/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/Class/XSAccessor/XSAccessor.dll b/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/Class/XSAccessor/XSAccessor.dll deleted file mode 100755 index fd7d34c063c..00000000000 Binary files a/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/Class/XSAccessor/XSAccessor.dll and /dev/null differ diff --git a/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/Crypt/Blowfish/Blowfish.dll b/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/Crypt/Blowfish/Blowfish.dll deleted file mode 100644 index a6c11604ee7..00000000000 Binary files a/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/Crypt/Blowfish/Blowfish.dll and /dev/null differ diff --git a/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/DBD/SQLite/SQLite.dll b/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/DBD/SQLite/SQLite.dll deleted file mode 100755 index 73b8b886d20..00000000000 Binary files a/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/DBD/SQLite/SQLite.dll and /dev/null differ diff --git a/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/DBD/SQLite/icudt57.dll b/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/DBD/SQLite/icudt57.dll deleted file mode 100755 index a9d3fc4448c..00000000000 Binary files a/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/DBD/SQLite/icudt57.dll and /dev/null differ diff --git a/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/DBD/SQLite/icuin57.dll b/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/DBD/SQLite/icuin57.dll deleted file mode 100755 index 3f41a5e3b83..00000000000 Binary files a/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/DBD/SQLite/icuin57.dll and /dev/null differ diff --git a/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/DBD/SQLite/icuuc57.dll b/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/DBD/SQLite/icuuc57.dll deleted file mode 100755 index b2f67c0c889..00000000000 Binary files a/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/DBD/SQLite/icuuc57.dll and /dev/null differ diff --git a/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/EV/EV.dll b/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/EV/EV.dll deleted file mode 100755 index 99a8ef28237..00000000000 Binary files a/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/EV/EV.dll and /dev/null differ diff --git a/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/Encode/Detect/Detector/Detector.dll b/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/Encode/Detect/Detector/Detector.dll deleted file mode 100755 index 62f2693029e..00000000000 Binary files a/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/Encode/Detect/Detector/Detector.dll and /dev/null differ diff --git a/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/Font/FreeType/FreeType.dll b/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/Font/FreeType/FreeType.dll deleted file mode 100755 index 6421239dffd..00000000000 Binary files a/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/Font/FreeType/FreeType.dll and /dev/null differ diff --git a/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/Image/Scale/Scale.dll b/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/Image/Scale/Scale.dll deleted file mode 100755 index c5c3bfca5e7..00000000000 Binary files a/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/Image/Scale/Scale.dll and /dev/null differ diff --git a/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/JSON/XS/XS.dll b/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/JSON/XS/XS.dll deleted file mode 100755 index e679a68abd6..00000000000 Binary files a/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/JSON/XS/XS.dll and /dev/null differ diff --git a/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/Locale/Hebrew/Hebrew.dll b/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/Locale/Hebrew/Hebrew.dll deleted file mode 100755 index 8e4407a6ff0..00000000000 Binary files a/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/Locale/Hebrew/Hebrew.dll and /dev/null differ diff --git a/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/MP3/Cut/Gapless/Gapless.dll b/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/MP3/Cut/Gapless/Gapless.dll deleted file mode 100755 index 6864ab7dee3..00000000000 Binary files a/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/MP3/Cut/Gapless/Gapless.dll and /dev/null differ diff --git a/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/Template/Stash/XS/XS.dll b/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/Template/Stash/XS/XS.dll deleted file mode 100755 index 21411385166..00000000000 Binary files a/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/Template/Stash/XS/XS.dll and /dev/null differ diff --git a/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/Win32/Process/List/List.dll b/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/Win32/Process/List/List.dll deleted file mode 100755 index 99995e0acd4..00000000000 Binary files a/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/Win32/Process/List/List.dll and /dev/null differ diff --git a/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/Win32/Process/List/autosplit.ix b/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/Win32/Process/List/autosplit.ix deleted file mode 100644 index fa14b89287c..00000000000 --- a/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/Win32/Process/List/autosplit.ix +++ /dev/null @@ -1,3 +0,0 @@ -# Index created by AutoSplit for blib\lib\Win32\Process\List.pm -# (file acts as timestamp) -1; diff --git a/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/XML/Parser/Expat/Expat.dll b/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/XML/Parser/Expat/Expat.dll deleted file mode 100755 index 3034106074c..00000000000 Binary files a/CPAN/arch/5.14/MSWin32-x86-multi-thread/auto/XML/Parser/Expat/Expat.dll and /dev/null differ diff --git a/CPAN/arch/5.32/DBD/SQLite.pm b/CPAN/arch/5.32/DBD/SQLite.pm index a719c10ea75..1032e1dcc70 100644 --- a/CPAN/arch/5.32/DBD/SQLite.pm +++ b/CPAN/arch/5.32/DBD/SQLite.pm @@ -3,10 +3,9 @@ package DBD::SQLite; use 5.006; use strict; use DBI 1.57 (); -use DynaLoader (); +use XSLoader (); -our $VERSION = '1.58'; -our @ISA = 'DynaLoader'; +our $VERSION = '1.76'; # sqlite_version cache (set in the XS bootstrap) our ($sqlite_version, $sqlite_version_number); @@ -14,7 +13,7 @@ our ($sqlite_version, $sqlite_version_number); # not sure if we still need these... our ($err, $errstr); -__PACKAGE__->bootstrap($VERSION); +XSLoader::load('DBD::SQLite', $VERSION); # New or old API? use constant NEWAPI => ($DBI::VERSION >= 1.608); @@ -47,6 +46,8 @@ sub driver { DBD::SQLite::db->install_method('sqlite_set_authorizer'); DBD::SQLite::db->install_method('sqlite_backup_from_file'); DBD::SQLite::db->install_method('sqlite_backup_to_file'); + DBD::SQLite::db->install_method('sqlite_backup_from_dbh'); + DBD::SQLite::db->install_method('sqlite_backup_to_dbh'); DBD::SQLite::db->install_method('sqlite_enable_load_extension'); DBD::SQLite::db->install_method('sqlite_load_extension'); DBD::SQLite::db->install_method('sqlite_register_fts3_perl_tokenizer'); @@ -57,6 +58,11 @@ sub driver { DBD::SQLite::db->install_method('sqlite_db_status', { O => 0x0004 }); DBD::SQLite::st->install_method('sqlite_st_status', { O => 0x0004 }); DBD::SQLite::db->install_method('sqlite_create_module'); + DBD::SQLite::db->install_method('sqlite_limit'); + DBD::SQLite::db->install_method('sqlite_db_config'); + DBD::SQLite::db->install_method('sqlite_get_autocommit'); + DBD::SQLite::db->install_method('sqlite_txn_state'); + DBD::SQLite::db->install_method('sqlite_error_offset'); $methods_are_installed++; } @@ -180,7 +186,7 @@ sub install_collation { # default implementation for sqlite 'REGEXP' infix operator. # Note : args are reversed, i.e. "a REGEXP b" calls REGEXP(b, a) -# (see http://www.sqlite.org/vtab.html#xfindfunction) +# (see https://www.sqlite.org/vtab.html#xfindfunction) sub regexp { use locale; return if !defined $_[0] || !defined $_[1]; @@ -190,6 +196,8 @@ sub regexp { package # hide from PAUSE DBD::SQLite::db; +use DBI qw/:sql_types/; + sub prepare { my $dbh = shift; my $sql = shift; @@ -245,19 +253,26 @@ sub ping { return $dbh->FETCH('Active') ? 1 : 0; } -sub _get_version { - return ( DBD::SQLite::db::FETCH($_[0], 'sqlite_version') ); +sub quote { + my ($self, $value, $data_type) = @_; + return "NULL" unless defined $value; + if (defined $data_type and ( + $data_type == DBI::SQL_BIT || + $data_type == DBI::SQL_BLOB || + $data_type == DBI::SQL_BINARY || + $data_type == DBI::SQL_VARBINARY || + $data_type == DBI::SQL_LONGVARBINARY)) { + return q(X') . unpack('H*', $value) . q('); + } + $value =~ s/'/''/g; + return "'$value'"; } -my %info = ( - 17 => 'SQLite', # SQL_DBMS_NAME - 18 => \&_get_version, # SQL_DBMS_VER - 29 => '"', # SQL_IDENTIFIER_QUOTE_CHAR -); - sub get_info { - my($dbh, $info_type) = @_; - my $v = $info{int($info_type)}; + my ($dbh, $info_type) = @_; + + require DBD::SQLite::GetInfo; + my $v = $DBD::SQLite::GetInfo::info{int($info_type)}; $v = $v->($dbh) if ref $v eq 'CODE'; return $v; } @@ -553,6 +568,15 @@ my @FOREIGN_KEY_INFO_SQL_CLI = qw( UNIQUE_OR_PRIMARY ); +my $DEFERRABLE_RE = qr/ + (?:(?: + on \s+ (?:delete|update) \s+ (?:set \s+ null|set \s+ default|cascade|restrict|no \s+ action) + | + match \s* (?:\S+|".+?(?selectall_arrayref("SELECT name FROM $master_table WHERE type = ?", undef, "table") or return; + my $tables = $dbh->selectall_arrayref("SELECT name, sql FROM $master_table WHERE type = ?", undef, "table") or return; for my $table (@$tables) { my $tbname = $table->[0]; + my $ddl = $table->[1]; + my (@rels, %relid2rels); next if defined $fk_table && $fk_table ne '%' && $fk_table ne $tbname; my $quoted_tbname = $dbh->quote_identifier($tbname); @@ -603,7 +629,17 @@ sub foreign_key_info { next if defined $pk_schema && $pk_schema ne '%' && $pk_schema ne $table_info{$row->{table}}{schema}; - push @fk_info, { + # cribbed from DBIx::Class::Schema::Loader::DBI::SQLite + my $rel = $rels[ $row->{id} ] ||= { + local_columns => [], + remote_columns => undef, + remote_table => $row->{table}, + }; + push @{ $rel->{local_columns} }, $row->{from}; + push @{ $rel->{remote_columns} }, $row->{to} + if defined $row->{to}; + + my $fk_row = { PKTABLE_CAT => undef, PKTABLE_SCHEM => $table_info{$row->{table}}{schema}, PKTABLE_NAME => $row->{table}, @@ -620,6 +656,44 @@ sub foreign_key_info { DEFERRABILITY => undef, UNIQUE_OR_PRIMARY => $table_info{$row->{table}}{columns}{$row->{to}} ? 'PRIMARY' : 'UNIQUE', }; + push @fk_info, $fk_row; + push @{ $relid2rels{$row->{id}} }, $fk_row; # keep so can fixup + } + + # cribbed from DBIx::Class::Schema::Loader::DBI::SQLite + # but with additional parsing of which kind of deferrable + REL: for my $relid (keys %relid2rels) { + my $rel = $rels[$relid]; + my $deferrable = $DBI_code_for_rule{'NOT DEFERRABLE'}; + my $local_cols = '"?' . (join '"? \s* , \s* "?', map quotemeta, @{ $rel->{local_columns} }) . '"?'; + my $remote_cols = '"?' . (join '"? \s* , \s* "?', map quotemeta, @{ $rel->{remote_columns} || [] }) . '"?'; + my ($deferrable_clause) = $ddl =~ / + foreign \s+ key \s* \( \s* $local_cols \s* \) \s* references \s* (?:\S+|".+?(?{local_columns} } == 1) { + my ($local_col) = @{ $rel->{local_columns} }; + my ($remote_col) = @{ $rel->{remote_columns} || [] }; + $remote_col ||= ''; + ($deferrable_clause) = $ddl =~ / + "?\Q$local_col\E"? \s* (?:\w+\s*)* (?: \( \s* \d\+ (?:\s*,\s*\d+)* \s* \) )? \s* + references \s+ (?:\S+|".+?(?{DEFERRABILITY} = $deferrable for @{ $relid2rels{$relid} }; } } } @@ -694,7 +768,7 @@ sub statistics_info { NON_UNIQUE => $row->{unique} ? 0 : 1, INDEX_QUALIFIER => undef, INDEX_NAME => $row->{name}, - TYPE => 'btree', # see http://www.sqlite.org/version3.html esp. "Traditional B-trees are still used for indices" + TYPE => 'btree', # see https://www.sqlite.org/version3.html esp. "Traditional B-trees are still used for indices" ORDINAL_POSITION => $info->{seqno} + 1, COLUMN_NAME => $info->{name}, ASC_OR_DESC => undef, @@ -721,45 +795,68 @@ sub statistics_info { return $sponge_sth; } +my @TypeInfoKeys = qw/ + TYPE_NAME + DATA_TYPE + COLUMN_SIZE + LITERAL_PREFIX + LITERAL_SUFFIX + CREATE_PARAMS + NULLABLE + CASE_SENSITIVE + SEARCHABLE + UNSIGNED_ATTRIBUTE + FIXED_PREC_SCALE + AUTO_UNIQUE_VALUE + LOCAL_TYPE_NAME + MINIMUM_SCALE + MAXIMUM_SCALE + SQL_DATA_TYPE + SQL_DATETIME_SUB + NUM_PREC_RADIX + INTERVAL_PRECISION +/; + +my %TypeInfo = ( + SQL_INTEGER ,=> { + TYPE_NAME => 'INTEGER', + DATA_TYPE => SQL_INTEGER, + NULLABLE => 2, # no for integer primary key, otherwise yes + SEARCHABLE => 3, + }, + SQL_DOUBLE ,=> { + TYPE_NAME => 'REAL', + DATA_TYPE => SQL_DOUBLE, + NULLABLE => 1, + SEARCHABLE => 3, + }, + SQL_VARCHAR ,=> { + TYPE_NAME => 'TEXT', + DATA_TYPE => SQL_VARCHAR, + LITERAL_PREFIX => "'", + LITERAL_SUFFIX => "'", + NULLABLE => 1, + SEARCHABLE => 3, + }, + SQL_BLOB ,=> { + TYPE_NAME => 'BLOB', + DATA_TYPE => SQL_BLOB, + NULLABLE => 1, + SEARCHABLE => 3, + }, + SQL_UNKNOWN_TYPE ,=> { + DATA_TYPE => SQL_UNKNOWN_TYPE, + }, +); + sub type_info_all { - return; # XXX code just copied from DBD::Oracle, not yet thought about -# return [ -# { -# TYPE_NAME => 0, -# DATA_TYPE => 1, -# COLUMN_SIZE => 2, -# LITERAL_PREFIX => 3, -# LITERAL_SUFFIX => 4, -# CREATE_PARAMS => 5, -# NULLABLE => 6, -# CASE_SENSITIVE => 7, -# SEARCHABLE => 8, -# UNSIGNED_ATTRIBUTE => 9, -# FIXED_PREC_SCALE => 10, -# AUTO_UNIQUE_VALUE => 11, -# LOCAL_TYPE_NAME => 12, -# MINIMUM_SCALE => 13, -# MAXIMUM_SCALE => 14, -# SQL_DATA_TYPE => 15, -# SQL_DATETIME_SUB => 16, -# NUM_PREC_RADIX => 17, -# }, -# [ 'CHAR', 1, 255, '\'', '\'', 'max length', 1, 1, 3, -# undef, '0', '0', undef, undef, undef, 1, undef, undef -# ], -# [ 'NUMBER', 3, 38, undef, undef, 'precision,scale', 1, '0', 3, -# '0', '0', '0', undef, '0', 38, 3, undef, 10 -# ], -# [ 'DOUBLE', 8, 15, undef, undef, undef, 1, '0', 3, -# '0', '0', '0', undef, undef, undef, 8, undef, 10 -# ], -# [ 'DATE', 9, 19, '\'', '\'', undef, 1, '0', 3, -# undef, '0', '0', undef, '0', '0', 11, undef, undef -# ], -# [ 'VARCHAR', 12, 1024*1024, '\'', '\'', 'max length', 1, 1, 3, -# undef, '0', '0', undef, undef, undef, 12, undef, undef -# ] -# ]; + my $idx = 0; + + my @info = ({map {$_ => $idx++} @TypeInfoKeys}); + for my $id (sort {$a <=> $b} keys %TypeInfo) { + push @info, [map {$TypeInfo{$id}{$_}} @TypeInfoKeys]; + } + return \@info; } my @COLUMN_INFO = qw( @@ -936,7 +1033,7 @@ DBD::SQLite - Self-contained RDBMS in a DBI Driver =head1 DESCRIPTION SQLite is a public domain file-based relational database engine that -you can find at L. +you can find at L. B is a Perl DBI driver for SQLite, that includes the entire thing in the distribution. @@ -950,7 +1047,7 @@ SQLite supports the following features: =item Implements a large subset of SQL92 -See L for details. +See L for details. =item A complete DB in a single disk file @@ -977,7 +1074,7 @@ are limited by the typeless nature of the SQLite database. =head1 SQLITE VERSION DBD::SQLite is usually compiled with a bundled SQLite library -(SQLite version S<3.22.0> as of this release) for consistency. +(SQLite version S<3.46.1> as of this release) for consistency. However, a different version of SQLite may sometimes be used for some reasons like security, or some new experimental features. @@ -1021,7 +1118,7 @@ If the filename C<$dbfile> is an empty string, then a private, temporary on-disk database will be created. This private database will be automatically deleted as soon as the database connection is closed. -As of 1.41_01, you can pass URI filename (see L) +As of 1.41_01, you can pass URI filename (see L) as well for finer control: my $dbh = DBI->connect("dbi:SQLite:uri=file:$path_to_dbfile?mode=rwc"); @@ -1038,7 +1135,7 @@ You can set sqlite_open_flags (only) when you connect to a database: sqlite_open_flags => SQLITE_OPEN_READONLY, }); -See L for details. +See L for details. As of 1.49_05, you can also make a database read-only by setting C attribute to true (only) when you connect to a database. @@ -1156,7 +1253,7 @@ like this while executing: SELECT bar FROM foo GROUP BY bar HAVING count(*) > "5"; -There are three workarounds for this. +There are four workarounds for this. =over 4 @@ -1182,6 +1279,15 @@ This is somewhat weird, but works anyway. }); $sth->execute(5); +=item Use SQL cast() function + +This is more explicit way to do the above. + + my $sth = $dbh->prepare(q{ + SELECT bar FROM foo GROUP BY bar HAVING count(*) > cast(? as integer); + }); + $sth->execute(5); + =item Set C database handle attribute As of version 1.32_02, you can use C @@ -1230,7 +1336,7 @@ SQLite supports several placeholder expressions, including C and C<:AAAA>. Consult the L and SQLite documentation for details. -L +L Note that a question mark actually means a next unused (numbered) placeholder. You're advised not to use it with other (numbered or @@ -1300,7 +1406,7 @@ in the worst case. See also L section below. =back -See L for more details. +See L for more details. =head2 Foreign Keys @@ -1328,7 +1434,7 @@ SQLite, be prepared, and please do extensive testing to ensure that your applications will continue to work when the foreign keys support is enabled by default. -See L for details. +See L for details. =head2 Transactions @@ -1382,7 +1488,7 @@ automatically begin if you execute another statement. This C mode is independent from the autocommit mode of the internal SQLite library, which always begins by a C -statement, and ends by a C or a . +statement, and ends by a C or a C. =head2 Transaction and Database Locking @@ -1451,9 +1557,22 @@ of the rest (since 1.30_01, and without creating DBI's statement handles internally since 1.47_01). If you do need to use C or C (which I don't recommend in this case, because typically there's no placeholder nor reusable part in a dump), -you can look at << $sth->{sqlite_unprepared_statements} >> to retrieve +you can look at C<< $sth->{sqlite_unprepared_statements} >> to retrieve what's left, though it usually contains nothing but white spaces. +=head2 TYPE statement attribute + +Because of historical reasons, DBD::SQLite's C statement +handle attribute returns an array ref of string values, contrary to +the DBI specification. This value is also less useful for SQLite +users because SQLite uses dynamic type system (that means, +the datatype of a value is associated with the value itself, not +with its container). + +As of version 1.61_02, if you set C +database handle attribute to true, C statement handle +attribute returns an array of integer, as an experiment. + =head2 Performance SQLite is fast, very fast. Matt processed his 72MB log file with it, @@ -1502,34 +1621,74 @@ Your sweet spot probably lies somewhere in between. =item sqlite_version Returns the version of the SQLite library which B is using, -e.g., "2.8.0". Can only be read. +e.g., "3.26.0". Can only be read. + +=item sqlite_string_mode + +SQLite strings are simple arrays of bytes, but Perl strings can store any +arbitrary Unicode code point. Thus, DBD::SQLite has to adopt some method +of translating between those two models. This parameter defines that +translation. + +Accepted values are the following constants: -=item sqlite_unicode +=over + +=item * DBD_SQLITE_STRING_MODE_BYTES: All strings are assumed to +represent bytes. A Perl string that contains any code point above 255 +will trigger an exception. This is appropriate for Latin-1 strings, +binary data, pre-encoded UTF-8 strings, etc. + +=item * DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK: All Perl strings are encoded +to UTF-8 before being given to SQLite. Perl will B to decode SQLite +strings as UTF-8 when giving them to Perl. Should any such string not be +valid UTF-8, a warning is thrown, and the string is left undecoded. -If set to a true value, B will turn the UTF-8 flag on for all -text strings coming out of the database (this feature is currently disabled -for perl < 5.8.5). For more details on the UTF-8 flag see -L. The default is for the UTF-8 flag to be turned off. +This is appropriate for strings that are decoded to characters via, +e.g., L. -Also note that due to some bizarreness in SQLite's type system (see -L), if you want to retain -blob-style behavior for B columns under C<< $dbh->{sqlite_unicode} = 1 ->> (say, to store images in the database), you have to state so +Also note that, due to some bizarreness in SQLite's type system (see +L), if you want to retain +blob-style behavior for B columns under DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK +(say, to store images in the database), you have to state so explicitly using the 3-argument form of L when doing updates: use DBI qw(:sql_types); - $dbh->{sqlite_unicode} = 1; + use DBD::SQLite::Constants ':dbd_sqlite_string_mode'; + $dbh->{sqlite_string_mode} = DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK; my $sth = $dbh->prepare("INSERT INTO mytable (blobcolumn) VALUES (?)"); - + # Binary_data will be stored as is. $sth->bind_param(1, $binary_data, SQL_BLOB); Defining the column type as C in the DDL is B sufficient. -This attribute was originally named as C, and renamed to -C for integrity since version 1.26_06. Old C -attribute is still accessible but will be deprecated in the near future. +=item * DBD_SQLITE_STRING_MODE_UNICODE_STRICT: Like +DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK but usually throws an exception +rather than a warning if SQLite sends invalid UTF-8. (In Perl callbacks +from SQLite we still warn instead.) + +=item * DBD_SQLITE_STRING_MODE_UNICODE_NAIVE: Like +DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK but uses a "naïve" UTF-8 decoding +method that forgoes validation. This is marginally faster than a validated +decode, but it can also B B B + +=item * DBD_SQLITE_STRING_MODE_PV (default, but B B B): Like +DBD_SQLITE_STRING_MODE_BYTES, but when translating Perl strings to SQLite +the Perl string's internal byte buffer is given to SQLite. B B +B, but it's been the default for many years, and changing that would +break existing applications. + +=back + +=item C or C (deprecated) + +If truthy, equivalent to setting C to +DBD_SQLITE_STRING_MODE_UNICODE_NAIVE; if falsy, equivalent to +DBD_SQLITE_STRING_MODE_PV. + +Prefer C in all new code. =item sqlite_allow_multiple_statements @@ -1556,7 +1715,12 @@ for details. =item sqlite_extended_result_codes If set to true, DBD::SQLite uses extended result codes where appropriate -(see L). +(see L). + +=item sqlite_defensive + +If set to true, language features that allow ordinary SQL to deliberately +corrupt the database file are prohibited. =back @@ -1585,7 +1749,8 @@ Returns all tables and schemas (databases) as specified in L. The schema and table arguments will do a C search. You can specify an ESCAPE character by including an 'Escape' attribute in \%attr. The C<$type> argument accepts a comma separated list of the following types 'TABLE', -'VIEW', 'LOCAL TEMPORARY' and 'SYSTEM TABLE' (by default all are returned). +'INDEX', 'VIEW', 'TRIGGER', 'LOCAL TEMPORARY' and 'SYSTEM TABLE' +(by default all are returned). Note that a statement handle is returned, and not a direct list of tables. The following fields are returned: @@ -1598,8 +1763,8 @@ databases will be in the name given when the database was attached. B: The name of the table or view. -B: The type of object returned. Will be one of 'TABLE', 'VIEW', -'LOCAL TEMPORARY' or 'SYSTEM TABLE'. +B: The type of object returned. Will be one of 'TABLE', 'INDEX', +'VIEW', 'TRIGGER', 'LOCAL TEMPORARY' or 'SYSTEM TABLE'. =head2 primary_key, primary_key_info @@ -1665,10 +1830,12 @@ B: The referential action for the DELETE rule. The codes are the same as for UPDATE_RULE. -Unfortunately, the B field is always C; -as a matter of fact, deferrability clauses are supported by SQLite, -but they can't be reported because the C -tells nothing about them. +B: +The following codes are defined: + + INITIALLY DEFERRED 5 + INITIALLY IMMEDIATE 6 + NOT DEFERRABLE 7 B: Whether the column is primary or unique. @@ -1728,7 +1895,7 @@ returns true if the database file exists (or the database is in-memory), and the The following methods can be called via the func() method with a little tweak, but the use of func() method is now discouraged by the L author for various reasons (see DBI's document -L +L for details). So, if you're using L >= 1.608, use these C methods. If you need to use an older L, you can call these like this: @@ -1755,7 +1922,8 @@ C<$dbh-Esqlite_last_insert_rowid()> directly. =head2 $dbh->sqlite_db_filename() -Retrieve the current (main) database filename. If the database is in-memory or temporary, this returns C. +Retrieve the current (main) database filename. If the database is in-memory +or temporary, this returns an empty string, or C. =head2 $dbh->sqlite_busy_timeout() @@ -1801,6 +1969,13 @@ After this, it could be used from SQL as: INSERT INTO mytable ( now() ); +The function should return a scalar value, and the value is treated as a text +(or a number if appropriate) by default. If you do need to specify a type +of the return value (like BLOB), you can return a reference to an array that +contains the value and the type, as of 1.65_01. + + $dbh->sqlite_create_function( 'md5', 1, sub { return [md5($_[0]), SQL_BLOB] } ); + =head3 REGEXP function SQLite includes syntactic support for an infix operator 'REGEXP', but @@ -2105,18 +2280,39 @@ special :memory: database, and you wish to populate it from an existing DB. This method accesses the SQLite Online Backup API, and will take a backup of the currently connected database, and write it out to the named file. +=head2 $dbh->sqlite_backup_from_dbh( $another_dbh ) + +This method accesses the SQLite Online Backup API, and will take a backup of +the database for the passed handle, copying it to, and overwriting, your current database +connection. This can be particularly handy if your current connection is to the +special :memory: database, and you wish to populate it from an existing DB. +You can use this to backup from an in-memory database to another in-memory database. + +=head2 $dbh->sqlite_backup_to_dbh( $another_dbh ) + +This method accesses the SQLite Online Backup API, and will take a backup of +the currently connected database, and write it out to the passed database handle. + =head2 $dbh->sqlite_enable_load_extension( $bool ) Calling this method with a true value enables loading (external) SQLite3 extensions. After the call, you can load extensions like this: $dbh->sqlite_enable_load_extension(1); - $sth = $dbh->prepare("select load_extension('libsqlitefunctions.so')") + $sth = $dbh->prepare("select load_extension('libmemvfs.so')") or die "Cannot prepare: " . $dbh->errstr(); =head2 $dbh->sqlite_load_extension( $file, $proc ) -Loading an extension by a select statement (with the "load_extension" SQLite3 function like above) has some limitations. If you need to, say, create other functions from an extension, use this method. $file (a path to the extension) is mandatory, and $proc (an entry point name) is optional. You need to call C before calling C. +Loading an extension by a select statement (with the "load_extension" SQLite3 function like above) has some limitations. If the extension you want to use creates other functions that are not native to SQLite, use this method instead. $file (a path to the extension) is mandatory, and $proc (an entry point name) is optional. You need to call C before calling C: + + $dbh->sqlite_enable_load_extension(1); + $dbh->sqlite_load_extension('libsqlitefunctions.so') + or die "Cannot load extension: " . $dbh->errstr(); + +If the extension uses SQLite mutex functions like C, then +the extension should be compiled with the same C compile-time +setting as this module, see C. =head2 $dbh->sqlite_trace( $code_ref ) @@ -2177,17 +2373,38 @@ is for internal use only. =head2 $dbh->sqlite_db_status() -Returns a hash reference that holds a set of status information of database connection such as cache usage. See L for details. You may also pass 0 as an argument to reset the status. +Returns a hash reference that holds a set of status information of database connection such as cache usage. See L for details. You may also pass 0 as an argument to reset the status. =head2 $sth->sqlite_st_status() -Returns a hash reference that holds a set of status information of SQLite statement handle such as full table scan count. See L for details. Statement status only holds the current value. +Returns a hash reference that holds a set of status information of SQLite statement handle such as full table scan count. See L for details. Statement status only holds the current value. my $status = $sth->sqlite_st_status(); my $cur = $status->{fullscan_step}; You may also pass 0 as an argument to reset the status. +=head2 $dbh->sqlite_db_config( $id, $new_integer_value ) + +You can change how the connected database should behave like this: + + use DBD::SQLite::Constants qw/:database_connection_configuration_options/; + + my $dbh = DBI->connect('dbi:SQLite::memory:'); + + # This disables language features that allow ordinary SQL + # to deliberately corrupt the database file + $dbh->sqlite_db_config( SQLITE_DBCONFIG_DEFENSIVE, 1 ); + + # This disables two-arg version of fts3_tokenizer. + $dbh->sqlite_db_config( SQLITE_DBCONFIG_ENABLE_FTS3_TOKENIZER, 0 ); + +C returns the new value after the call. If you just want to know the current value without changing anything, pass a negative integer value. + + my $current_value = $dbh->sqlite_db_config( SQLITE_DBCONFIG_DEFENSIVE, -1 ); + +As of this writing, C only supports options that set an integer value. C and C are not supported. See also C for details. + =head2 $dbh->sqlite_create_module() Registers a name for a I. Module names must be @@ -2195,6 +2412,33 @@ registered before creating a new virtual table using the module and before using a preexisting virtual table for the module. Virtual tables are explained in L. +=head2 $dbh->sqlite_limit( $category_id, $new_value ) + +Sets a new run-time limit for the category, and returns the current limit. +If the new value is a negative number (or omitted), the limit is unchanged +and just returns the current limit. Category ids (SQLITE_LIMIT_LENGTH, +SQLITE_LIMIT_VARIABLE_NUMBER, etc) can be imported from DBD::SQLite::Constants. + +=head2 $dbh->sqlite_get_autocommit() + +Returns true if the internal SQLite connection is in an autocommit mode. +This does not always return the same value as C<< $dbh->{AutoCommit} >>. +This returns false if you explicitly issue a C<> statement. + +=head2 $dbh->sqlite_txn_state() + +Returns the internal transaction status of SQLite (not of DBI). +Return values (SQLITE_TXN_NONE, SQLITE_TXN_READ, SQLITE_TXN_WRITE) +can be imported from DBD::SQLite::Constants. You may pass an optional +schema name (usually "main"). If SQLite does not support this function, +or if you pass a wrong schema name, -1 is returned. + +=head2 $dbh->sqlite_error_offset() + +Returns the byte offset of the start of a problematic input SQL token +or -1 if the most recent error does not reference a specific token in +the input SQL (or DBD::SQLite is built with an older version of SQLite). + =head1 DRIVER FUNCTIONS =head2 DBD::SQLite::compile_options() @@ -2205,7 +2449,7 @@ library is old or compiled with SQLITE_OMIT_COMPILEOPTION_DIAGS. =head2 DBD::SQLite::sqlite_status() -Returns a hash reference that holds a set of status information of SQLite runtime such as memory usage or page cache usage (see L for details). Each of the entry contains the current value and the highwater value. +Returns a hash reference that holds a set of status information of SQLite runtime such as memory usage or page cache usage (see L for details). Each of the entry contains the current value and the highwater value. my $status = DBD::SQLite::sqlite_status(); my $cur = $status->{memory_used}{current}; @@ -2239,7 +2483,7 @@ DELETE operation would be written as follows : The list of constants implemented in C is given below; more information can be found ad -at L. +at L. =head2 Authorizer Return Codes @@ -2299,7 +2543,7 @@ associated strings. SQLite v3 provides the ability for users to supply arbitrary comparison functions, known as user-defined "collation sequences" or "collating functions", to be used for comparing two text values. -L +L explains how collations are used in various SQL expressions. =head2 Builtin collation sequences @@ -2357,18 +2601,17 @@ or =head2 Unicode handling -If the attribute C<< $dbh->{sqlite_unicode} >> is set, strings coming from -the database and passed to the collation function will be properly -tagged with the utf8 flag; but this only works if the -C attribute is set B the first call to -a perl collation sequence . The recommended way to activate unicode -is to set the parameter at connection time : +Depending on the C<< $dbh->{sqlite_string_mode} >> value, strings coming +from the database and passed to the collation function may be decoded as +UTF-8. This only works, though, if the C attribute is +set B the first call to a perl collation sequence. The recommended +way to activate unicode is to set C at connection time: my $dbh = DBI->connect( "dbi:SQLite:dbname=foo", "", "", { - RaiseError => 1, - sqlite_unicode => 1, + RaiseError => 1, + sqlite_string_mode => DBD_SQLITE_STRING_MODE_UNICODE_STRICT, } ); @@ -2390,7 +2633,7 @@ characters : use DBD::SQLite; $DBD::SQLite::COLLATION{no_accents} = sub { my ( $a, $b ) = map lc, @_; - tr[] + tr[àâáäåãçðèêéëìîíïñòôóöõøùûúüý] [aaaaaacdeeeeiiiinoooooouuuuy] for $a, $b; $a cmp $b; }; @@ -2463,7 +2706,7 @@ then query which buildings overlap or are contained within a specified region: $minLong, $maxLong, $minLat, $maxLat); For more detail, please see the SQLite R-Tree page -(L). Note that custom R-Tree +(L). Note that custom R-Tree queries using callbacks, as mentioned in the prior link, have not been implemented yet. @@ -2547,13 +2790,17 @@ Reading/writing into blobs using C / C. =head2 Support for custom callbacks for R-Tree queries Custom queries of a R-Tree index using a callback are possible with -the SQLite C API (L), so one could +the SQLite C API (L), so one could potentially use a callback that narrowed the result set down based on a specific need, such as querying for overlapping circles. =head1 SUPPORT -Bugs should be reported via the CPAN bug tracker at +Bugs should be reported to GitHub issues: + +L + +or via RT if you prefer: L diff --git a/CPAN/arch/5.32/DBD/SQLite/Constants.pm b/CPAN/arch/5.32/DBD/SQLite/Constants.pm index a9f55dcab90..5be8f0aa4bd 100644 --- a/CPAN/arch/5.32/DBD/SQLite/Constants.pm +++ b/CPAN/arch/5.32/DBD/SQLite/Constants.pm @@ -8,6 +8,18 @@ use warnings; use base 'Exporter'; use DBD::SQLite; our @EXPORT_OK = ( + 'DBD_SQLITE_STRING_MODE_PV', + 'DBD_SQLITE_STRING_MODE_BYTES', + 'DBD_SQLITE_STRING_MODE_UNICODE_NAIVE', + 'DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK', + 'DBD_SQLITE_STRING_MODE_UNICODE_STRICT', + # allowed_return_values_from_sqlite3_txn_state + qw/ + SQLITE_TXN_NONE + SQLITE_TXN_READ + SQLITE_TXN_WRITE + /, + # authorizer_action_codes qw/ SQLITE_ALTER_TABLE @@ -57,27 +69,62 @@ our @EXPORT_OK = ( SQLITE_VERSION_NUMBER /, + # database_connection_configuration_options + qw/ + SQLITE_DBCONFIG_DEFENSIVE + SQLITE_DBCONFIG_DQS_DDL + SQLITE_DBCONFIG_DQS_DML + SQLITE_DBCONFIG_ENABLE_FKEY + SQLITE_DBCONFIG_ENABLE_FTS3_TOKENIZER + SQLITE_DBCONFIG_ENABLE_LOAD_EXTENSION + SQLITE_DBCONFIG_ENABLE_QPSG + SQLITE_DBCONFIG_ENABLE_TRIGGER + SQLITE_DBCONFIG_ENABLE_VIEW + SQLITE_DBCONFIG_LEGACY_ALTER_TABLE + SQLITE_DBCONFIG_LEGACY_FILE_FORMAT + SQLITE_DBCONFIG_LOOKASIDE + SQLITE_DBCONFIG_MAINDBNAME + SQLITE_DBCONFIG_MAX + SQLITE_DBCONFIG_NO_CKPT_ON_CLOSE + SQLITE_DBCONFIG_RESET_DATABASE + SQLITE_DBCONFIG_REVERSE_SCANORDER + SQLITE_DBCONFIG_STMT_SCANSTATUS + SQLITE_DBCONFIG_TRIGGER_EQP + SQLITE_DBCONFIG_TRUSTED_SCHEMA + SQLITE_DBCONFIG_WRITABLE_SCHEMA + /, + # extended_result_codes qw/ SQLITE_ABORT_ROLLBACK SQLITE_AUTH_USER SQLITE_BUSY_RECOVERY SQLITE_BUSY_SNAPSHOT + SQLITE_BUSY_TIMEOUT SQLITE_CANTOPEN_CONVPATH + SQLITE_CANTOPEN_DIRTYWAL SQLITE_CANTOPEN_FULLPATH SQLITE_CANTOPEN_ISDIR SQLITE_CANTOPEN_NOTEMPDIR + SQLITE_CANTOPEN_SYMLINK SQLITE_CONSTRAINT_CHECK SQLITE_CONSTRAINT_COMMITHOOK + SQLITE_CONSTRAINT_DATATYPE SQLITE_CONSTRAINT_FOREIGNKEY SQLITE_CONSTRAINT_FUNCTION SQLITE_CONSTRAINT_NOTNULL + SQLITE_CONSTRAINT_PINNED SQLITE_CONSTRAINT_PRIMARYKEY SQLITE_CONSTRAINT_ROWID SQLITE_CONSTRAINT_TRIGGER SQLITE_CONSTRAINT_UNIQUE SQLITE_CONSTRAINT_VTAB + SQLITE_CORRUPT_INDEX + SQLITE_CORRUPT_SEQUENCE SQLITE_CORRUPT_VTAB + SQLITE_ERROR_MISSING_COLLSEQ + SQLITE_ERROR_RETRY + SQLITE_ERROR_SNAPSHOT SQLITE_IOERR_ACCESS SQLITE_IOERR_AUTH SQLITE_IOERR_BEGIN_ATOMIC @@ -86,6 +133,8 @@ our @EXPORT_OK = ( SQLITE_IOERR_CLOSE SQLITE_IOERR_COMMIT_ATOMIC SQLITE_IOERR_CONVPATH + SQLITE_IOERR_CORRUPTFS + SQLITE_IOERR_DATA SQLITE_IOERR_DELETE SQLITE_IOERR_DELETE_NOENT SQLITE_IOERR_DIR_CLOSE @@ -93,6 +142,7 @@ our @EXPORT_OK = ( SQLITE_IOERR_FSTAT SQLITE_IOERR_FSYNC SQLITE_IOERR_GETTEMPPATH + SQLITE_IOERR_IN_PAGE SQLITE_IOERR_LOCK SQLITE_IOERR_MMAP SQLITE_IOERR_NOMEM @@ -110,10 +160,15 @@ our @EXPORT_OK = ( SQLITE_IOERR_VNODE SQLITE_IOERR_WRITE SQLITE_LOCKED_SHAREDCACHE + SQLITE_LOCKED_VTAB + SQLITE_NOTICE_RBU SQLITE_NOTICE_RECOVER_ROLLBACK SQLITE_NOTICE_RECOVER_WAL + SQLITE_OK_SYMLINK + SQLITE_READONLY_CANTINIT SQLITE_READONLY_CANTLOCK SQLITE_READONLY_DBMOVED + SQLITE_READONLY_DIRECTORY SQLITE_READONLY_RECOVERY SQLITE_READONLY_ROLLBACK SQLITE_WARNING_AUTOINDEX @@ -122,19 +177,26 @@ our @EXPORT_OK = ( # flags_for_file_open_operations qw/ SQLITE_OPEN_CREATE + SQLITE_OPEN_EXRESCODE SQLITE_OPEN_FULLMUTEX SQLITE_OPEN_MEMORY + SQLITE_OPEN_NOFOLLOW SQLITE_OPEN_NOMUTEX SQLITE_OPEN_PRIVATECACHE SQLITE_OPEN_READONLY SQLITE_OPEN_READWRITE SQLITE_OPEN_SHAREDCACHE + SQLITE_OPEN_SUPER_JOURNAL SQLITE_OPEN_URI /, # function_flags qw/ SQLITE_DETERMINISTIC + SQLITE_DIRECTONLY + SQLITE_INNOCUOUS + SQLITE_RESULT_SUBTYPE + SQLITE_SUBTYPE /, # fundamental_datatypes @@ -143,6 +205,7 @@ our @EXPORT_OK = ( SQLITE_FLOAT SQLITE_INTEGER SQLITE_NULL + SQLITE_TEXT /, # result_codes @@ -180,6 +243,22 @@ our @EXPORT_OK = ( SQLITE_WARNING /, + # run_time_limit_categories + qw/ + SQLITE_LIMIT_ATTACHED + SQLITE_LIMIT_COLUMN + SQLITE_LIMIT_COMPOUND_SELECT + SQLITE_LIMIT_EXPR_DEPTH + SQLITE_LIMIT_FUNCTION_ARG + SQLITE_LIMIT_LENGTH + SQLITE_LIMIT_LIKE_PATTERN_LENGTH + SQLITE_LIMIT_SQL_LENGTH + SQLITE_LIMIT_TRIGGER_DEPTH + SQLITE_LIMIT_VARIABLE_NUMBER + SQLITE_LIMIT_VDBE_OP + SQLITE_LIMIT_WORKER_THREADS + /, + ); our %EXPORT_TAGS = ( @@ -195,17 +274,22 @@ our %EXPORT_TAGS = ( SQLITE_BUSY SQLITE_BUSY_RECOVERY SQLITE_BUSY_SNAPSHOT + SQLITE_BUSY_TIMEOUT SQLITE_CANTOPEN SQLITE_CANTOPEN_CONVPATH + SQLITE_CANTOPEN_DIRTYWAL SQLITE_CANTOPEN_FULLPATH SQLITE_CANTOPEN_ISDIR SQLITE_CANTOPEN_NOTEMPDIR + SQLITE_CANTOPEN_SYMLINK SQLITE_CONSTRAINT SQLITE_CONSTRAINT_CHECK SQLITE_CONSTRAINT_COMMITHOOK + SQLITE_CONSTRAINT_DATATYPE SQLITE_CONSTRAINT_FOREIGNKEY SQLITE_CONSTRAINT_FUNCTION SQLITE_CONSTRAINT_NOTNULL + SQLITE_CONSTRAINT_PINNED SQLITE_CONSTRAINT_PRIMARYKEY SQLITE_CONSTRAINT_ROWID SQLITE_CONSTRAINT_TRIGGER @@ -213,6 +297,8 @@ our %EXPORT_TAGS = ( SQLITE_CONSTRAINT_VTAB SQLITE_COPY SQLITE_CORRUPT + SQLITE_CORRUPT_INDEX + SQLITE_CORRUPT_SEQUENCE SQLITE_CORRUPT_VTAB SQLITE_CREATE_INDEX SQLITE_CREATE_TABLE @@ -223,10 +309,37 @@ our %EXPORT_TAGS = ( SQLITE_CREATE_TRIGGER SQLITE_CREATE_VIEW SQLITE_CREATE_VTABLE + SQLITE_DBCONFIG_DEFENSIVE + SQLITE_DBCONFIG_DQS_DDL + SQLITE_DBCONFIG_DQS_DML + SQLITE_DBCONFIG_ENABLE_FKEY + SQLITE_DBCONFIG_ENABLE_FTS3_TOKENIZER + SQLITE_DBCONFIG_ENABLE_LOAD_EXTENSION + SQLITE_DBCONFIG_ENABLE_QPSG + SQLITE_DBCONFIG_ENABLE_TRIGGER + SQLITE_DBCONFIG_ENABLE_VIEW + SQLITE_DBCONFIG_LEGACY_ALTER_TABLE + SQLITE_DBCONFIG_LEGACY_FILE_FORMAT + SQLITE_DBCONFIG_LOOKASIDE + SQLITE_DBCONFIG_MAINDBNAME + SQLITE_DBCONFIG_MAX + SQLITE_DBCONFIG_NO_CKPT_ON_CLOSE + SQLITE_DBCONFIG_RESET_DATABASE + SQLITE_DBCONFIG_REVERSE_SCANORDER + SQLITE_DBCONFIG_STMT_SCANSTATUS + SQLITE_DBCONFIG_TRIGGER_EQP + SQLITE_DBCONFIG_TRUSTED_SCHEMA + SQLITE_DBCONFIG_WRITABLE_SCHEMA + DBD_SQLITE_STRING_MODE_BYTES + DBD_SQLITE_STRING_MODE_PV + DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK + DBD_SQLITE_STRING_MODE_UNICODE_NAIVE + DBD_SQLITE_STRING_MODE_UNICODE_STRICT SQLITE_DELETE SQLITE_DENY SQLITE_DETACH SQLITE_DETERMINISTIC + SQLITE_DIRECTONLY SQLITE_DONE SQLITE_DROP_INDEX SQLITE_DROP_TABLE @@ -239,11 +352,15 @@ our %EXPORT_TAGS = ( SQLITE_DROP_VTABLE SQLITE_EMPTY SQLITE_ERROR + SQLITE_ERROR_MISSING_COLLSEQ + SQLITE_ERROR_RETRY + SQLITE_ERROR_SNAPSHOT SQLITE_FLOAT SQLITE_FORMAT SQLITE_FULL SQLITE_FUNCTION SQLITE_IGNORE + SQLITE_INNOCUOUS SQLITE_INSERT SQLITE_INTEGER SQLITE_INTERNAL @@ -257,6 +374,8 @@ our %EXPORT_TAGS = ( SQLITE_IOERR_CLOSE SQLITE_IOERR_COMMIT_ATOMIC SQLITE_IOERR_CONVPATH + SQLITE_IOERR_CORRUPTFS + SQLITE_IOERR_DATA SQLITE_IOERR_DELETE SQLITE_IOERR_DELETE_NOENT SQLITE_IOERR_DIR_CLOSE @@ -264,6 +383,7 @@ our %EXPORT_TAGS = ( SQLITE_IOERR_FSTAT SQLITE_IOERR_FSYNC SQLITE_IOERR_GETTEMPPATH + SQLITE_IOERR_IN_PAGE SQLITE_IOERR_LOCK SQLITE_IOERR_MMAP SQLITE_IOERR_NOMEM @@ -280,8 +400,21 @@ our %EXPORT_TAGS = ( SQLITE_IOERR_UNLOCK SQLITE_IOERR_VNODE SQLITE_IOERR_WRITE + SQLITE_LIMIT_ATTACHED + SQLITE_LIMIT_COLUMN + SQLITE_LIMIT_COMPOUND_SELECT + SQLITE_LIMIT_EXPR_DEPTH + SQLITE_LIMIT_FUNCTION_ARG + SQLITE_LIMIT_LENGTH + SQLITE_LIMIT_LIKE_PATTERN_LENGTH + SQLITE_LIMIT_SQL_LENGTH + SQLITE_LIMIT_TRIGGER_DEPTH + SQLITE_LIMIT_VARIABLE_NUMBER + SQLITE_LIMIT_VDBE_OP + SQLITE_LIMIT_WORKER_THREADS SQLITE_LOCKED SQLITE_LOCKED_SHAREDCACHE + SQLITE_LOCKED_VTAB SQLITE_MISMATCH SQLITE_MISUSE SQLITE_NOLFS @@ -289,18 +422,23 @@ our %EXPORT_TAGS = ( SQLITE_NOTADB SQLITE_NOTFOUND SQLITE_NOTICE + SQLITE_NOTICE_RBU SQLITE_NOTICE_RECOVER_ROLLBACK SQLITE_NOTICE_RECOVER_WAL SQLITE_NULL SQLITE_OK + SQLITE_OK_SYMLINK SQLITE_OPEN_CREATE + SQLITE_OPEN_EXRESCODE SQLITE_OPEN_FULLMUTEX SQLITE_OPEN_MEMORY + SQLITE_OPEN_NOFOLLOW SQLITE_OPEN_NOMUTEX SQLITE_OPEN_PRIVATECACHE SQLITE_OPEN_READONLY SQLITE_OPEN_READWRITE SQLITE_OPEN_SHAREDCACHE + SQLITE_OPEN_SUPER_JOURNAL SQLITE_OPEN_URI SQLITE_PERM SQLITE_PRAGMA @@ -308,24 +446,38 @@ our %EXPORT_TAGS = ( SQLITE_RANGE SQLITE_READ SQLITE_READONLY + SQLITE_READONLY_CANTINIT SQLITE_READONLY_CANTLOCK SQLITE_READONLY_DBMOVED + SQLITE_READONLY_DIRECTORY SQLITE_READONLY_RECOVERY SQLITE_READONLY_ROLLBACK SQLITE_RECURSIVE SQLITE_REINDEX + SQLITE_RESULT_SUBTYPE SQLITE_ROW SQLITE_SAVEPOINT SQLITE_SCHEMA SQLITE_SELECT + SQLITE_SUBTYPE + SQLITE_TEXT SQLITE_TOOBIG SQLITE_TRANSACTION + SQLITE_TXN_NONE + SQLITE_TXN_READ + SQLITE_TXN_WRITE SQLITE_UPDATE SQLITE_VERSION_NUMBER SQLITE_WARNING SQLITE_WARNING_AUTOINDEX /], + allowed_return_values_from_sqlite3_txn_state => [qw/ + SQLITE_TXN_NONE + SQLITE_TXN_READ + SQLITE_TXN_WRITE + /], + authorizer_action_codes => [qw/ SQLITE_ALTER_TABLE SQLITE_ANALYZE @@ -372,26 +524,68 @@ our %EXPORT_TAGS = ( SQLITE_VERSION_NUMBER /], + database_connection_configuration_options => [qw/ + SQLITE_DBCONFIG_DEFENSIVE + SQLITE_DBCONFIG_DQS_DDL + SQLITE_DBCONFIG_DQS_DML + SQLITE_DBCONFIG_ENABLE_FKEY + SQLITE_DBCONFIG_ENABLE_FTS3_TOKENIZER + SQLITE_DBCONFIG_ENABLE_LOAD_EXTENSION + SQLITE_DBCONFIG_ENABLE_QPSG + SQLITE_DBCONFIG_ENABLE_TRIGGER + SQLITE_DBCONFIG_ENABLE_VIEW + SQLITE_DBCONFIG_LEGACY_ALTER_TABLE + SQLITE_DBCONFIG_LEGACY_FILE_FORMAT + SQLITE_DBCONFIG_LOOKASIDE + SQLITE_DBCONFIG_MAINDBNAME + SQLITE_DBCONFIG_MAX + SQLITE_DBCONFIG_NO_CKPT_ON_CLOSE + SQLITE_DBCONFIG_RESET_DATABASE + SQLITE_DBCONFIG_REVERSE_SCANORDER + SQLITE_DBCONFIG_STMT_SCANSTATUS + SQLITE_DBCONFIG_TRIGGER_EQP + SQLITE_DBCONFIG_TRUSTED_SCHEMA + SQLITE_DBCONFIG_WRITABLE_SCHEMA + /], + + dbd_sqlite_string_mode => [qw/ + DBD_SQLITE_STRING_MODE_BYTES + DBD_SQLITE_STRING_MODE_PV + DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK + DBD_SQLITE_STRING_MODE_UNICODE_NAIVE + DBD_SQLITE_STRING_MODE_UNICODE_STRICT + /], + extended_result_codes => [qw/ SQLITE_ABORT_ROLLBACK SQLITE_AUTH_USER SQLITE_BUSY_RECOVERY SQLITE_BUSY_SNAPSHOT + SQLITE_BUSY_TIMEOUT SQLITE_CANTOPEN_CONVPATH + SQLITE_CANTOPEN_DIRTYWAL SQLITE_CANTOPEN_FULLPATH SQLITE_CANTOPEN_ISDIR SQLITE_CANTOPEN_NOTEMPDIR + SQLITE_CANTOPEN_SYMLINK SQLITE_CONSTRAINT_CHECK SQLITE_CONSTRAINT_COMMITHOOK + SQLITE_CONSTRAINT_DATATYPE SQLITE_CONSTRAINT_FOREIGNKEY SQLITE_CONSTRAINT_FUNCTION SQLITE_CONSTRAINT_NOTNULL + SQLITE_CONSTRAINT_PINNED SQLITE_CONSTRAINT_PRIMARYKEY SQLITE_CONSTRAINT_ROWID SQLITE_CONSTRAINT_TRIGGER SQLITE_CONSTRAINT_UNIQUE SQLITE_CONSTRAINT_VTAB + SQLITE_CORRUPT_INDEX + SQLITE_CORRUPT_SEQUENCE SQLITE_CORRUPT_VTAB + SQLITE_ERROR_MISSING_COLLSEQ + SQLITE_ERROR_RETRY + SQLITE_ERROR_SNAPSHOT SQLITE_IOERR_ACCESS SQLITE_IOERR_AUTH SQLITE_IOERR_BEGIN_ATOMIC @@ -400,6 +594,8 @@ our %EXPORT_TAGS = ( SQLITE_IOERR_CLOSE SQLITE_IOERR_COMMIT_ATOMIC SQLITE_IOERR_CONVPATH + SQLITE_IOERR_CORRUPTFS + SQLITE_IOERR_DATA SQLITE_IOERR_DELETE SQLITE_IOERR_DELETE_NOENT SQLITE_IOERR_DIR_CLOSE @@ -407,6 +603,7 @@ our %EXPORT_TAGS = ( SQLITE_IOERR_FSTAT SQLITE_IOERR_FSYNC SQLITE_IOERR_GETTEMPPATH + SQLITE_IOERR_IN_PAGE SQLITE_IOERR_LOCK SQLITE_IOERR_MMAP SQLITE_IOERR_NOMEM @@ -424,10 +621,15 @@ our %EXPORT_TAGS = ( SQLITE_IOERR_VNODE SQLITE_IOERR_WRITE SQLITE_LOCKED_SHAREDCACHE + SQLITE_LOCKED_VTAB + SQLITE_NOTICE_RBU SQLITE_NOTICE_RECOVER_ROLLBACK SQLITE_NOTICE_RECOVER_WAL + SQLITE_OK_SYMLINK + SQLITE_READONLY_CANTINIT SQLITE_READONLY_CANTLOCK SQLITE_READONLY_DBMOVED + SQLITE_READONLY_DIRECTORY SQLITE_READONLY_RECOVERY SQLITE_READONLY_ROLLBACK SQLITE_WARNING_AUTOINDEX @@ -435,18 +637,25 @@ our %EXPORT_TAGS = ( flags_for_file_open_operations => [qw/ SQLITE_OPEN_CREATE + SQLITE_OPEN_EXRESCODE SQLITE_OPEN_FULLMUTEX SQLITE_OPEN_MEMORY + SQLITE_OPEN_NOFOLLOW SQLITE_OPEN_NOMUTEX SQLITE_OPEN_PRIVATECACHE SQLITE_OPEN_READONLY SQLITE_OPEN_READWRITE SQLITE_OPEN_SHAREDCACHE + SQLITE_OPEN_SUPER_JOURNAL SQLITE_OPEN_URI /], function_flags => [qw/ SQLITE_DETERMINISTIC + SQLITE_DIRECTONLY + SQLITE_INNOCUOUS + SQLITE_RESULT_SUBTYPE + SQLITE_SUBTYPE /], fundamental_datatypes => [qw/ @@ -454,6 +663,7 @@ our %EXPORT_TAGS = ( SQLITE_FLOAT SQLITE_INTEGER SQLITE_NULL + SQLITE_TEXT /], result_codes => [qw/ @@ -490,6 +700,21 @@ our %EXPORT_TAGS = ( SQLITE_WARNING /], + run_time_limit_categories => [qw/ + SQLITE_LIMIT_ATTACHED + SQLITE_LIMIT_COLUMN + SQLITE_LIMIT_COMPOUND_SELECT + SQLITE_LIMIT_EXPR_DEPTH + SQLITE_LIMIT_FUNCTION_ARG + SQLITE_LIMIT_LENGTH + SQLITE_LIMIT_LIKE_PATTERN_LENGTH + SQLITE_LIMIT_SQL_LENGTH + SQLITE_LIMIT_TRIGGER_DEPTH + SQLITE_LIMIT_VARIABLE_NUMBER + SQLITE_LIMIT_VDBE_OP + SQLITE_LIMIT_WORKER_THREADS + /], + ); $EXPORT_TAGS{version} = $EXPORT_TAGS{compile_time_library_version_numbers}; $EXPORT_TAGS{file_open} = $EXPORT_TAGS{flags_for_file_open_operations}; @@ -511,12 +736,24 @@ DBD::SQLite::Constants - common SQLite constants =head1 DESCRIPTION -You can import necessary SQLite constants from this module. Available tags are C, C, C, C (C), C, C (C), C, C (C), C. See L for the complete list of constants. +You can import necessary SQLite constants from this module. Available tags are C, C, C, C, C (C), C, C, C, C (C), C, C (C), C, C. See L for the complete list of constants. This module does not export anything by default. =head1 CONSTANTS +=head2 allowed_return_values_from_sqlite3_txn_state + +=over 4 + +=item SQLITE_TXN_NONE + +=item SQLITE_TXN_READ + +=item SQLITE_TXN_WRITE + +=back + =head2 authorizer_action_codes =over 4 @@ -609,6 +846,70 @@ This module does not export anything by default. =back +=head2 database_connection_configuration_options + +=over 4 + +=item SQLITE_DBCONFIG_LOOKASIDE + +=item SQLITE_DBCONFIG_ENABLE_FKEY + +=item SQLITE_DBCONFIG_ENABLE_TRIGGER + +=item SQLITE_DBCONFIG_ENABLE_FTS3_TOKENIZER + +=item SQLITE_DBCONFIG_ENABLE_LOAD_EXTENSION + +=item SQLITE_DBCONFIG_MAINDBNAME + +=item SQLITE_DBCONFIG_NO_CKPT_ON_CLOSE + +=item SQLITE_DBCONFIG_ENABLE_QPSG + +=item SQLITE_DBCONFIG_TRIGGER_EQP + +=item SQLITE_DBCONFIG_MAX + +=item SQLITE_DBCONFIG_RESET_DATABASE + +=item SQLITE_DBCONFIG_DEFENSIVE + +=item SQLITE_DBCONFIG_WRITABLE_SCHEMA + +=item SQLITE_DBCONFIG_LEGACY_ALTER_TABLE + +=item SQLITE_DBCONFIG_DQS_DML + +=item SQLITE_DBCONFIG_DQS_DDL + +=item SQLITE_DBCONFIG_ENABLE_VIEW + +=item SQLITE_DBCONFIG_LEGACY_FILE_FORMAT + +=item SQLITE_DBCONFIG_TRUSTED_SCHEMA + +=item SQLITE_DBCONFIG_STMT_SCANSTATUS + +=item SQLITE_DBCONFIG_REVERSE_SCANORDER + +=back + +=head2 dbd_sqlite_string_mode + +=over 4 + +=item DBD_SQLITE_STRING_MODE_PV + +=item DBD_SQLITE_STRING_MODE_BYTES + +=item DBD_SQLITE_STRING_MODE_UNICODE_NAIVE + +=item DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK + +=item DBD_SQLITE_STRING_MODE_UNICODE_STRICT + +=back + =head2 extended_result_codes =over 4 @@ -729,6 +1030,42 @@ This module does not export anything by default. =item SQLITE_IOERR_ROLLBACK_ATOMIC +=item SQLITE_ERROR_MISSING_COLLSEQ + +=item SQLITE_ERROR_RETRY + +=item SQLITE_READONLY_CANTINIT + +=item SQLITE_READONLY_DIRECTORY + +=item SQLITE_LOCKED_VTAB + +=item SQLITE_CORRUPT_SEQUENCE + +=item SQLITE_ERROR_SNAPSHOT + +=item SQLITE_CANTOPEN_DIRTYWAL + +=item SQLITE_CANTOPEN_SYMLINK + +=item SQLITE_CONSTRAINT_PINNED + +=item SQLITE_OK_SYMLINK + +=item SQLITE_IOERR_DATA + +=item SQLITE_BUSY_TIMEOUT + +=item SQLITE_CORRUPT_INDEX + +=item SQLITE_IOERR_CORRUPTFS + +=item SQLITE_CONSTRAINT_DATATYPE + +=item SQLITE_NOTICE_RBU + +=item SQLITE_IOERR_IN_PAGE + =back =head2 file_open (flags_for_file_open_operations) @@ -753,6 +1090,12 @@ This module does not export anything by default. =item SQLITE_OPEN_MEMORY +=item SQLITE_OPEN_NOFOLLOW + +=item SQLITE_OPEN_SUPER_JOURNAL + +=item SQLITE_OPEN_EXRESCODE + =back =head2 function_flags @@ -761,6 +1104,14 @@ This module does not export anything by default. =item SQLITE_DETERMINISTIC +=item SQLITE_DIRECTONLY + +=item SQLITE_SUBTYPE + +=item SQLITE_INNOCUOUS + +=item SQLITE_RESULT_SUBTYPE + =back =head2 datatypes (fundamental_datatypes) @@ -775,6 +1126,8 @@ This module does not export anything by default. =item SQLITE_NULL +=item SQLITE_TEXT + =back =head2 result_codes @@ -845,3 +1198,33 @@ This module does not export anything by default. =back +=head2 run_time_limit_categories + +=over 4 + +=item SQLITE_LIMIT_LENGTH + +=item SQLITE_LIMIT_SQL_LENGTH + +=item SQLITE_LIMIT_COLUMN + +=item SQLITE_LIMIT_EXPR_DEPTH + +=item SQLITE_LIMIT_COMPOUND_SELECT + +=item SQLITE_LIMIT_VDBE_OP + +=item SQLITE_LIMIT_FUNCTION_ARG + +=item SQLITE_LIMIT_ATTACHED + +=item SQLITE_LIMIT_LIKE_PATTERN_LENGTH + +=item SQLITE_LIMIT_VARIABLE_NUMBER + +=item SQLITE_LIMIT_TRIGGER_DEPTH + +=item SQLITE_LIMIT_WORKER_THREADS + +=back + diff --git a/CPAN/arch/5.32/DBD/SQLite/GetInfo.pm b/CPAN/arch/5.32/DBD/SQLite/GetInfo.pm new file mode 100644 index 00000000000..083bfa4c02c --- /dev/null +++ b/CPAN/arch/5.32/DBD/SQLite/GetInfo.pm @@ -0,0 +1,288 @@ +package DBD::SQLite::GetInfo; + +use 5.006; +use strict; +use warnings; + +use DBD::SQLite; + +# SQL_DRIVER_VER should be formatted as dd.dd.dddd +my $dbdversion = $DBD::SQLite::VERSION; +$dbdversion .= '_00' if $dbdversion =~ /^\d+\.\d+$/; +my $sql_driver_ver = sprintf("%02d.%02d.%04d", split(/[\._]/, $dbdversion)); + +# Full list of keys and their return types: DBI::Const::GetInfo::ODBC + +# Most of the key definitions can be gleaned from: +# +# https://docs.microsoft.com/en-us/sql/odbc/reference/syntax/sqlgetinfo-function + +our %info = ( + 20 => 'N', # SQL_ACCESSIBLE_PROCEDURES - No stored procedures to access + 19 => 'Y', # SQL_ACCESSIBLE_TABLES - SELECT access to all tables in table_info + 0 => 0, # SQL_ACTIVE_CONNECTIONS - No maximum connection limit + 116 => 0, # SQL_ACTIVE_ENVIRONMENTS - No "active environment" limit + 1 => 0, # SQL_ACTIVE_STATEMENTS - No concurrent activity limit + 169 => 127, # SQL_AGGREGATE_FUNCTIONS - Supports all SQL-92 aggregrate functions + 117 => 0, # SQL_ALTER_DOMAIN - No ALTER DOMAIN support + 86 => 1, # SQL_ALTER_TABLE - Only supports ADD COLUMN and table rename (not listed in enum) in ALTER TABLE statements + 10021 => 0, # SQL_ASYNC_MODE - No asynchronous support (in vanilla SQLite) + 120 => 0, # SQL_BATCH_ROW_COUNT - No special row counting access + 121 => 0, # SQL_BATCH_SUPPORT - No batches + 82 => 0, # SQL_BOOKMARK_PERSISTENCE - No bookmark support + 114 => 1, # SQL_CATALOG_LOCATION - Database comes first in identifiers + 10003 => 'Y', # SQL_CATALOG_NAME - Supports database names + 41 => '.', # SQL_CATALOG_NAME_SEPARATOR - Separated by dot + 42 => 'database', # SQL_CATALOG_TERM - SQLite calls catalogs databases + 92 => 1+4+8, # SQL_CATALOG_USAGE - Supported in calls to DML & table/index definiton (no procedures or permissions) + 10004 => 'UTF-8', # SQL_COLLATION_SEQ - SQLite 3 uses UTF-8 by default + 87 => 'Y', # SQL_COLUMN_ALIAS - Supports column aliases + 22 => 0, # SQL_CONCAT_NULL_BEHAVIOR - 'a'||NULL = NULL + +# SQLite has no CONVERT function, only CAST. However, it converts to every "affinity" it supports. +# +# The only SQL_CVT_* types it doesn't support are date/time types, as it has no concept of +# date/time values once inserted. These are only convertable to text-like types. GUIDs are in +# the same boat, having no real means of switching to a numeric format. +# +# text/binary types = 31723265 +# numeric types = 28926 +# date/time types = 1802240 +# total = 33554431 + + 48 => 1, # SQL_CONVERT_FUNCTIONS - CAST only + + 53 => 31723265+28926, # SQL_CONVERT_BIGINT + 54 => 31723265+28926, # SQL_CONVERT_BINARY + 55 => 31723265+28926, # SQL_CONVERT_BIT + 56 => 33554431, # SQL_CONVERT_CHAR + 57 => 31723265+1802240, # SQL_CONVERT_DATE + 58 => 31723265+28926, # SQL_CONVERT_DECIMAL + 59 => 31723265+28926, # SQL_CONVERT_DOUBLE + 60 => 31723265+28926, # SQL_CONVERT_FLOAT + 173 => 31723265, # SQL_CONVERT_GUID + 61 => 31723265+28926, # SQL_CONVERT_INTEGER + 123 => 31723265+1802240, # SQL_CONVERT_INTERVAL_DAY_TIME + 124 => 31723265+1802240, # SQL_CONVERT_INTERVAL_YEAR_MONTH + 71 => 31723265+28926, # SQL_CONVERT_LONGVARBINARY + 62 => 31723265+28926, # SQL_CONVERT_LONGVARCHAR + 63 => 31723265+28926, # SQL_CONVERT_NUMERIC + 64 => 31723265+28926, # SQL_CONVERT_REAL + 65 => 31723265+28926, # SQL_CONVERT_SMALLINT + 66 => 31723265+1802240, # SQL_CONVERT_TIME + 67 => 31723265+1802240, # SQL_CONVERT_TIMESTAMP + 68 => 31723265+28926, # SQL_CONVERT_TINYINT + 69 => 33554431, # SQL_CONVERT_VARBINARY + 70 => 33554431, # SQL_CONVERT_VARCHAR + 122 => 33554431, # SQL_CONVERT_WCHAR + 125 => 33554431, # SQL_CONVERT_WLONGVARCHAR + 126 => 33554431, # SQL_CONVERT_WVARCHAR + + 74 => 1, # SQL_CORRELATION_NAME - Table aliases are supported, but must be named differently + 127 => 0, # SQL_CREATE_ASSERTION - No CREATE ASSERTION support + 128 => 0, # SQL_CREATE_CHARACTER_SET - No CREATE CHARACTER SET support + 129 => 0, # SQL_CREATE_COLLATION - No CREATE COLLATION support + 130 => 0, # SQL_CREATE_DOMAIN - No CREATE DOMAIN support + 131 => 0, # SQL_CREATE_SCHEMA - No CREATE SCHEMA support + 132 => 16383-2-8-4096, # SQL_CREATE_TABLE - Most of the functionality of CREATE TABLE support + 133 => 0, # SQL_CREATE_TRANSLATION - No CREATE TRANSLATION support + 134 => 1, # SQL_CREATE_VIEW - CREATE VIEW, no WITH CHECK OPTION support + + 23 => 2, # SQL_CURSOR_COMMIT_BEHAVIOR - Cursors are preserved + 24 => 2, # SQL_CURSOR_ROLLBACK_BEHAVIOR - Cursors are preserved + 10001 => 0, # SQL_CURSOR_SENSITIVITY - Cursors have a concept of snapshots, though this depends on the transaction type + + 2 => \&sql_data_source_name, # SQL_DATA_SOURCE_NAME - The DSN + 25 => \&sql_data_source_read_only, # SQL_DATA_SOURCE_READ_ONLY - Might have a SQLITE_OPEN_READONLY flag + 16 => \&sql_database_name, # SQL_DATABASE_NAME - Self-explanatory + 119 => 0, # SQL_DATETIME_LITERALS - No support for SQL-92's super weird date/time literal format (ie: {d '2999-12-12'}) + 17 => 'SQLite', # SQL_DBMS_NAME - You are here + 18 => \&sql_dbms_ver, # SQL_DBMS_VER - This driver version + 170 => 1+2, # SQL_DDL_INDEX - Supports CREATE/DROP INDEX + 26 => 8, # SQL_DEFAULT_TXN_ISOLATION - Default is SERIALIZABLE (See "PRAGMA read_uncommitted") + 10002 => 'N', # SQL_DESCRIBE_PARAMETER - No DESCRIBE INPUT support + +# XXX: MySQL/Oracle fills in HDBC and HENV, but information on what should actually go there is +# hard to acquire. + +# 171 => undef, # SQL_DM_VER - Not a Driver Manager +# 3 => undef, # SQL_DRIVER_HDBC - Not a Driver Manager +# 135 => undef, # SQL_DRIVER_HDESC - Not a Driver Manager +# 4 => undef, # SQL_DRIVER_HENV - Not a Driver Manager +# 76 => undef, # SQL_DRIVER_HLIB - Not a Driver Manager +# 5 => undef, # SQL_DRIVER_HSTMT - Not a Driver Manager + 6 => 'libsqlite3odbc.so', # SQL_DRIVER_NAME - SQLite3 ODBC driver (if installed) + 77 => '03.00', # SQL_DRIVER_ODBC_VER - Same as sqlite3odbc.c + 7 => $sql_driver_ver, # SQL_DRIVER_VER - Self-explanatory + + 136 => 0, # SQL_DROP_ASSERTION - No DROP ASSERTION support + 137 => 0, # SQL_DROP_CHARACTER_SET - No DROP CHARACTER SET support + 138 => 0, # SQL_DROP_COLLATION - No DROP COLLATION support + 139 => 0, # SQL_DROP_DOMAIN - No DROP DOMAIN support + 140 => 0, # SQL_DROP_SCHEMA - No DROP SCHEMA support + 141 => 1, # SQL_DROP_TABLE - DROP TABLE support, no RESTRICT/CASCADE + 142 => 0, # SQL_DROP_TRANSLATION - No DROP TRANSLATION support + 143 => 1, # SQL_DROP_VIEW - DROP VIEW support, no RESTRICT/CASCADE + +# NOTE: This is based purely on what sqlite3odbc supports. +# +# Static CA1: NEXT, ABSOLUTE, RELATIVE, BOOKMARK, LOCK_NO_CHANGE, POSITION, UPDATE, DELETE, REFRESH, +# BULK_ADD, BULK_UPDATE_BY_BOOKMARK, BULK_DELETE_BY_BOOKMARK = 466511 +# +# Forward-only CA1: NEXT, BOOKMARK +# +# CA2: READ_ONLY_CONCURRENCY, LOCK_CONCURRENCY + + 144 => 0, # SQL_DYNAMIC_CURSOR_ATTRIBUTES1 - No dynamic cursor support + 145 => 0, # SQL_DYNAMIC_CURSOR_ATTRIBUTES2 - No dynamic cursor support + 146 => 1+8, # SQL_FORWARD_ONLY_CURSOR_ATTRIBUTES1 + 147 => 1+2, # SQL_FORWARD_ONLY_CURSOR_ATTRIBUTES2 + 150 => 0, # SQL_KEYSET_CURSOR_ATTRIBUTES1 - No keyset cursor support + 151 => 0, # SQL_KEYSET_CURSOR_ATTRIBUTES2 - No keyset cursor support + 167 => 466511, # SQL_STATIC_CURSOR_ATTRIBUTES1 + 168 => 1+2, # SQL_STATIC_CURSOR_ATTRIBUTES2 + + 27 => 'Y', # SQL_EXPRESSIONS_IN_ORDERBY - ORDER BY allows expressions + 8 => 63, # SQL_FETCH_DIRECTION - Cursors support next, first, last, prior, absolute, relative + 84 => 2, # SQL_FILE_USAGE - Single-tier driver, treats files as databases + 81 => 1+2+8, # SQL_GETDATA_EXTENSIONS - Same as sqlite3odbc.c + 88 => 3, # SQL_GROUP_BY - SELECT columns are independent of GROUP BY columns + 28 => 4, # SQL_IDENTIFIER_CASE - Not case-sensitive, stored in mixed case + 29 => '"', # SQL_IDENTIFIER_QUOTE_CHAR - Uses " for identifiers, though supports [] and ` as well + 148 => 0, # SQL_INDEX_KEYWORDS - No support for ASC/DESC/ALL for CREATE INDEX + 149 => 0, # SQL_INFO_SCHEMA_VIEWS - No support for INFORMATION_SCHEMA + 172 => 1+2, # SQL_INSERT_STATEMENT - INSERT...VALUES & INSERT...SELECT + 73 => 'N', # SQL_INTEGRITY - No support for "Integrity Enhancement Facility" + 89 => \&sql_keywords, # SQL_KEYWORDS - List of non-ODBC keywords + 113 => 'Y', # SQL_LIKE_ESCAPE_CLAUSE - Supports LIKE...ESCAPE + 78 => 1, # SQL_LOCK_TYPES - Only NO_CHANGE + + 10022 => 0, # SQL_MAX_ASYNC_CONCURRENT_STATEMENTS - No async mode + 112 => 1_000_000, # SQL_MAX_BINARY_LITERAL_LEN - SQLITE_MAX_SQL_LENGTH + 34 => 1_000_000, # SQL_MAX_CATALOG_NAME_LEN - SQLITE_MAX_SQL_LENGTH + 108 => 1_000_000, # SQL_MAX_CHAR_LITERAL_LEN - SQLITE_MAX_SQL_LENGTH + 97 => 2000, # SQL_MAX_COLUMNS_IN_GROUP_BY - SQLITE_MAX_COLUMN + 98 => 2000, # SQL_MAX_COLUMNS_IN_INDEX - SQLITE_MAX_COLUMN + 99 => 2000, # SQL_MAX_COLUMNS_IN_ORDER_BY - SQLITE_MAX_COLUMN + 100 => 2000, # SQL_MAX_COLUMNS_IN_SELECT - SQLITE_MAX_COLUMN + 101 => 2000, # SQL_MAX_COLUMNS_IN_TABLE - SQLITE_MAX_COLUMN + 30 => 1_000_000, # SQL_MAX_COLUMN_NAME_LEN - SQLITE_MAX_SQL_LENGTH + 1 => 1021, # SQL_MAX_CONCURRENT_ACTIVITIES - Typical filehandle limits + 31 => 1_000_000, # SQL_MAX_CURSOR_NAME_LEN - SQLITE_MAX_SQL_LENGTH + 0 => 1021, # SQL_MAX_DRIVER_CONNECTIONS - Typical filehandle limits + 10005 => 1_000_000, # SQL_MAX_IDENTIFIER_LEN - SQLITE_MAX_SQL_LENGTH + 102 => 2147483646*65536, # SQL_MAX_INDEX_SIZE - Tied to DB size, which is theortically 140TB + 32 => 1_000_000, # SQL_MAX_OWNER_NAME_LEN - SQLITE_MAX_SQL_LENGTH + 33 => 1_000_000, # SQL_MAX_PROCEDURE_NAME_LEN - SQLITE_MAX_SQL_LENGTH + 34 => 1_000_000, # SQL_MAX_QUALIFIER_NAME_LEN - SQLITE_MAX_SQL_LENGTH + 104 => 1_000_000, # SQL_MAX_ROW_SIZE - SQLITE_MAX_SQL_LENGTH (since INSERT has to be used) + 103 => 'Y', # SQL_MAX_ROW_SIZE_INCLUDES_LONG + 32 => 1_000_000, # SQL_MAX_SCHEMA_NAME_LEN - SQLITE_MAX_SQL_LENGTH + 105 => 1_000_000, # SQL_MAX_STATEMENT_LEN - SQLITE_MAX_SQL_LENGTH + 106 => 64, # SQL_MAX_TABLES_IN_SELECT - 64 tables, because of the bitmap in the query optimizer + 35 => 1_000_000, # SQL_MAX_TABLE_NAME_LEN - SQLITE_MAX_SQL_LENGTH + 107 => 0, # SQL_MAX_USER_NAME_LEN - No user support + + 37 => 'Y', # SQL_MULTIPLE_ACTIVE_TXN - Supports mulitple txns, though not nested + 36 => 'N', # SQL_MULT_RESULT_SETS - No batches + 111 => 'N', # SQL_NEED_LONG_DATA_LEN - Doesn't care about LONG + 75 => 1, # SQL_NON_NULLABLE_COLUMNS - Supports NOT NULL + 85 => 1, # SQL_NULL_COLLATION - NULLs first on ASC (low end) + 49 => 4194304+1, # SQL_NUMERIC_FUNCTIONS - Just ABS & ROUND (has RANDOM, but not RAND) + + 9 => 1, # SQL_ODBC_API_CONFORMANCE - Same as sqlite3odbc.c + 152 => 1, # SQL_ODBC_INTERFACE_CONFORMANCE - Same as sqlite3odbc.c + 12 => 0, # SQL_ODBC_SAG_CLI_CONFORMANCE - Same as sqlite3odbc.c + 15 => 0, # SQL_ODBC_SQL_CONFORMANCE - Same as sqlite3odbc.c + 10 => '03.00', # SQL_ODBC_VER - Same as sqlite3odbc.c + + 115 => 1+8+16+32+64, # SQL_OJ_CAPABILITIES - Supports all OUTER JOINs except RIGHT & FULL + 90 => 'N', # SQL_ORDER_BY_COLUMNS_IN_SELECT - ORDER BY columns don't have to be in the SELECT list + 38 => 'Y', # SQL_OUTER_JOINS - Supports OUTER JOINs + 153 => 2, # SQL_PARAM_ARRAY_ROW_COUNTS - Only has row counts for executed statements + 154 => 3, # SQL_PARAM_ARRAY_SELECTS - No support for arrays of parameters + 80 => 0, # SQL_POSITIONED_STATEMENTS - No support for positioned statements (WHERE CURRENT OF or SELECT FOR UPDATE) + 79 => 31, # SQL_POS_OPERATIONS - Supports all SQLSetPos operations + 21 => 'N', # SQL_PROCEDURES - No procedures + 40 => '', # SQL_PROCEDURE_TERM - No procedures + 93 => 4, # SQL_QUOTED_IDENTIFIER_CASE - Even quoted identifiers are case-insensitive + 11 => 'N', # SQL_ROW_UPDATES - No fancy cursor update support + 39 => '', # SQL_SCHEMA_TERM - No schemas + 91 => 0, # SQL_SCHEMA_USAGE - No schemas + 43 => 2, # SQL_SCROLL_CONCURRENCY - Updates/deletes on cursors lock the database + 44 => 1+16, # SQL_SCROLL_OPTIONS - Only supports static & forward-only cursors + 14 => '\\', # SQL_SEARCH_PATTERN_ESCAPE - Default escape character for LIKE is \ + 13 => \&sql_server_name, # SQL_SERVER_NAME - Just $dbh->{Name} + 94 => '', # SQL_SPECIAL_CHARACTERS - Other drivers tend to stick to the ASCII/Latin-1 range, and SQLite uses all of + # the lower 7-bit punctuation for other things + + 155 => 7, # SQL_SQL92_DATETIME_FUNCTIONS - Supports CURRENT_(DATE|TIME|TIMESTAMP) + 156 => 1+2+4+8, # SQL_SQL92_FOREIGN_KEY_DELETE_RULE - Support all ON DELETE options + 157 => 1+2+4+8, # SQL_SQL92_FOREIGN_KEY_UPDATE_RULE - Support all ON UPDATE options + 158 => 0, # SQL_SQL92_GRANT - No users; no support for GRANT + 159 => 0, # SQL_SQL92_NUMERIC_VALUE_FUNCTIONS - No support for any of the listed functions + 160 => 1+2+4+512+1024+2048+4096+8192, # SQL_SQL92_PREDICATES - Supports the important comparison operators + 161 => 2+16+64+128, # SQL_SQL92_RELATIONAL_JOIN_OPERATORS - Supports the important ones except RIGHT/FULL OUTER JOINs + 162 => 0, # SQL_SQL92_REVOKE - No users; no support for REVOKE + 163 => 1+2+8, # SQL_SQL92_ROW_VALUE_CONSTRUCTOR - Supports most row value constructors + 164 => 2+4, # SQL_SQL92_STRING_FUNCTIONS - Just UPPER & LOWER (has SUBSTR, but not SUBSTRING and SQL-92's weird TRIM syntax) + 165 => 1+2+4+8, # SQL_SQL92_VALUE_EXPRESSIONS - Supports all SQL-92 value expressions + + 118 => 1, # SQL_SQL_CONFORMANCE - SQL-92 Entry level + 83 => 0, # SQL_STATIC_SENSITIVITY - Cursors would lock the DB, so only old data is visible + 50 => 8+16+256+1024+16384+131072, # SQL_STRING_FUNCTIONS - LTRIM, LENGTH, REPLACE, RTRIM, CHAR, SOUNDEX + 95 => 1+2+4+8+16, # SQL_SUBQUERIES - Supports all of the subquery types + 51 => 4, # SQL_SYSTEM_FUNCTIONS - Only IFNULL + 45 => 'table', # SQL_TABLE_TERM - Tables are called tables + 109 => 0, # SQL_TIMEDATE_ADD_INTERVALS - No support for INTERVAL + 110 => 0, # SQL_TIMEDATE_DIFF_INTERVALS - No support for INTERVAL + 52 => 0x20000+0x40000+0x80000, # SQL_TIMEDATE_FUNCTIONS - Only supports CURRENT_(DATE|TIME|TIMESTAMP) + 46 => 2, # SQL_TXN_CAPABLE - Full transaction support for both DML & DDL + 72 => 1+8, # SQL_TXN_ISOLATION_OPTION - Supports read uncommitted and serializable + 96 => 1+2, # SQL_UNION - Supports UNION and UNION ALL + 47 => '', # SQL_USER_NAME - No users + + 166 => 1, # SQL_STANDARD_CLI_CONFORMANCE - X/Open CLI Version 1.0 + 10000 => 1992, # SQL_XOPEN_CLI_YEAR - Year for V1.0 +); + +sub sql_dbms_ver { + my $dbh = shift; + return $dbh->FETCH('sqlite_version'); +} + +sub sql_data_source_name { + my $dbh = shift; + return "dbi:SQLite:".$dbh->{Name}; +} + +sub sql_data_source_read_only { + my $dbh = shift; + my $flags = $dbh->FETCH('sqlite_open_flags') || 0; + return $dbh->{ReadOnly} || ($flags & DBD::SQLite::OPEN_READONLY()) ? 'Y' : 'N'; +} + +sub sql_database_name { + my $dbh = shift; + my $databases = $dbh->selectall_hashref('PRAGMA database_list', 'seq'); + return $databases->{0}{name}; +} + +sub sql_keywords { + # SQLite keywords minus ODBC keywords + return join ',', (qw< + ABORT AFTER ANALYZE ATTACH AUTOINCREMENT BEFORE CONFLICT DATABASE DETACH EACH EXCLUSIVE + EXPLAIN FAIL GLOB IF IGNORE INDEXED INSTEAD ISNULL LIMIT NOTNULL OFFSET + PLAN PRAGMA QUERY RAISE RECURSIVE REGEXP REINDEX RELEASE RENAME REPLACE ROW + SAVEPOINT TEMP TRIGGER VACUUM VIRTUAL WITHOUT + >); +} + +sub sql_server_name { + my $dbh = shift; + return $dbh->{Name}; +} + +1; + +__END__ diff --git a/CPAN/arch/5.32/DBD/SQLite/VirtualTable.pm b/CPAN/arch/5.32/DBD/SQLite/VirtualTable.pm index f8e054a7077..efcc19b72d9 100644 --- a/CPAN/arch/5.32/DBD/SQLite/VirtualTable.pm +++ b/CPAN/arch/5.32/DBD/SQLite/VirtualTable.pm @@ -5,7 +5,7 @@ use strict; use warnings; use Scalar::Util qw/weaken/; -our $VERSION = '1.58'; +our $VERSION = '1.76'; our @ISA; diff --git a/CPAN/arch/5.32/DBD/SQLite/VirtualTable/PerlData.pm b/CPAN/arch/5.32/DBD/SQLite/VirtualTable/PerlData.pm index 5af9977757c..0e58d7d0dae 100644 --- a/CPAN/arch/5.32/DBD/SQLite/VirtualTable/PerlData.pm +++ b/CPAN/arch/5.32/DBD/SQLite/VirtualTable/PerlData.pm @@ -88,7 +88,7 @@ sub BEST_INDEX { # in FILTER() for deciding which rows match the constraints. my @conditions; my $ix = 0; - foreach my $constraint (grep {$_->{usable}} @$constraints) { + foreach my $constraint (grep {$_->{usable} and exists $SQLOP2PERLOP{ $_->{op} } } @$constraints) { my $col = $constraint->{col}; my ($member, $optype); @@ -389,7 +389,7 @@ time. Here is a way to do it with a virtual table : my @files = ... ; # list of files to inspect # apply the L function to each file - our $file_stats = [ map {($_, stat $_)} @files]; + our $file_stats = [ map { [ $_, stat $_ ] } @files]; # create a temporary virtual table $dbh->do(<<""); diff --git a/CPAN/arch/5.32/aarch64-linux-thread-multi/auto/DBD/SQLite/SQLite.so b/CPAN/arch/5.32/aarch64-linux-thread-multi/auto/DBD/SQLite/SQLite.so index 570b9db9c72..94d3ac1886e 100755 Binary files a/CPAN/arch/5.32/aarch64-linux-thread-multi/auto/DBD/SQLite/SQLite.so and b/CPAN/arch/5.32/aarch64-linux-thread-multi/auto/DBD/SQLite/SQLite.so differ diff --git a/CPAN/arch/5.32/arm-linux-gnueabihf-thread-multi-64int/auto/DBD/SQLite/SQLite.so b/CPAN/arch/5.32/arm-linux-gnueabihf-thread-multi-64int/auto/DBD/SQLite/SQLite.so index 2d48ac8393a..89657c981f1 100755 Binary files a/CPAN/arch/5.32/arm-linux-gnueabihf-thread-multi-64int/auto/DBD/SQLite/SQLite.so and b/CPAN/arch/5.32/arm-linux-gnueabihf-thread-multi-64int/auto/DBD/SQLite/SQLite.so differ diff --git a/CPAN/arch/5.32/x86_64-linux-thread-multi/auto/DBD/SQLite/SQLite.so b/CPAN/arch/5.32/x86_64-linux-thread-multi/auto/DBD/SQLite/SQLite.so index 99fbfde919b..24f68797b35 100755 Binary files a/CPAN/arch/5.32/x86_64-linux-thread-multi/auto/DBD/SQLite/SQLite.so and b/CPAN/arch/5.32/x86_64-linux-thread-multi/auto/DBD/SQLite/SQLite.so differ diff --git a/CPAN/arch/5.34/DBD/SQLite.pm b/CPAN/arch/5.34/DBD/SQLite.pm index a719c10ea75..1032e1dcc70 100644 --- a/CPAN/arch/5.34/DBD/SQLite.pm +++ b/CPAN/arch/5.34/DBD/SQLite.pm @@ -3,10 +3,9 @@ package DBD::SQLite; use 5.006; use strict; use DBI 1.57 (); -use DynaLoader (); +use XSLoader (); -our $VERSION = '1.58'; -our @ISA = 'DynaLoader'; +our $VERSION = '1.76'; # sqlite_version cache (set in the XS bootstrap) our ($sqlite_version, $sqlite_version_number); @@ -14,7 +13,7 @@ our ($sqlite_version, $sqlite_version_number); # not sure if we still need these... our ($err, $errstr); -__PACKAGE__->bootstrap($VERSION); +XSLoader::load('DBD::SQLite', $VERSION); # New or old API? use constant NEWAPI => ($DBI::VERSION >= 1.608); @@ -47,6 +46,8 @@ sub driver { DBD::SQLite::db->install_method('sqlite_set_authorizer'); DBD::SQLite::db->install_method('sqlite_backup_from_file'); DBD::SQLite::db->install_method('sqlite_backup_to_file'); + DBD::SQLite::db->install_method('sqlite_backup_from_dbh'); + DBD::SQLite::db->install_method('sqlite_backup_to_dbh'); DBD::SQLite::db->install_method('sqlite_enable_load_extension'); DBD::SQLite::db->install_method('sqlite_load_extension'); DBD::SQLite::db->install_method('sqlite_register_fts3_perl_tokenizer'); @@ -57,6 +58,11 @@ sub driver { DBD::SQLite::db->install_method('sqlite_db_status', { O => 0x0004 }); DBD::SQLite::st->install_method('sqlite_st_status', { O => 0x0004 }); DBD::SQLite::db->install_method('sqlite_create_module'); + DBD::SQLite::db->install_method('sqlite_limit'); + DBD::SQLite::db->install_method('sqlite_db_config'); + DBD::SQLite::db->install_method('sqlite_get_autocommit'); + DBD::SQLite::db->install_method('sqlite_txn_state'); + DBD::SQLite::db->install_method('sqlite_error_offset'); $methods_are_installed++; } @@ -180,7 +186,7 @@ sub install_collation { # default implementation for sqlite 'REGEXP' infix operator. # Note : args are reversed, i.e. "a REGEXP b" calls REGEXP(b, a) -# (see http://www.sqlite.org/vtab.html#xfindfunction) +# (see https://www.sqlite.org/vtab.html#xfindfunction) sub regexp { use locale; return if !defined $_[0] || !defined $_[1]; @@ -190,6 +196,8 @@ sub regexp { package # hide from PAUSE DBD::SQLite::db; +use DBI qw/:sql_types/; + sub prepare { my $dbh = shift; my $sql = shift; @@ -245,19 +253,26 @@ sub ping { return $dbh->FETCH('Active') ? 1 : 0; } -sub _get_version { - return ( DBD::SQLite::db::FETCH($_[0], 'sqlite_version') ); +sub quote { + my ($self, $value, $data_type) = @_; + return "NULL" unless defined $value; + if (defined $data_type and ( + $data_type == DBI::SQL_BIT || + $data_type == DBI::SQL_BLOB || + $data_type == DBI::SQL_BINARY || + $data_type == DBI::SQL_VARBINARY || + $data_type == DBI::SQL_LONGVARBINARY)) { + return q(X') . unpack('H*', $value) . q('); + } + $value =~ s/'/''/g; + return "'$value'"; } -my %info = ( - 17 => 'SQLite', # SQL_DBMS_NAME - 18 => \&_get_version, # SQL_DBMS_VER - 29 => '"', # SQL_IDENTIFIER_QUOTE_CHAR -); - sub get_info { - my($dbh, $info_type) = @_; - my $v = $info{int($info_type)}; + my ($dbh, $info_type) = @_; + + require DBD::SQLite::GetInfo; + my $v = $DBD::SQLite::GetInfo::info{int($info_type)}; $v = $v->($dbh) if ref $v eq 'CODE'; return $v; } @@ -553,6 +568,15 @@ my @FOREIGN_KEY_INFO_SQL_CLI = qw( UNIQUE_OR_PRIMARY ); +my $DEFERRABLE_RE = qr/ + (?:(?: + on \s+ (?:delete|update) \s+ (?:set \s+ null|set \s+ default|cascade|restrict|no \s+ action) + | + match \s* (?:\S+|".+?(?selectall_arrayref("SELECT name FROM $master_table WHERE type = ?", undef, "table") or return; + my $tables = $dbh->selectall_arrayref("SELECT name, sql FROM $master_table WHERE type = ?", undef, "table") or return; for my $table (@$tables) { my $tbname = $table->[0]; + my $ddl = $table->[1]; + my (@rels, %relid2rels); next if defined $fk_table && $fk_table ne '%' && $fk_table ne $tbname; my $quoted_tbname = $dbh->quote_identifier($tbname); @@ -603,7 +629,17 @@ sub foreign_key_info { next if defined $pk_schema && $pk_schema ne '%' && $pk_schema ne $table_info{$row->{table}}{schema}; - push @fk_info, { + # cribbed from DBIx::Class::Schema::Loader::DBI::SQLite + my $rel = $rels[ $row->{id} ] ||= { + local_columns => [], + remote_columns => undef, + remote_table => $row->{table}, + }; + push @{ $rel->{local_columns} }, $row->{from}; + push @{ $rel->{remote_columns} }, $row->{to} + if defined $row->{to}; + + my $fk_row = { PKTABLE_CAT => undef, PKTABLE_SCHEM => $table_info{$row->{table}}{schema}, PKTABLE_NAME => $row->{table}, @@ -620,6 +656,44 @@ sub foreign_key_info { DEFERRABILITY => undef, UNIQUE_OR_PRIMARY => $table_info{$row->{table}}{columns}{$row->{to}} ? 'PRIMARY' : 'UNIQUE', }; + push @fk_info, $fk_row; + push @{ $relid2rels{$row->{id}} }, $fk_row; # keep so can fixup + } + + # cribbed from DBIx::Class::Schema::Loader::DBI::SQLite + # but with additional parsing of which kind of deferrable + REL: for my $relid (keys %relid2rels) { + my $rel = $rels[$relid]; + my $deferrable = $DBI_code_for_rule{'NOT DEFERRABLE'}; + my $local_cols = '"?' . (join '"? \s* , \s* "?', map quotemeta, @{ $rel->{local_columns} }) . '"?'; + my $remote_cols = '"?' . (join '"? \s* , \s* "?', map quotemeta, @{ $rel->{remote_columns} || [] }) . '"?'; + my ($deferrable_clause) = $ddl =~ / + foreign \s+ key \s* \( \s* $local_cols \s* \) \s* references \s* (?:\S+|".+?(?{local_columns} } == 1) { + my ($local_col) = @{ $rel->{local_columns} }; + my ($remote_col) = @{ $rel->{remote_columns} || [] }; + $remote_col ||= ''; + ($deferrable_clause) = $ddl =~ / + "?\Q$local_col\E"? \s* (?:\w+\s*)* (?: \( \s* \d\+ (?:\s*,\s*\d+)* \s* \) )? \s* + references \s+ (?:\S+|".+?(?{DEFERRABILITY} = $deferrable for @{ $relid2rels{$relid} }; } } } @@ -694,7 +768,7 @@ sub statistics_info { NON_UNIQUE => $row->{unique} ? 0 : 1, INDEX_QUALIFIER => undef, INDEX_NAME => $row->{name}, - TYPE => 'btree', # see http://www.sqlite.org/version3.html esp. "Traditional B-trees are still used for indices" + TYPE => 'btree', # see https://www.sqlite.org/version3.html esp. "Traditional B-trees are still used for indices" ORDINAL_POSITION => $info->{seqno} + 1, COLUMN_NAME => $info->{name}, ASC_OR_DESC => undef, @@ -721,45 +795,68 @@ sub statistics_info { return $sponge_sth; } +my @TypeInfoKeys = qw/ + TYPE_NAME + DATA_TYPE + COLUMN_SIZE + LITERAL_PREFIX + LITERAL_SUFFIX + CREATE_PARAMS + NULLABLE + CASE_SENSITIVE + SEARCHABLE + UNSIGNED_ATTRIBUTE + FIXED_PREC_SCALE + AUTO_UNIQUE_VALUE + LOCAL_TYPE_NAME + MINIMUM_SCALE + MAXIMUM_SCALE + SQL_DATA_TYPE + SQL_DATETIME_SUB + NUM_PREC_RADIX + INTERVAL_PRECISION +/; + +my %TypeInfo = ( + SQL_INTEGER ,=> { + TYPE_NAME => 'INTEGER', + DATA_TYPE => SQL_INTEGER, + NULLABLE => 2, # no for integer primary key, otherwise yes + SEARCHABLE => 3, + }, + SQL_DOUBLE ,=> { + TYPE_NAME => 'REAL', + DATA_TYPE => SQL_DOUBLE, + NULLABLE => 1, + SEARCHABLE => 3, + }, + SQL_VARCHAR ,=> { + TYPE_NAME => 'TEXT', + DATA_TYPE => SQL_VARCHAR, + LITERAL_PREFIX => "'", + LITERAL_SUFFIX => "'", + NULLABLE => 1, + SEARCHABLE => 3, + }, + SQL_BLOB ,=> { + TYPE_NAME => 'BLOB', + DATA_TYPE => SQL_BLOB, + NULLABLE => 1, + SEARCHABLE => 3, + }, + SQL_UNKNOWN_TYPE ,=> { + DATA_TYPE => SQL_UNKNOWN_TYPE, + }, +); + sub type_info_all { - return; # XXX code just copied from DBD::Oracle, not yet thought about -# return [ -# { -# TYPE_NAME => 0, -# DATA_TYPE => 1, -# COLUMN_SIZE => 2, -# LITERAL_PREFIX => 3, -# LITERAL_SUFFIX => 4, -# CREATE_PARAMS => 5, -# NULLABLE => 6, -# CASE_SENSITIVE => 7, -# SEARCHABLE => 8, -# UNSIGNED_ATTRIBUTE => 9, -# FIXED_PREC_SCALE => 10, -# AUTO_UNIQUE_VALUE => 11, -# LOCAL_TYPE_NAME => 12, -# MINIMUM_SCALE => 13, -# MAXIMUM_SCALE => 14, -# SQL_DATA_TYPE => 15, -# SQL_DATETIME_SUB => 16, -# NUM_PREC_RADIX => 17, -# }, -# [ 'CHAR', 1, 255, '\'', '\'', 'max length', 1, 1, 3, -# undef, '0', '0', undef, undef, undef, 1, undef, undef -# ], -# [ 'NUMBER', 3, 38, undef, undef, 'precision,scale', 1, '0', 3, -# '0', '0', '0', undef, '0', 38, 3, undef, 10 -# ], -# [ 'DOUBLE', 8, 15, undef, undef, undef, 1, '0', 3, -# '0', '0', '0', undef, undef, undef, 8, undef, 10 -# ], -# [ 'DATE', 9, 19, '\'', '\'', undef, 1, '0', 3, -# undef, '0', '0', undef, '0', '0', 11, undef, undef -# ], -# [ 'VARCHAR', 12, 1024*1024, '\'', '\'', 'max length', 1, 1, 3, -# undef, '0', '0', undef, undef, undef, 12, undef, undef -# ] -# ]; + my $idx = 0; + + my @info = ({map {$_ => $idx++} @TypeInfoKeys}); + for my $id (sort {$a <=> $b} keys %TypeInfo) { + push @info, [map {$TypeInfo{$id}{$_}} @TypeInfoKeys]; + } + return \@info; } my @COLUMN_INFO = qw( @@ -936,7 +1033,7 @@ DBD::SQLite - Self-contained RDBMS in a DBI Driver =head1 DESCRIPTION SQLite is a public domain file-based relational database engine that -you can find at L. +you can find at L. B is a Perl DBI driver for SQLite, that includes the entire thing in the distribution. @@ -950,7 +1047,7 @@ SQLite supports the following features: =item Implements a large subset of SQL92 -See L for details. +See L for details. =item A complete DB in a single disk file @@ -977,7 +1074,7 @@ are limited by the typeless nature of the SQLite database. =head1 SQLITE VERSION DBD::SQLite is usually compiled with a bundled SQLite library -(SQLite version S<3.22.0> as of this release) for consistency. +(SQLite version S<3.46.1> as of this release) for consistency. However, a different version of SQLite may sometimes be used for some reasons like security, or some new experimental features. @@ -1021,7 +1118,7 @@ If the filename C<$dbfile> is an empty string, then a private, temporary on-disk database will be created. This private database will be automatically deleted as soon as the database connection is closed. -As of 1.41_01, you can pass URI filename (see L) +As of 1.41_01, you can pass URI filename (see L) as well for finer control: my $dbh = DBI->connect("dbi:SQLite:uri=file:$path_to_dbfile?mode=rwc"); @@ -1038,7 +1135,7 @@ You can set sqlite_open_flags (only) when you connect to a database: sqlite_open_flags => SQLITE_OPEN_READONLY, }); -See L for details. +See L for details. As of 1.49_05, you can also make a database read-only by setting C attribute to true (only) when you connect to a database. @@ -1156,7 +1253,7 @@ like this while executing: SELECT bar FROM foo GROUP BY bar HAVING count(*) > "5"; -There are three workarounds for this. +There are four workarounds for this. =over 4 @@ -1182,6 +1279,15 @@ This is somewhat weird, but works anyway. }); $sth->execute(5); +=item Use SQL cast() function + +This is more explicit way to do the above. + + my $sth = $dbh->prepare(q{ + SELECT bar FROM foo GROUP BY bar HAVING count(*) > cast(? as integer); + }); + $sth->execute(5); + =item Set C database handle attribute As of version 1.32_02, you can use C @@ -1230,7 +1336,7 @@ SQLite supports several placeholder expressions, including C and C<:AAAA>. Consult the L and SQLite documentation for details. -L +L Note that a question mark actually means a next unused (numbered) placeholder. You're advised not to use it with other (numbered or @@ -1300,7 +1406,7 @@ in the worst case. See also L section below. =back -See L for more details. +See L for more details. =head2 Foreign Keys @@ -1328,7 +1434,7 @@ SQLite, be prepared, and please do extensive testing to ensure that your applications will continue to work when the foreign keys support is enabled by default. -See L for details. +See L for details. =head2 Transactions @@ -1382,7 +1488,7 @@ automatically begin if you execute another statement. This C mode is independent from the autocommit mode of the internal SQLite library, which always begins by a C -statement, and ends by a C or a . +statement, and ends by a C or a C. =head2 Transaction and Database Locking @@ -1451,9 +1557,22 @@ of the rest (since 1.30_01, and without creating DBI's statement handles internally since 1.47_01). If you do need to use C or C (which I don't recommend in this case, because typically there's no placeholder nor reusable part in a dump), -you can look at << $sth->{sqlite_unprepared_statements} >> to retrieve +you can look at C<< $sth->{sqlite_unprepared_statements} >> to retrieve what's left, though it usually contains nothing but white spaces. +=head2 TYPE statement attribute + +Because of historical reasons, DBD::SQLite's C statement +handle attribute returns an array ref of string values, contrary to +the DBI specification. This value is also less useful for SQLite +users because SQLite uses dynamic type system (that means, +the datatype of a value is associated with the value itself, not +with its container). + +As of version 1.61_02, if you set C +database handle attribute to true, C statement handle +attribute returns an array of integer, as an experiment. + =head2 Performance SQLite is fast, very fast. Matt processed his 72MB log file with it, @@ -1502,34 +1621,74 @@ Your sweet spot probably lies somewhere in between. =item sqlite_version Returns the version of the SQLite library which B is using, -e.g., "2.8.0". Can only be read. +e.g., "3.26.0". Can only be read. + +=item sqlite_string_mode + +SQLite strings are simple arrays of bytes, but Perl strings can store any +arbitrary Unicode code point. Thus, DBD::SQLite has to adopt some method +of translating between those two models. This parameter defines that +translation. + +Accepted values are the following constants: -=item sqlite_unicode +=over + +=item * DBD_SQLITE_STRING_MODE_BYTES: All strings are assumed to +represent bytes. A Perl string that contains any code point above 255 +will trigger an exception. This is appropriate for Latin-1 strings, +binary data, pre-encoded UTF-8 strings, etc. + +=item * DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK: All Perl strings are encoded +to UTF-8 before being given to SQLite. Perl will B to decode SQLite +strings as UTF-8 when giving them to Perl. Should any such string not be +valid UTF-8, a warning is thrown, and the string is left undecoded. -If set to a true value, B will turn the UTF-8 flag on for all -text strings coming out of the database (this feature is currently disabled -for perl < 5.8.5). For more details on the UTF-8 flag see -L. The default is for the UTF-8 flag to be turned off. +This is appropriate for strings that are decoded to characters via, +e.g., L. -Also note that due to some bizarreness in SQLite's type system (see -L), if you want to retain -blob-style behavior for B columns under C<< $dbh->{sqlite_unicode} = 1 ->> (say, to store images in the database), you have to state so +Also note that, due to some bizarreness in SQLite's type system (see +L), if you want to retain +blob-style behavior for B columns under DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK +(say, to store images in the database), you have to state so explicitly using the 3-argument form of L when doing updates: use DBI qw(:sql_types); - $dbh->{sqlite_unicode} = 1; + use DBD::SQLite::Constants ':dbd_sqlite_string_mode'; + $dbh->{sqlite_string_mode} = DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK; my $sth = $dbh->prepare("INSERT INTO mytable (blobcolumn) VALUES (?)"); - + # Binary_data will be stored as is. $sth->bind_param(1, $binary_data, SQL_BLOB); Defining the column type as C in the DDL is B sufficient. -This attribute was originally named as C, and renamed to -C for integrity since version 1.26_06. Old C -attribute is still accessible but will be deprecated in the near future. +=item * DBD_SQLITE_STRING_MODE_UNICODE_STRICT: Like +DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK but usually throws an exception +rather than a warning if SQLite sends invalid UTF-8. (In Perl callbacks +from SQLite we still warn instead.) + +=item * DBD_SQLITE_STRING_MODE_UNICODE_NAIVE: Like +DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK but uses a "naïve" UTF-8 decoding +method that forgoes validation. This is marginally faster than a validated +decode, but it can also B B B + +=item * DBD_SQLITE_STRING_MODE_PV (default, but B B B): Like +DBD_SQLITE_STRING_MODE_BYTES, but when translating Perl strings to SQLite +the Perl string's internal byte buffer is given to SQLite. B B +B, but it's been the default for many years, and changing that would +break existing applications. + +=back + +=item C or C (deprecated) + +If truthy, equivalent to setting C to +DBD_SQLITE_STRING_MODE_UNICODE_NAIVE; if falsy, equivalent to +DBD_SQLITE_STRING_MODE_PV. + +Prefer C in all new code. =item sqlite_allow_multiple_statements @@ -1556,7 +1715,12 @@ for details. =item sqlite_extended_result_codes If set to true, DBD::SQLite uses extended result codes where appropriate -(see L). +(see L). + +=item sqlite_defensive + +If set to true, language features that allow ordinary SQL to deliberately +corrupt the database file are prohibited. =back @@ -1585,7 +1749,8 @@ Returns all tables and schemas (databases) as specified in L. The schema and table arguments will do a C search. You can specify an ESCAPE character by including an 'Escape' attribute in \%attr. The C<$type> argument accepts a comma separated list of the following types 'TABLE', -'VIEW', 'LOCAL TEMPORARY' and 'SYSTEM TABLE' (by default all are returned). +'INDEX', 'VIEW', 'TRIGGER', 'LOCAL TEMPORARY' and 'SYSTEM TABLE' +(by default all are returned). Note that a statement handle is returned, and not a direct list of tables. The following fields are returned: @@ -1598,8 +1763,8 @@ databases will be in the name given when the database was attached. B: The name of the table or view. -B: The type of object returned. Will be one of 'TABLE', 'VIEW', -'LOCAL TEMPORARY' or 'SYSTEM TABLE'. +B: The type of object returned. Will be one of 'TABLE', 'INDEX', +'VIEW', 'TRIGGER', 'LOCAL TEMPORARY' or 'SYSTEM TABLE'. =head2 primary_key, primary_key_info @@ -1665,10 +1830,12 @@ B: The referential action for the DELETE rule. The codes are the same as for UPDATE_RULE. -Unfortunately, the B field is always C; -as a matter of fact, deferrability clauses are supported by SQLite, -but they can't be reported because the C -tells nothing about them. +B: +The following codes are defined: + + INITIALLY DEFERRED 5 + INITIALLY IMMEDIATE 6 + NOT DEFERRABLE 7 B: Whether the column is primary or unique. @@ -1728,7 +1895,7 @@ returns true if the database file exists (or the database is in-memory), and the The following methods can be called via the func() method with a little tweak, but the use of func() method is now discouraged by the L author for various reasons (see DBI's document -L +L for details). So, if you're using L >= 1.608, use these C methods. If you need to use an older L, you can call these like this: @@ -1755,7 +1922,8 @@ C<$dbh-Esqlite_last_insert_rowid()> directly. =head2 $dbh->sqlite_db_filename() -Retrieve the current (main) database filename. If the database is in-memory or temporary, this returns C. +Retrieve the current (main) database filename. If the database is in-memory +or temporary, this returns an empty string, or C. =head2 $dbh->sqlite_busy_timeout() @@ -1801,6 +1969,13 @@ After this, it could be used from SQL as: INSERT INTO mytable ( now() ); +The function should return a scalar value, and the value is treated as a text +(or a number if appropriate) by default. If you do need to specify a type +of the return value (like BLOB), you can return a reference to an array that +contains the value and the type, as of 1.65_01. + + $dbh->sqlite_create_function( 'md5', 1, sub { return [md5($_[0]), SQL_BLOB] } ); + =head3 REGEXP function SQLite includes syntactic support for an infix operator 'REGEXP', but @@ -2105,18 +2280,39 @@ special :memory: database, and you wish to populate it from an existing DB. This method accesses the SQLite Online Backup API, and will take a backup of the currently connected database, and write it out to the named file. +=head2 $dbh->sqlite_backup_from_dbh( $another_dbh ) + +This method accesses the SQLite Online Backup API, and will take a backup of +the database for the passed handle, copying it to, and overwriting, your current database +connection. This can be particularly handy if your current connection is to the +special :memory: database, and you wish to populate it from an existing DB. +You can use this to backup from an in-memory database to another in-memory database. + +=head2 $dbh->sqlite_backup_to_dbh( $another_dbh ) + +This method accesses the SQLite Online Backup API, and will take a backup of +the currently connected database, and write it out to the passed database handle. + =head2 $dbh->sqlite_enable_load_extension( $bool ) Calling this method with a true value enables loading (external) SQLite3 extensions. After the call, you can load extensions like this: $dbh->sqlite_enable_load_extension(1); - $sth = $dbh->prepare("select load_extension('libsqlitefunctions.so')") + $sth = $dbh->prepare("select load_extension('libmemvfs.so')") or die "Cannot prepare: " . $dbh->errstr(); =head2 $dbh->sqlite_load_extension( $file, $proc ) -Loading an extension by a select statement (with the "load_extension" SQLite3 function like above) has some limitations. If you need to, say, create other functions from an extension, use this method. $file (a path to the extension) is mandatory, and $proc (an entry point name) is optional. You need to call C before calling C. +Loading an extension by a select statement (with the "load_extension" SQLite3 function like above) has some limitations. If the extension you want to use creates other functions that are not native to SQLite, use this method instead. $file (a path to the extension) is mandatory, and $proc (an entry point name) is optional. You need to call C before calling C: + + $dbh->sqlite_enable_load_extension(1); + $dbh->sqlite_load_extension('libsqlitefunctions.so') + or die "Cannot load extension: " . $dbh->errstr(); + +If the extension uses SQLite mutex functions like C, then +the extension should be compiled with the same C compile-time +setting as this module, see C. =head2 $dbh->sqlite_trace( $code_ref ) @@ -2177,17 +2373,38 @@ is for internal use only. =head2 $dbh->sqlite_db_status() -Returns a hash reference that holds a set of status information of database connection such as cache usage. See L for details. You may also pass 0 as an argument to reset the status. +Returns a hash reference that holds a set of status information of database connection such as cache usage. See L for details. You may also pass 0 as an argument to reset the status. =head2 $sth->sqlite_st_status() -Returns a hash reference that holds a set of status information of SQLite statement handle such as full table scan count. See L for details. Statement status only holds the current value. +Returns a hash reference that holds a set of status information of SQLite statement handle such as full table scan count. See L for details. Statement status only holds the current value. my $status = $sth->sqlite_st_status(); my $cur = $status->{fullscan_step}; You may also pass 0 as an argument to reset the status. +=head2 $dbh->sqlite_db_config( $id, $new_integer_value ) + +You can change how the connected database should behave like this: + + use DBD::SQLite::Constants qw/:database_connection_configuration_options/; + + my $dbh = DBI->connect('dbi:SQLite::memory:'); + + # This disables language features that allow ordinary SQL + # to deliberately corrupt the database file + $dbh->sqlite_db_config( SQLITE_DBCONFIG_DEFENSIVE, 1 ); + + # This disables two-arg version of fts3_tokenizer. + $dbh->sqlite_db_config( SQLITE_DBCONFIG_ENABLE_FTS3_TOKENIZER, 0 ); + +C returns the new value after the call. If you just want to know the current value without changing anything, pass a negative integer value. + + my $current_value = $dbh->sqlite_db_config( SQLITE_DBCONFIG_DEFENSIVE, -1 ); + +As of this writing, C only supports options that set an integer value. C and C are not supported. See also C for details. + =head2 $dbh->sqlite_create_module() Registers a name for a I. Module names must be @@ -2195,6 +2412,33 @@ registered before creating a new virtual table using the module and before using a preexisting virtual table for the module. Virtual tables are explained in L. +=head2 $dbh->sqlite_limit( $category_id, $new_value ) + +Sets a new run-time limit for the category, and returns the current limit. +If the new value is a negative number (or omitted), the limit is unchanged +and just returns the current limit. Category ids (SQLITE_LIMIT_LENGTH, +SQLITE_LIMIT_VARIABLE_NUMBER, etc) can be imported from DBD::SQLite::Constants. + +=head2 $dbh->sqlite_get_autocommit() + +Returns true if the internal SQLite connection is in an autocommit mode. +This does not always return the same value as C<< $dbh->{AutoCommit} >>. +This returns false if you explicitly issue a C<> statement. + +=head2 $dbh->sqlite_txn_state() + +Returns the internal transaction status of SQLite (not of DBI). +Return values (SQLITE_TXN_NONE, SQLITE_TXN_READ, SQLITE_TXN_WRITE) +can be imported from DBD::SQLite::Constants. You may pass an optional +schema name (usually "main"). If SQLite does not support this function, +or if you pass a wrong schema name, -1 is returned. + +=head2 $dbh->sqlite_error_offset() + +Returns the byte offset of the start of a problematic input SQL token +or -1 if the most recent error does not reference a specific token in +the input SQL (or DBD::SQLite is built with an older version of SQLite). + =head1 DRIVER FUNCTIONS =head2 DBD::SQLite::compile_options() @@ -2205,7 +2449,7 @@ library is old or compiled with SQLITE_OMIT_COMPILEOPTION_DIAGS. =head2 DBD::SQLite::sqlite_status() -Returns a hash reference that holds a set of status information of SQLite runtime such as memory usage or page cache usage (see L for details). Each of the entry contains the current value and the highwater value. +Returns a hash reference that holds a set of status information of SQLite runtime such as memory usage or page cache usage (see L for details). Each of the entry contains the current value and the highwater value. my $status = DBD::SQLite::sqlite_status(); my $cur = $status->{memory_used}{current}; @@ -2239,7 +2483,7 @@ DELETE operation would be written as follows : The list of constants implemented in C is given below; more information can be found ad -at L. +at L. =head2 Authorizer Return Codes @@ -2299,7 +2543,7 @@ associated strings. SQLite v3 provides the ability for users to supply arbitrary comparison functions, known as user-defined "collation sequences" or "collating functions", to be used for comparing two text values. -L +L explains how collations are used in various SQL expressions. =head2 Builtin collation sequences @@ -2357,18 +2601,17 @@ or =head2 Unicode handling -If the attribute C<< $dbh->{sqlite_unicode} >> is set, strings coming from -the database and passed to the collation function will be properly -tagged with the utf8 flag; but this only works if the -C attribute is set B the first call to -a perl collation sequence . The recommended way to activate unicode -is to set the parameter at connection time : +Depending on the C<< $dbh->{sqlite_string_mode} >> value, strings coming +from the database and passed to the collation function may be decoded as +UTF-8. This only works, though, if the C attribute is +set B the first call to a perl collation sequence. The recommended +way to activate unicode is to set C at connection time: my $dbh = DBI->connect( "dbi:SQLite:dbname=foo", "", "", { - RaiseError => 1, - sqlite_unicode => 1, + RaiseError => 1, + sqlite_string_mode => DBD_SQLITE_STRING_MODE_UNICODE_STRICT, } ); @@ -2390,7 +2633,7 @@ characters : use DBD::SQLite; $DBD::SQLite::COLLATION{no_accents} = sub { my ( $a, $b ) = map lc, @_; - tr[] + tr[àâáäåãçðèêéëìîíïñòôóöõøùûúüý] [aaaaaacdeeeeiiiinoooooouuuuy] for $a, $b; $a cmp $b; }; @@ -2463,7 +2706,7 @@ then query which buildings overlap or are contained within a specified region: $minLong, $maxLong, $minLat, $maxLat); For more detail, please see the SQLite R-Tree page -(L). Note that custom R-Tree +(L). Note that custom R-Tree queries using callbacks, as mentioned in the prior link, have not been implemented yet. @@ -2547,13 +2790,17 @@ Reading/writing into blobs using C / C. =head2 Support for custom callbacks for R-Tree queries Custom queries of a R-Tree index using a callback are possible with -the SQLite C API (L), so one could +the SQLite C API (L), so one could potentially use a callback that narrowed the result set down based on a specific need, such as querying for overlapping circles. =head1 SUPPORT -Bugs should be reported via the CPAN bug tracker at +Bugs should be reported to GitHub issues: + +L + +or via RT if you prefer: L diff --git a/CPAN/arch/5.34/DBD/SQLite/Constants.pm b/CPAN/arch/5.34/DBD/SQLite/Constants.pm index a9f55dcab90..5be8f0aa4bd 100644 --- a/CPAN/arch/5.34/DBD/SQLite/Constants.pm +++ b/CPAN/arch/5.34/DBD/SQLite/Constants.pm @@ -8,6 +8,18 @@ use warnings; use base 'Exporter'; use DBD::SQLite; our @EXPORT_OK = ( + 'DBD_SQLITE_STRING_MODE_PV', + 'DBD_SQLITE_STRING_MODE_BYTES', + 'DBD_SQLITE_STRING_MODE_UNICODE_NAIVE', + 'DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK', + 'DBD_SQLITE_STRING_MODE_UNICODE_STRICT', + # allowed_return_values_from_sqlite3_txn_state + qw/ + SQLITE_TXN_NONE + SQLITE_TXN_READ + SQLITE_TXN_WRITE + /, + # authorizer_action_codes qw/ SQLITE_ALTER_TABLE @@ -57,27 +69,62 @@ our @EXPORT_OK = ( SQLITE_VERSION_NUMBER /, + # database_connection_configuration_options + qw/ + SQLITE_DBCONFIG_DEFENSIVE + SQLITE_DBCONFIG_DQS_DDL + SQLITE_DBCONFIG_DQS_DML + SQLITE_DBCONFIG_ENABLE_FKEY + SQLITE_DBCONFIG_ENABLE_FTS3_TOKENIZER + SQLITE_DBCONFIG_ENABLE_LOAD_EXTENSION + SQLITE_DBCONFIG_ENABLE_QPSG + SQLITE_DBCONFIG_ENABLE_TRIGGER + SQLITE_DBCONFIG_ENABLE_VIEW + SQLITE_DBCONFIG_LEGACY_ALTER_TABLE + SQLITE_DBCONFIG_LEGACY_FILE_FORMAT + SQLITE_DBCONFIG_LOOKASIDE + SQLITE_DBCONFIG_MAINDBNAME + SQLITE_DBCONFIG_MAX + SQLITE_DBCONFIG_NO_CKPT_ON_CLOSE + SQLITE_DBCONFIG_RESET_DATABASE + SQLITE_DBCONFIG_REVERSE_SCANORDER + SQLITE_DBCONFIG_STMT_SCANSTATUS + SQLITE_DBCONFIG_TRIGGER_EQP + SQLITE_DBCONFIG_TRUSTED_SCHEMA + SQLITE_DBCONFIG_WRITABLE_SCHEMA + /, + # extended_result_codes qw/ SQLITE_ABORT_ROLLBACK SQLITE_AUTH_USER SQLITE_BUSY_RECOVERY SQLITE_BUSY_SNAPSHOT + SQLITE_BUSY_TIMEOUT SQLITE_CANTOPEN_CONVPATH + SQLITE_CANTOPEN_DIRTYWAL SQLITE_CANTOPEN_FULLPATH SQLITE_CANTOPEN_ISDIR SQLITE_CANTOPEN_NOTEMPDIR + SQLITE_CANTOPEN_SYMLINK SQLITE_CONSTRAINT_CHECK SQLITE_CONSTRAINT_COMMITHOOK + SQLITE_CONSTRAINT_DATATYPE SQLITE_CONSTRAINT_FOREIGNKEY SQLITE_CONSTRAINT_FUNCTION SQLITE_CONSTRAINT_NOTNULL + SQLITE_CONSTRAINT_PINNED SQLITE_CONSTRAINT_PRIMARYKEY SQLITE_CONSTRAINT_ROWID SQLITE_CONSTRAINT_TRIGGER SQLITE_CONSTRAINT_UNIQUE SQLITE_CONSTRAINT_VTAB + SQLITE_CORRUPT_INDEX + SQLITE_CORRUPT_SEQUENCE SQLITE_CORRUPT_VTAB + SQLITE_ERROR_MISSING_COLLSEQ + SQLITE_ERROR_RETRY + SQLITE_ERROR_SNAPSHOT SQLITE_IOERR_ACCESS SQLITE_IOERR_AUTH SQLITE_IOERR_BEGIN_ATOMIC @@ -86,6 +133,8 @@ our @EXPORT_OK = ( SQLITE_IOERR_CLOSE SQLITE_IOERR_COMMIT_ATOMIC SQLITE_IOERR_CONVPATH + SQLITE_IOERR_CORRUPTFS + SQLITE_IOERR_DATA SQLITE_IOERR_DELETE SQLITE_IOERR_DELETE_NOENT SQLITE_IOERR_DIR_CLOSE @@ -93,6 +142,7 @@ our @EXPORT_OK = ( SQLITE_IOERR_FSTAT SQLITE_IOERR_FSYNC SQLITE_IOERR_GETTEMPPATH + SQLITE_IOERR_IN_PAGE SQLITE_IOERR_LOCK SQLITE_IOERR_MMAP SQLITE_IOERR_NOMEM @@ -110,10 +160,15 @@ our @EXPORT_OK = ( SQLITE_IOERR_VNODE SQLITE_IOERR_WRITE SQLITE_LOCKED_SHAREDCACHE + SQLITE_LOCKED_VTAB + SQLITE_NOTICE_RBU SQLITE_NOTICE_RECOVER_ROLLBACK SQLITE_NOTICE_RECOVER_WAL + SQLITE_OK_SYMLINK + SQLITE_READONLY_CANTINIT SQLITE_READONLY_CANTLOCK SQLITE_READONLY_DBMOVED + SQLITE_READONLY_DIRECTORY SQLITE_READONLY_RECOVERY SQLITE_READONLY_ROLLBACK SQLITE_WARNING_AUTOINDEX @@ -122,19 +177,26 @@ our @EXPORT_OK = ( # flags_for_file_open_operations qw/ SQLITE_OPEN_CREATE + SQLITE_OPEN_EXRESCODE SQLITE_OPEN_FULLMUTEX SQLITE_OPEN_MEMORY + SQLITE_OPEN_NOFOLLOW SQLITE_OPEN_NOMUTEX SQLITE_OPEN_PRIVATECACHE SQLITE_OPEN_READONLY SQLITE_OPEN_READWRITE SQLITE_OPEN_SHAREDCACHE + SQLITE_OPEN_SUPER_JOURNAL SQLITE_OPEN_URI /, # function_flags qw/ SQLITE_DETERMINISTIC + SQLITE_DIRECTONLY + SQLITE_INNOCUOUS + SQLITE_RESULT_SUBTYPE + SQLITE_SUBTYPE /, # fundamental_datatypes @@ -143,6 +205,7 @@ our @EXPORT_OK = ( SQLITE_FLOAT SQLITE_INTEGER SQLITE_NULL + SQLITE_TEXT /, # result_codes @@ -180,6 +243,22 @@ our @EXPORT_OK = ( SQLITE_WARNING /, + # run_time_limit_categories + qw/ + SQLITE_LIMIT_ATTACHED + SQLITE_LIMIT_COLUMN + SQLITE_LIMIT_COMPOUND_SELECT + SQLITE_LIMIT_EXPR_DEPTH + SQLITE_LIMIT_FUNCTION_ARG + SQLITE_LIMIT_LENGTH + SQLITE_LIMIT_LIKE_PATTERN_LENGTH + SQLITE_LIMIT_SQL_LENGTH + SQLITE_LIMIT_TRIGGER_DEPTH + SQLITE_LIMIT_VARIABLE_NUMBER + SQLITE_LIMIT_VDBE_OP + SQLITE_LIMIT_WORKER_THREADS + /, + ); our %EXPORT_TAGS = ( @@ -195,17 +274,22 @@ our %EXPORT_TAGS = ( SQLITE_BUSY SQLITE_BUSY_RECOVERY SQLITE_BUSY_SNAPSHOT + SQLITE_BUSY_TIMEOUT SQLITE_CANTOPEN SQLITE_CANTOPEN_CONVPATH + SQLITE_CANTOPEN_DIRTYWAL SQLITE_CANTOPEN_FULLPATH SQLITE_CANTOPEN_ISDIR SQLITE_CANTOPEN_NOTEMPDIR + SQLITE_CANTOPEN_SYMLINK SQLITE_CONSTRAINT SQLITE_CONSTRAINT_CHECK SQLITE_CONSTRAINT_COMMITHOOK + SQLITE_CONSTRAINT_DATATYPE SQLITE_CONSTRAINT_FOREIGNKEY SQLITE_CONSTRAINT_FUNCTION SQLITE_CONSTRAINT_NOTNULL + SQLITE_CONSTRAINT_PINNED SQLITE_CONSTRAINT_PRIMARYKEY SQLITE_CONSTRAINT_ROWID SQLITE_CONSTRAINT_TRIGGER @@ -213,6 +297,8 @@ our %EXPORT_TAGS = ( SQLITE_CONSTRAINT_VTAB SQLITE_COPY SQLITE_CORRUPT + SQLITE_CORRUPT_INDEX + SQLITE_CORRUPT_SEQUENCE SQLITE_CORRUPT_VTAB SQLITE_CREATE_INDEX SQLITE_CREATE_TABLE @@ -223,10 +309,37 @@ our %EXPORT_TAGS = ( SQLITE_CREATE_TRIGGER SQLITE_CREATE_VIEW SQLITE_CREATE_VTABLE + SQLITE_DBCONFIG_DEFENSIVE + SQLITE_DBCONFIG_DQS_DDL + SQLITE_DBCONFIG_DQS_DML + SQLITE_DBCONFIG_ENABLE_FKEY + SQLITE_DBCONFIG_ENABLE_FTS3_TOKENIZER + SQLITE_DBCONFIG_ENABLE_LOAD_EXTENSION + SQLITE_DBCONFIG_ENABLE_QPSG + SQLITE_DBCONFIG_ENABLE_TRIGGER + SQLITE_DBCONFIG_ENABLE_VIEW + SQLITE_DBCONFIG_LEGACY_ALTER_TABLE + SQLITE_DBCONFIG_LEGACY_FILE_FORMAT + SQLITE_DBCONFIG_LOOKASIDE + SQLITE_DBCONFIG_MAINDBNAME + SQLITE_DBCONFIG_MAX + SQLITE_DBCONFIG_NO_CKPT_ON_CLOSE + SQLITE_DBCONFIG_RESET_DATABASE + SQLITE_DBCONFIG_REVERSE_SCANORDER + SQLITE_DBCONFIG_STMT_SCANSTATUS + SQLITE_DBCONFIG_TRIGGER_EQP + SQLITE_DBCONFIG_TRUSTED_SCHEMA + SQLITE_DBCONFIG_WRITABLE_SCHEMA + DBD_SQLITE_STRING_MODE_BYTES + DBD_SQLITE_STRING_MODE_PV + DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK + DBD_SQLITE_STRING_MODE_UNICODE_NAIVE + DBD_SQLITE_STRING_MODE_UNICODE_STRICT SQLITE_DELETE SQLITE_DENY SQLITE_DETACH SQLITE_DETERMINISTIC + SQLITE_DIRECTONLY SQLITE_DONE SQLITE_DROP_INDEX SQLITE_DROP_TABLE @@ -239,11 +352,15 @@ our %EXPORT_TAGS = ( SQLITE_DROP_VTABLE SQLITE_EMPTY SQLITE_ERROR + SQLITE_ERROR_MISSING_COLLSEQ + SQLITE_ERROR_RETRY + SQLITE_ERROR_SNAPSHOT SQLITE_FLOAT SQLITE_FORMAT SQLITE_FULL SQLITE_FUNCTION SQLITE_IGNORE + SQLITE_INNOCUOUS SQLITE_INSERT SQLITE_INTEGER SQLITE_INTERNAL @@ -257,6 +374,8 @@ our %EXPORT_TAGS = ( SQLITE_IOERR_CLOSE SQLITE_IOERR_COMMIT_ATOMIC SQLITE_IOERR_CONVPATH + SQLITE_IOERR_CORRUPTFS + SQLITE_IOERR_DATA SQLITE_IOERR_DELETE SQLITE_IOERR_DELETE_NOENT SQLITE_IOERR_DIR_CLOSE @@ -264,6 +383,7 @@ our %EXPORT_TAGS = ( SQLITE_IOERR_FSTAT SQLITE_IOERR_FSYNC SQLITE_IOERR_GETTEMPPATH + SQLITE_IOERR_IN_PAGE SQLITE_IOERR_LOCK SQLITE_IOERR_MMAP SQLITE_IOERR_NOMEM @@ -280,8 +400,21 @@ our %EXPORT_TAGS = ( SQLITE_IOERR_UNLOCK SQLITE_IOERR_VNODE SQLITE_IOERR_WRITE + SQLITE_LIMIT_ATTACHED + SQLITE_LIMIT_COLUMN + SQLITE_LIMIT_COMPOUND_SELECT + SQLITE_LIMIT_EXPR_DEPTH + SQLITE_LIMIT_FUNCTION_ARG + SQLITE_LIMIT_LENGTH + SQLITE_LIMIT_LIKE_PATTERN_LENGTH + SQLITE_LIMIT_SQL_LENGTH + SQLITE_LIMIT_TRIGGER_DEPTH + SQLITE_LIMIT_VARIABLE_NUMBER + SQLITE_LIMIT_VDBE_OP + SQLITE_LIMIT_WORKER_THREADS SQLITE_LOCKED SQLITE_LOCKED_SHAREDCACHE + SQLITE_LOCKED_VTAB SQLITE_MISMATCH SQLITE_MISUSE SQLITE_NOLFS @@ -289,18 +422,23 @@ our %EXPORT_TAGS = ( SQLITE_NOTADB SQLITE_NOTFOUND SQLITE_NOTICE + SQLITE_NOTICE_RBU SQLITE_NOTICE_RECOVER_ROLLBACK SQLITE_NOTICE_RECOVER_WAL SQLITE_NULL SQLITE_OK + SQLITE_OK_SYMLINK SQLITE_OPEN_CREATE + SQLITE_OPEN_EXRESCODE SQLITE_OPEN_FULLMUTEX SQLITE_OPEN_MEMORY + SQLITE_OPEN_NOFOLLOW SQLITE_OPEN_NOMUTEX SQLITE_OPEN_PRIVATECACHE SQLITE_OPEN_READONLY SQLITE_OPEN_READWRITE SQLITE_OPEN_SHAREDCACHE + SQLITE_OPEN_SUPER_JOURNAL SQLITE_OPEN_URI SQLITE_PERM SQLITE_PRAGMA @@ -308,24 +446,38 @@ our %EXPORT_TAGS = ( SQLITE_RANGE SQLITE_READ SQLITE_READONLY + SQLITE_READONLY_CANTINIT SQLITE_READONLY_CANTLOCK SQLITE_READONLY_DBMOVED + SQLITE_READONLY_DIRECTORY SQLITE_READONLY_RECOVERY SQLITE_READONLY_ROLLBACK SQLITE_RECURSIVE SQLITE_REINDEX + SQLITE_RESULT_SUBTYPE SQLITE_ROW SQLITE_SAVEPOINT SQLITE_SCHEMA SQLITE_SELECT + SQLITE_SUBTYPE + SQLITE_TEXT SQLITE_TOOBIG SQLITE_TRANSACTION + SQLITE_TXN_NONE + SQLITE_TXN_READ + SQLITE_TXN_WRITE SQLITE_UPDATE SQLITE_VERSION_NUMBER SQLITE_WARNING SQLITE_WARNING_AUTOINDEX /], + allowed_return_values_from_sqlite3_txn_state => [qw/ + SQLITE_TXN_NONE + SQLITE_TXN_READ + SQLITE_TXN_WRITE + /], + authorizer_action_codes => [qw/ SQLITE_ALTER_TABLE SQLITE_ANALYZE @@ -372,26 +524,68 @@ our %EXPORT_TAGS = ( SQLITE_VERSION_NUMBER /], + database_connection_configuration_options => [qw/ + SQLITE_DBCONFIG_DEFENSIVE + SQLITE_DBCONFIG_DQS_DDL + SQLITE_DBCONFIG_DQS_DML + SQLITE_DBCONFIG_ENABLE_FKEY + SQLITE_DBCONFIG_ENABLE_FTS3_TOKENIZER + SQLITE_DBCONFIG_ENABLE_LOAD_EXTENSION + SQLITE_DBCONFIG_ENABLE_QPSG + SQLITE_DBCONFIG_ENABLE_TRIGGER + SQLITE_DBCONFIG_ENABLE_VIEW + SQLITE_DBCONFIG_LEGACY_ALTER_TABLE + SQLITE_DBCONFIG_LEGACY_FILE_FORMAT + SQLITE_DBCONFIG_LOOKASIDE + SQLITE_DBCONFIG_MAINDBNAME + SQLITE_DBCONFIG_MAX + SQLITE_DBCONFIG_NO_CKPT_ON_CLOSE + SQLITE_DBCONFIG_RESET_DATABASE + SQLITE_DBCONFIG_REVERSE_SCANORDER + SQLITE_DBCONFIG_STMT_SCANSTATUS + SQLITE_DBCONFIG_TRIGGER_EQP + SQLITE_DBCONFIG_TRUSTED_SCHEMA + SQLITE_DBCONFIG_WRITABLE_SCHEMA + /], + + dbd_sqlite_string_mode => [qw/ + DBD_SQLITE_STRING_MODE_BYTES + DBD_SQLITE_STRING_MODE_PV + DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK + DBD_SQLITE_STRING_MODE_UNICODE_NAIVE + DBD_SQLITE_STRING_MODE_UNICODE_STRICT + /], + extended_result_codes => [qw/ SQLITE_ABORT_ROLLBACK SQLITE_AUTH_USER SQLITE_BUSY_RECOVERY SQLITE_BUSY_SNAPSHOT + SQLITE_BUSY_TIMEOUT SQLITE_CANTOPEN_CONVPATH + SQLITE_CANTOPEN_DIRTYWAL SQLITE_CANTOPEN_FULLPATH SQLITE_CANTOPEN_ISDIR SQLITE_CANTOPEN_NOTEMPDIR + SQLITE_CANTOPEN_SYMLINK SQLITE_CONSTRAINT_CHECK SQLITE_CONSTRAINT_COMMITHOOK + SQLITE_CONSTRAINT_DATATYPE SQLITE_CONSTRAINT_FOREIGNKEY SQLITE_CONSTRAINT_FUNCTION SQLITE_CONSTRAINT_NOTNULL + SQLITE_CONSTRAINT_PINNED SQLITE_CONSTRAINT_PRIMARYKEY SQLITE_CONSTRAINT_ROWID SQLITE_CONSTRAINT_TRIGGER SQLITE_CONSTRAINT_UNIQUE SQLITE_CONSTRAINT_VTAB + SQLITE_CORRUPT_INDEX + SQLITE_CORRUPT_SEQUENCE SQLITE_CORRUPT_VTAB + SQLITE_ERROR_MISSING_COLLSEQ + SQLITE_ERROR_RETRY + SQLITE_ERROR_SNAPSHOT SQLITE_IOERR_ACCESS SQLITE_IOERR_AUTH SQLITE_IOERR_BEGIN_ATOMIC @@ -400,6 +594,8 @@ our %EXPORT_TAGS = ( SQLITE_IOERR_CLOSE SQLITE_IOERR_COMMIT_ATOMIC SQLITE_IOERR_CONVPATH + SQLITE_IOERR_CORRUPTFS + SQLITE_IOERR_DATA SQLITE_IOERR_DELETE SQLITE_IOERR_DELETE_NOENT SQLITE_IOERR_DIR_CLOSE @@ -407,6 +603,7 @@ our %EXPORT_TAGS = ( SQLITE_IOERR_FSTAT SQLITE_IOERR_FSYNC SQLITE_IOERR_GETTEMPPATH + SQLITE_IOERR_IN_PAGE SQLITE_IOERR_LOCK SQLITE_IOERR_MMAP SQLITE_IOERR_NOMEM @@ -424,10 +621,15 @@ our %EXPORT_TAGS = ( SQLITE_IOERR_VNODE SQLITE_IOERR_WRITE SQLITE_LOCKED_SHAREDCACHE + SQLITE_LOCKED_VTAB + SQLITE_NOTICE_RBU SQLITE_NOTICE_RECOVER_ROLLBACK SQLITE_NOTICE_RECOVER_WAL + SQLITE_OK_SYMLINK + SQLITE_READONLY_CANTINIT SQLITE_READONLY_CANTLOCK SQLITE_READONLY_DBMOVED + SQLITE_READONLY_DIRECTORY SQLITE_READONLY_RECOVERY SQLITE_READONLY_ROLLBACK SQLITE_WARNING_AUTOINDEX @@ -435,18 +637,25 @@ our %EXPORT_TAGS = ( flags_for_file_open_operations => [qw/ SQLITE_OPEN_CREATE + SQLITE_OPEN_EXRESCODE SQLITE_OPEN_FULLMUTEX SQLITE_OPEN_MEMORY + SQLITE_OPEN_NOFOLLOW SQLITE_OPEN_NOMUTEX SQLITE_OPEN_PRIVATECACHE SQLITE_OPEN_READONLY SQLITE_OPEN_READWRITE SQLITE_OPEN_SHAREDCACHE + SQLITE_OPEN_SUPER_JOURNAL SQLITE_OPEN_URI /], function_flags => [qw/ SQLITE_DETERMINISTIC + SQLITE_DIRECTONLY + SQLITE_INNOCUOUS + SQLITE_RESULT_SUBTYPE + SQLITE_SUBTYPE /], fundamental_datatypes => [qw/ @@ -454,6 +663,7 @@ our %EXPORT_TAGS = ( SQLITE_FLOAT SQLITE_INTEGER SQLITE_NULL + SQLITE_TEXT /], result_codes => [qw/ @@ -490,6 +700,21 @@ our %EXPORT_TAGS = ( SQLITE_WARNING /], + run_time_limit_categories => [qw/ + SQLITE_LIMIT_ATTACHED + SQLITE_LIMIT_COLUMN + SQLITE_LIMIT_COMPOUND_SELECT + SQLITE_LIMIT_EXPR_DEPTH + SQLITE_LIMIT_FUNCTION_ARG + SQLITE_LIMIT_LENGTH + SQLITE_LIMIT_LIKE_PATTERN_LENGTH + SQLITE_LIMIT_SQL_LENGTH + SQLITE_LIMIT_TRIGGER_DEPTH + SQLITE_LIMIT_VARIABLE_NUMBER + SQLITE_LIMIT_VDBE_OP + SQLITE_LIMIT_WORKER_THREADS + /], + ); $EXPORT_TAGS{version} = $EXPORT_TAGS{compile_time_library_version_numbers}; $EXPORT_TAGS{file_open} = $EXPORT_TAGS{flags_for_file_open_operations}; @@ -511,12 +736,24 @@ DBD::SQLite::Constants - common SQLite constants =head1 DESCRIPTION -You can import necessary SQLite constants from this module. Available tags are C, C, C, C (C), C, C (C), C, C (C), C. See L for the complete list of constants. +You can import necessary SQLite constants from this module. Available tags are C, C, C, C, C (C), C, C, C, C (C), C, C (C), C, C. See L for the complete list of constants. This module does not export anything by default. =head1 CONSTANTS +=head2 allowed_return_values_from_sqlite3_txn_state + +=over 4 + +=item SQLITE_TXN_NONE + +=item SQLITE_TXN_READ + +=item SQLITE_TXN_WRITE + +=back + =head2 authorizer_action_codes =over 4 @@ -609,6 +846,70 @@ This module does not export anything by default. =back +=head2 database_connection_configuration_options + +=over 4 + +=item SQLITE_DBCONFIG_LOOKASIDE + +=item SQLITE_DBCONFIG_ENABLE_FKEY + +=item SQLITE_DBCONFIG_ENABLE_TRIGGER + +=item SQLITE_DBCONFIG_ENABLE_FTS3_TOKENIZER + +=item SQLITE_DBCONFIG_ENABLE_LOAD_EXTENSION + +=item SQLITE_DBCONFIG_MAINDBNAME + +=item SQLITE_DBCONFIG_NO_CKPT_ON_CLOSE + +=item SQLITE_DBCONFIG_ENABLE_QPSG + +=item SQLITE_DBCONFIG_TRIGGER_EQP + +=item SQLITE_DBCONFIG_MAX + +=item SQLITE_DBCONFIG_RESET_DATABASE + +=item SQLITE_DBCONFIG_DEFENSIVE + +=item SQLITE_DBCONFIG_WRITABLE_SCHEMA + +=item SQLITE_DBCONFIG_LEGACY_ALTER_TABLE + +=item SQLITE_DBCONFIG_DQS_DML + +=item SQLITE_DBCONFIG_DQS_DDL + +=item SQLITE_DBCONFIG_ENABLE_VIEW + +=item SQLITE_DBCONFIG_LEGACY_FILE_FORMAT + +=item SQLITE_DBCONFIG_TRUSTED_SCHEMA + +=item SQLITE_DBCONFIG_STMT_SCANSTATUS + +=item SQLITE_DBCONFIG_REVERSE_SCANORDER + +=back + +=head2 dbd_sqlite_string_mode + +=over 4 + +=item DBD_SQLITE_STRING_MODE_PV + +=item DBD_SQLITE_STRING_MODE_BYTES + +=item DBD_SQLITE_STRING_MODE_UNICODE_NAIVE + +=item DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK + +=item DBD_SQLITE_STRING_MODE_UNICODE_STRICT + +=back + =head2 extended_result_codes =over 4 @@ -729,6 +1030,42 @@ This module does not export anything by default. =item SQLITE_IOERR_ROLLBACK_ATOMIC +=item SQLITE_ERROR_MISSING_COLLSEQ + +=item SQLITE_ERROR_RETRY + +=item SQLITE_READONLY_CANTINIT + +=item SQLITE_READONLY_DIRECTORY + +=item SQLITE_LOCKED_VTAB + +=item SQLITE_CORRUPT_SEQUENCE + +=item SQLITE_ERROR_SNAPSHOT + +=item SQLITE_CANTOPEN_DIRTYWAL + +=item SQLITE_CANTOPEN_SYMLINK + +=item SQLITE_CONSTRAINT_PINNED + +=item SQLITE_OK_SYMLINK + +=item SQLITE_IOERR_DATA + +=item SQLITE_BUSY_TIMEOUT + +=item SQLITE_CORRUPT_INDEX + +=item SQLITE_IOERR_CORRUPTFS + +=item SQLITE_CONSTRAINT_DATATYPE + +=item SQLITE_NOTICE_RBU + +=item SQLITE_IOERR_IN_PAGE + =back =head2 file_open (flags_for_file_open_operations) @@ -753,6 +1090,12 @@ This module does not export anything by default. =item SQLITE_OPEN_MEMORY +=item SQLITE_OPEN_NOFOLLOW + +=item SQLITE_OPEN_SUPER_JOURNAL + +=item SQLITE_OPEN_EXRESCODE + =back =head2 function_flags @@ -761,6 +1104,14 @@ This module does not export anything by default. =item SQLITE_DETERMINISTIC +=item SQLITE_DIRECTONLY + +=item SQLITE_SUBTYPE + +=item SQLITE_INNOCUOUS + +=item SQLITE_RESULT_SUBTYPE + =back =head2 datatypes (fundamental_datatypes) @@ -775,6 +1126,8 @@ This module does not export anything by default. =item SQLITE_NULL +=item SQLITE_TEXT + =back =head2 result_codes @@ -845,3 +1198,33 @@ This module does not export anything by default. =back +=head2 run_time_limit_categories + +=over 4 + +=item SQLITE_LIMIT_LENGTH + +=item SQLITE_LIMIT_SQL_LENGTH + +=item SQLITE_LIMIT_COLUMN + +=item SQLITE_LIMIT_EXPR_DEPTH + +=item SQLITE_LIMIT_COMPOUND_SELECT + +=item SQLITE_LIMIT_VDBE_OP + +=item SQLITE_LIMIT_FUNCTION_ARG + +=item SQLITE_LIMIT_ATTACHED + +=item SQLITE_LIMIT_LIKE_PATTERN_LENGTH + +=item SQLITE_LIMIT_VARIABLE_NUMBER + +=item SQLITE_LIMIT_TRIGGER_DEPTH + +=item SQLITE_LIMIT_WORKER_THREADS + +=back + diff --git a/CPAN/arch/5.34/DBD/SQLite/GetInfo.pm b/CPAN/arch/5.34/DBD/SQLite/GetInfo.pm new file mode 100644 index 00000000000..083bfa4c02c --- /dev/null +++ b/CPAN/arch/5.34/DBD/SQLite/GetInfo.pm @@ -0,0 +1,288 @@ +package DBD::SQLite::GetInfo; + +use 5.006; +use strict; +use warnings; + +use DBD::SQLite; + +# SQL_DRIVER_VER should be formatted as dd.dd.dddd +my $dbdversion = $DBD::SQLite::VERSION; +$dbdversion .= '_00' if $dbdversion =~ /^\d+\.\d+$/; +my $sql_driver_ver = sprintf("%02d.%02d.%04d", split(/[\._]/, $dbdversion)); + +# Full list of keys and their return types: DBI::Const::GetInfo::ODBC + +# Most of the key definitions can be gleaned from: +# +# https://docs.microsoft.com/en-us/sql/odbc/reference/syntax/sqlgetinfo-function + +our %info = ( + 20 => 'N', # SQL_ACCESSIBLE_PROCEDURES - No stored procedures to access + 19 => 'Y', # SQL_ACCESSIBLE_TABLES - SELECT access to all tables in table_info + 0 => 0, # SQL_ACTIVE_CONNECTIONS - No maximum connection limit + 116 => 0, # SQL_ACTIVE_ENVIRONMENTS - No "active environment" limit + 1 => 0, # SQL_ACTIVE_STATEMENTS - No concurrent activity limit + 169 => 127, # SQL_AGGREGATE_FUNCTIONS - Supports all SQL-92 aggregrate functions + 117 => 0, # SQL_ALTER_DOMAIN - No ALTER DOMAIN support + 86 => 1, # SQL_ALTER_TABLE - Only supports ADD COLUMN and table rename (not listed in enum) in ALTER TABLE statements + 10021 => 0, # SQL_ASYNC_MODE - No asynchronous support (in vanilla SQLite) + 120 => 0, # SQL_BATCH_ROW_COUNT - No special row counting access + 121 => 0, # SQL_BATCH_SUPPORT - No batches + 82 => 0, # SQL_BOOKMARK_PERSISTENCE - No bookmark support + 114 => 1, # SQL_CATALOG_LOCATION - Database comes first in identifiers + 10003 => 'Y', # SQL_CATALOG_NAME - Supports database names + 41 => '.', # SQL_CATALOG_NAME_SEPARATOR - Separated by dot + 42 => 'database', # SQL_CATALOG_TERM - SQLite calls catalogs databases + 92 => 1+4+8, # SQL_CATALOG_USAGE - Supported in calls to DML & table/index definiton (no procedures or permissions) + 10004 => 'UTF-8', # SQL_COLLATION_SEQ - SQLite 3 uses UTF-8 by default + 87 => 'Y', # SQL_COLUMN_ALIAS - Supports column aliases + 22 => 0, # SQL_CONCAT_NULL_BEHAVIOR - 'a'||NULL = NULL + +# SQLite has no CONVERT function, only CAST. However, it converts to every "affinity" it supports. +# +# The only SQL_CVT_* types it doesn't support are date/time types, as it has no concept of +# date/time values once inserted. These are only convertable to text-like types. GUIDs are in +# the same boat, having no real means of switching to a numeric format. +# +# text/binary types = 31723265 +# numeric types = 28926 +# date/time types = 1802240 +# total = 33554431 + + 48 => 1, # SQL_CONVERT_FUNCTIONS - CAST only + + 53 => 31723265+28926, # SQL_CONVERT_BIGINT + 54 => 31723265+28926, # SQL_CONVERT_BINARY + 55 => 31723265+28926, # SQL_CONVERT_BIT + 56 => 33554431, # SQL_CONVERT_CHAR + 57 => 31723265+1802240, # SQL_CONVERT_DATE + 58 => 31723265+28926, # SQL_CONVERT_DECIMAL + 59 => 31723265+28926, # SQL_CONVERT_DOUBLE + 60 => 31723265+28926, # SQL_CONVERT_FLOAT + 173 => 31723265, # SQL_CONVERT_GUID + 61 => 31723265+28926, # SQL_CONVERT_INTEGER + 123 => 31723265+1802240, # SQL_CONVERT_INTERVAL_DAY_TIME + 124 => 31723265+1802240, # SQL_CONVERT_INTERVAL_YEAR_MONTH + 71 => 31723265+28926, # SQL_CONVERT_LONGVARBINARY + 62 => 31723265+28926, # SQL_CONVERT_LONGVARCHAR + 63 => 31723265+28926, # SQL_CONVERT_NUMERIC + 64 => 31723265+28926, # SQL_CONVERT_REAL + 65 => 31723265+28926, # SQL_CONVERT_SMALLINT + 66 => 31723265+1802240, # SQL_CONVERT_TIME + 67 => 31723265+1802240, # SQL_CONVERT_TIMESTAMP + 68 => 31723265+28926, # SQL_CONVERT_TINYINT + 69 => 33554431, # SQL_CONVERT_VARBINARY + 70 => 33554431, # SQL_CONVERT_VARCHAR + 122 => 33554431, # SQL_CONVERT_WCHAR + 125 => 33554431, # SQL_CONVERT_WLONGVARCHAR + 126 => 33554431, # SQL_CONVERT_WVARCHAR + + 74 => 1, # SQL_CORRELATION_NAME - Table aliases are supported, but must be named differently + 127 => 0, # SQL_CREATE_ASSERTION - No CREATE ASSERTION support + 128 => 0, # SQL_CREATE_CHARACTER_SET - No CREATE CHARACTER SET support + 129 => 0, # SQL_CREATE_COLLATION - No CREATE COLLATION support + 130 => 0, # SQL_CREATE_DOMAIN - No CREATE DOMAIN support + 131 => 0, # SQL_CREATE_SCHEMA - No CREATE SCHEMA support + 132 => 16383-2-8-4096, # SQL_CREATE_TABLE - Most of the functionality of CREATE TABLE support + 133 => 0, # SQL_CREATE_TRANSLATION - No CREATE TRANSLATION support + 134 => 1, # SQL_CREATE_VIEW - CREATE VIEW, no WITH CHECK OPTION support + + 23 => 2, # SQL_CURSOR_COMMIT_BEHAVIOR - Cursors are preserved + 24 => 2, # SQL_CURSOR_ROLLBACK_BEHAVIOR - Cursors are preserved + 10001 => 0, # SQL_CURSOR_SENSITIVITY - Cursors have a concept of snapshots, though this depends on the transaction type + + 2 => \&sql_data_source_name, # SQL_DATA_SOURCE_NAME - The DSN + 25 => \&sql_data_source_read_only, # SQL_DATA_SOURCE_READ_ONLY - Might have a SQLITE_OPEN_READONLY flag + 16 => \&sql_database_name, # SQL_DATABASE_NAME - Self-explanatory + 119 => 0, # SQL_DATETIME_LITERALS - No support for SQL-92's super weird date/time literal format (ie: {d '2999-12-12'}) + 17 => 'SQLite', # SQL_DBMS_NAME - You are here + 18 => \&sql_dbms_ver, # SQL_DBMS_VER - This driver version + 170 => 1+2, # SQL_DDL_INDEX - Supports CREATE/DROP INDEX + 26 => 8, # SQL_DEFAULT_TXN_ISOLATION - Default is SERIALIZABLE (See "PRAGMA read_uncommitted") + 10002 => 'N', # SQL_DESCRIBE_PARAMETER - No DESCRIBE INPUT support + +# XXX: MySQL/Oracle fills in HDBC and HENV, but information on what should actually go there is +# hard to acquire. + +# 171 => undef, # SQL_DM_VER - Not a Driver Manager +# 3 => undef, # SQL_DRIVER_HDBC - Not a Driver Manager +# 135 => undef, # SQL_DRIVER_HDESC - Not a Driver Manager +# 4 => undef, # SQL_DRIVER_HENV - Not a Driver Manager +# 76 => undef, # SQL_DRIVER_HLIB - Not a Driver Manager +# 5 => undef, # SQL_DRIVER_HSTMT - Not a Driver Manager + 6 => 'libsqlite3odbc.so', # SQL_DRIVER_NAME - SQLite3 ODBC driver (if installed) + 77 => '03.00', # SQL_DRIVER_ODBC_VER - Same as sqlite3odbc.c + 7 => $sql_driver_ver, # SQL_DRIVER_VER - Self-explanatory + + 136 => 0, # SQL_DROP_ASSERTION - No DROP ASSERTION support + 137 => 0, # SQL_DROP_CHARACTER_SET - No DROP CHARACTER SET support + 138 => 0, # SQL_DROP_COLLATION - No DROP COLLATION support + 139 => 0, # SQL_DROP_DOMAIN - No DROP DOMAIN support + 140 => 0, # SQL_DROP_SCHEMA - No DROP SCHEMA support + 141 => 1, # SQL_DROP_TABLE - DROP TABLE support, no RESTRICT/CASCADE + 142 => 0, # SQL_DROP_TRANSLATION - No DROP TRANSLATION support + 143 => 1, # SQL_DROP_VIEW - DROP VIEW support, no RESTRICT/CASCADE + +# NOTE: This is based purely on what sqlite3odbc supports. +# +# Static CA1: NEXT, ABSOLUTE, RELATIVE, BOOKMARK, LOCK_NO_CHANGE, POSITION, UPDATE, DELETE, REFRESH, +# BULK_ADD, BULK_UPDATE_BY_BOOKMARK, BULK_DELETE_BY_BOOKMARK = 466511 +# +# Forward-only CA1: NEXT, BOOKMARK +# +# CA2: READ_ONLY_CONCURRENCY, LOCK_CONCURRENCY + + 144 => 0, # SQL_DYNAMIC_CURSOR_ATTRIBUTES1 - No dynamic cursor support + 145 => 0, # SQL_DYNAMIC_CURSOR_ATTRIBUTES2 - No dynamic cursor support + 146 => 1+8, # SQL_FORWARD_ONLY_CURSOR_ATTRIBUTES1 + 147 => 1+2, # SQL_FORWARD_ONLY_CURSOR_ATTRIBUTES2 + 150 => 0, # SQL_KEYSET_CURSOR_ATTRIBUTES1 - No keyset cursor support + 151 => 0, # SQL_KEYSET_CURSOR_ATTRIBUTES2 - No keyset cursor support + 167 => 466511, # SQL_STATIC_CURSOR_ATTRIBUTES1 + 168 => 1+2, # SQL_STATIC_CURSOR_ATTRIBUTES2 + + 27 => 'Y', # SQL_EXPRESSIONS_IN_ORDERBY - ORDER BY allows expressions + 8 => 63, # SQL_FETCH_DIRECTION - Cursors support next, first, last, prior, absolute, relative + 84 => 2, # SQL_FILE_USAGE - Single-tier driver, treats files as databases + 81 => 1+2+8, # SQL_GETDATA_EXTENSIONS - Same as sqlite3odbc.c + 88 => 3, # SQL_GROUP_BY - SELECT columns are independent of GROUP BY columns + 28 => 4, # SQL_IDENTIFIER_CASE - Not case-sensitive, stored in mixed case + 29 => '"', # SQL_IDENTIFIER_QUOTE_CHAR - Uses " for identifiers, though supports [] and ` as well + 148 => 0, # SQL_INDEX_KEYWORDS - No support for ASC/DESC/ALL for CREATE INDEX + 149 => 0, # SQL_INFO_SCHEMA_VIEWS - No support for INFORMATION_SCHEMA + 172 => 1+2, # SQL_INSERT_STATEMENT - INSERT...VALUES & INSERT...SELECT + 73 => 'N', # SQL_INTEGRITY - No support for "Integrity Enhancement Facility" + 89 => \&sql_keywords, # SQL_KEYWORDS - List of non-ODBC keywords + 113 => 'Y', # SQL_LIKE_ESCAPE_CLAUSE - Supports LIKE...ESCAPE + 78 => 1, # SQL_LOCK_TYPES - Only NO_CHANGE + + 10022 => 0, # SQL_MAX_ASYNC_CONCURRENT_STATEMENTS - No async mode + 112 => 1_000_000, # SQL_MAX_BINARY_LITERAL_LEN - SQLITE_MAX_SQL_LENGTH + 34 => 1_000_000, # SQL_MAX_CATALOG_NAME_LEN - SQLITE_MAX_SQL_LENGTH + 108 => 1_000_000, # SQL_MAX_CHAR_LITERAL_LEN - SQLITE_MAX_SQL_LENGTH + 97 => 2000, # SQL_MAX_COLUMNS_IN_GROUP_BY - SQLITE_MAX_COLUMN + 98 => 2000, # SQL_MAX_COLUMNS_IN_INDEX - SQLITE_MAX_COLUMN + 99 => 2000, # SQL_MAX_COLUMNS_IN_ORDER_BY - SQLITE_MAX_COLUMN + 100 => 2000, # SQL_MAX_COLUMNS_IN_SELECT - SQLITE_MAX_COLUMN + 101 => 2000, # SQL_MAX_COLUMNS_IN_TABLE - SQLITE_MAX_COLUMN + 30 => 1_000_000, # SQL_MAX_COLUMN_NAME_LEN - SQLITE_MAX_SQL_LENGTH + 1 => 1021, # SQL_MAX_CONCURRENT_ACTIVITIES - Typical filehandle limits + 31 => 1_000_000, # SQL_MAX_CURSOR_NAME_LEN - SQLITE_MAX_SQL_LENGTH + 0 => 1021, # SQL_MAX_DRIVER_CONNECTIONS - Typical filehandle limits + 10005 => 1_000_000, # SQL_MAX_IDENTIFIER_LEN - SQLITE_MAX_SQL_LENGTH + 102 => 2147483646*65536, # SQL_MAX_INDEX_SIZE - Tied to DB size, which is theortically 140TB + 32 => 1_000_000, # SQL_MAX_OWNER_NAME_LEN - SQLITE_MAX_SQL_LENGTH + 33 => 1_000_000, # SQL_MAX_PROCEDURE_NAME_LEN - SQLITE_MAX_SQL_LENGTH + 34 => 1_000_000, # SQL_MAX_QUALIFIER_NAME_LEN - SQLITE_MAX_SQL_LENGTH + 104 => 1_000_000, # SQL_MAX_ROW_SIZE - SQLITE_MAX_SQL_LENGTH (since INSERT has to be used) + 103 => 'Y', # SQL_MAX_ROW_SIZE_INCLUDES_LONG + 32 => 1_000_000, # SQL_MAX_SCHEMA_NAME_LEN - SQLITE_MAX_SQL_LENGTH + 105 => 1_000_000, # SQL_MAX_STATEMENT_LEN - SQLITE_MAX_SQL_LENGTH + 106 => 64, # SQL_MAX_TABLES_IN_SELECT - 64 tables, because of the bitmap in the query optimizer + 35 => 1_000_000, # SQL_MAX_TABLE_NAME_LEN - SQLITE_MAX_SQL_LENGTH + 107 => 0, # SQL_MAX_USER_NAME_LEN - No user support + + 37 => 'Y', # SQL_MULTIPLE_ACTIVE_TXN - Supports mulitple txns, though not nested + 36 => 'N', # SQL_MULT_RESULT_SETS - No batches + 111 => 'N', # SQL_NEED_LONG_DATA_LEN - Doesn't care about LONG + 75 => 1, # SQL_NON_NULLABLE_COLUMNS - Supports NOT NULL + 85 => 1, # SQL_NULL_COLLATION - NULLs first on ASC (low end) + 49 => 4194304+1, # SQL_NUMERIC_FUNCTIONS - Just ABS & ROUND (has RANDOM, but not RAND) + + 9 => 1, # SQL_ODBC_API_CONFORMANCE - Same as sqlite3odbc.c + 152 => 1, # SQL_ODBC_INTERFACE_CONFORMANCE - Same as sqlite3odbc.c + 12 => 0, # SQL_ODBC_SAG_CLI_CONFORMANCE - Same as sqlite3odbc.c + 15 => 0, # SQL_ODBC_SQL_CONFORMANCE - Same as sqlite3odbc.c + 10 => '03.00', # SQL_ODBC_VER - Same as sqlite3odbc.c + + 115 => 1+8+16+32+64, # SQL_OJ_CAPABILITIES - Supports all OUTER JOINs except RIGHT & FULL + 90 => 'N', # SQL_ORDER_BY_COLUMNS_IN_SELECT - ORDER BY columns don't have to be in the SELECT list + 38 => 'Y', # SQL_OUTER_JOINS - Supports OUTER JOINs + 153 => 2, # SQL_PARAM_ARRAY_ROW_COUNTS - Only has row counts for executed statements + 154 => 3, # SQL_PARAM_ARRAY_SELECTS - No support for arrays of parameters + 80 => 0, # SQL_POSITIONED_STATEMENTS - No support for positioned statements (WHERE CURRENT OF or SELECT FOR UPDATE) + 79 => 31, # SQL_POS_OPERATIONS - Supports all SQLSetPos operations + 21 => 'N', # SQL_PROCEDURES - No procedures + 40 => '', # SQL_PROCEDURE_TERM - No procedures + 93 => 4, # SQL_QUOTED_IDENTIFIER_CASE - Even quoted identifiers are case-insensitive + 11 => 'N', # SQL_ROW_UPDATES - No fancy cursor update support + 39 => '', # SQL_SCHEMA_TERM - No schemas + 91 => 0, # SQL_SCHEMA_USAGE - No schemas + 43 => 2, # SQL_SCROLL_CONCURRENCY - Updates/deletes on cursors lock the database + 44 => 1+16, # SQL_SCROLL_OPTIONS - Only supports static & forward-only cursors + 14 => '\\', # SQL_SEARCH_PATTERN_ESCAPE - Default escape character for LIKE is \ + 13 => \&sql_server_name, # SQL_SERVER_NAME - Just $dbh->{Name} + 94 => '', # SQL_SPECIAL_CHARACTERS - Other drivers tend to stick to the ASCII/Latin-1 range, and SQLite uses all of + # the lower 7-bit punctuation for other things + + 155 => 7, # SQL_SQL92_DATETIME_FUNCTIONS - Supports CURRENT_(DATE|TIME|TIMESTAMP) + 156 => 1+2+4+8, # SQL_SQL92_FOREIGN_KEY_DELETE_RULE - Support all ON DELETE options + 157 => 1+2+4+8, # SQL_SQL92_FOREIGN_KEY_UPDATE_RULE - Support all ON UPDATE options + 158 => 0, # SQL_SQL92_GRANT - No users; no support for GRANT + 159 => 0, # SQL_SQL92_NUMERIC_VALUE_FUNCTIONS - No support for any of the listed functions + 160 => 1+2+4+512+1024+2048+4096+8192, # SQL_SQL92_PREDICATES - Supports the important comparison operators + 161 => 2+16+64+128, # SQL_SQL92_RELATIONAL_JOIN_OPERATORS - Supports the important ones except RIGHT/FULL OUTER JOINs + 162 => 0, # SQL_SQL92_REVOKE - No users; no support for REVOKE + 163 => 1+2+8, # SQL_SQL92_ROW_VALUE_CONSTRUCTOR - Supports most row value constructors + 164 => 2+4, # SQL_SQL92_STRING_FUNCTIONS - Just UPPER & LOWER (has SUBSTR, but not SUBSTRING and SQL-92's weird TRIM syntax) + 165 => 1+2+4+8, # SQL_SQL92_VALUE_EXPRESSIONS - Supports all SQL-92 value expressions + + 118 => 1, # SQL_SQL_CONFORMANCE - SQL-92 Entry level + 83 => 0, # SQL_STATIC_SENSITIVITY - Cursors would lock the DB, so only old data is visible + 50 => 8+16+256+1024+16384+131072, # SQL_STRING_FUNCTIONS - LTRIM, LENGTH, REPLACE, RTRIM, CHAR, SOUNDEX + 95 => 1+2+4+8+16, # SQL_SUBQUERIES - Supports all of the subquery types + 51 => 4, # SQL_SYSTEM_FUNCTIONS - Only IFNULL + 45 => 'table', # SQL_TABLE_TERM - Tables are called tables + 109 => 0, # SQL_TIMEDATE_ADD_INTERVALS - No support for INTERVAL + 110 => 0, # SQL_TIMEDATE_DIFF_INTERVALS - No support for INTERVAL + 52 => 0x20000+0x40000+0x80000, # SQL_TIMEDATE_FUNCTIONS - Only supports CURRENT_(DATE|TIME|TIMESTAMP) + 46 => 2, # SQL_TXN_CAPABLE - Full transaction support for both DML & DDL + 72 => 1+8, # SQL_TXN_ISOLATION_OPTION - Supports read uncommitted and serializable + 96 => 1+2, # SQL_UNION - Supports UNION and UNION ALL + 47 => '', # SQL_USER_NAME - No users + + 166 => 1, # SQL_STANDARD_CLI_CONFORMANCE - X/Open CLI Version 1.0 + 10000 => 1992, # SQL_XOPEN_CLI_YEAR - Year for V1.0 +); + +sub sql_dbms_ver { + my $dbh = shift; + return $dbh->FETCH('sqlite_version'); +} + +sub sql_data_source_name { + my $dbh = shift; + return "dbi:SQLite:".$dbh->{Name}; +} + +sub sql_data_source_read_only { + my $dbh = shift; + my $flags = $dbh->FETCH('sqlite_open_flags') || 0; + return $dbh->{ReadOnly} || ($flags & DBD::SQLite::OPEN_READONLY()) ? 'Y' : 'N'; +} + +sub sql_database_name { + my $dbh = shift; + my $databases = $dbh->selectall_hashref('PRAGMA database_list', 'seq'); + return $databases->{0}{name}; +} + +sub sql_keywords { + # SQLite keywords minus ODBC keywords + return join ',', (qw< + ABORT AFTER ANALYZE ATTACH AUTOINCREMENT BEFORE CONFLICT DATABASE DETACH EACH EXCLUSIVE + EXPLAIN FAIL GLOB IF IGNORE INDEXED INSTEAD ISNULL LIMIT NOTNULL OFFSET + PLAN PRAGMA QUERY RAISE RECURSIVE REGEXP REINDEX RELEASE RENAME REPLACE ROW + SAVEPOINT TEMP TRIGGER VACUUM VIRTUAL WITHOUT + >); +} + +sub sql_server_name { + my $dbh = shift; + return $dbh->{Name}; +} + +1; + +__END__ diff --git a/CPAN/arch/5.34/DBD/SQLite/VirtualTable.pm b/CPAN/arch/5.34/DBD/SQLite/VirtualTable.pm index f8e054a7077..efcc19b72d9 100644 --- a/CPAN/arch/5.34/DBD/SQLite/VirtualTable.pm +++ b/CPAN/arch/5.34/DBD/SQLite/VirtualTable.pm @@ -5,7 +5,7 @@ use strict; use warnings; use Scalar::Util qw/weaken/; -our $VERSION = '1.58'; +our $VERSION = '1.76'; our @ISA; diff --git a/CPAN/arch/5.34/DBD/SQLite/VirtualTable/PerlData.pm b/CPAN/arch/5.34/DBD/SQLite/VirtualTable/PerlData.pm index 5af9977757c..0e58d7d0dae 100644 --- a/CPAN/arch/5.34/DBD/SQLite/VirtualTable/PerlData.pm +++ b/CPAN/arch/5.34/DBD/SQLite/VirtualTable/PerlData.pm @@ -88,7 +88,7 @@ sub BEST_INDEX { # in FILTER() for deciding which rows match the constraints. my @conditions; my $ix = 0; - foreach my $constraint (grep {$_->{usable}} @$constraints) { + foreach my $constraint (grep {$_->{usable} and exists $SQLOP2PERLOP{ $_->{op} } } @$constraints) { my $col = $constraint->{col}; my ($member, $optype); @@ -389,7 +389,7 @@ time. Here is a way to do it with a virtual table : my @files = ... ; # list of files to inspect # apply the L function to each file - our $file_stats = [ map {($_, stat $_)} @files]; + our $file_stats = [ map { [ $_, stat $_ ] } @files]; # create a temporary virtual table $dbh->do(<<""); diff --git a/CPAN/arch/5.34/aarch64-linux-thread-multi/auto/DBD/SQLite/SQLite.so b/CPAN/arch/5.34/aarch64-linux-thread-multi/auto/DBD/SQLite/SQLite.so index 84274d847e0..2028b9ff1f6 100755 Binary files a/CPAN/arch/5.34/aarch64-linux-thread-multi/auto/DBD/SQLite/SQLite.so and b/CPAN/arch/5.34/aarch64-linux-thread-multi/auto/DBD/SQLite/SQLite.so differ diff --git a/CPAN/arch/5.34/darwin-thread-multi-2level/auto/DBD/SQLite/SQLite.bundle b/CPAN/arch/5.34/darwin-thread-multi-2level/auto/DBD/SQLite/SQLite.bundle index f44dc5a7981..f4ba8bc401d 100755 Binary files a/CPAN/arch/5.34/darwin-thread-multi-2level/auto/DBD/SQLite/SQLite.bundle and b/CPAN/arch/5.34/darwin-thread-multi-2level/auto/DBD/SQLite/SQLite.bundle differ diff --git a/CPAN/arch/5.34/x86_64-linux-thread-multi/auto/DBD/SQLite/SQLite.so b/CPAN/arch/5.34/x86_64-linux-thread-multi/auto/DBD/SQLite/SQLite.so index fd598678ce8..acfd69fa5f7 100755 Binary files a/CPAN/arch/5.34/x86_64-linux-thread-multi/auto/DBD/SQLite/SQLite.so and b/CPAN/arch/5.34/x86_64-linux-thread-multi/auto/DBD/SQLite/SQLite.so differ diff --git a/CPAN/arch/5.36/DBD/SQLite.pm b/CPAN/arch/5.36/DBD/SQLite.pm index a719c10ea75..1032e1dcc70 100644 --- a/CPAN/arch/5.36/DBD/SQLite.pm +++ b/CPAN/arch/5.36/DBD/SQLite.pm @@ -3,10 +3,9 @@ package DBD::SQLite; use 5.006; use strict; use DBI 1.57 (); -use DynaLoader (); +use XSLoader (); -our $VERSION = '1.58'; -our @ISA = 'DynaLoader'; +our $VERSION = '1.76'; # sqlite_version cache (set in the XS bootstrap) our ($sqlite_version, $sqlite_version_number); @@ -14,7 +13,7 @@ our ($sqlite_version, $sqlite_version_number); # not sure if we still need these... our ($err, $errstr); -__PACKAGE__->bootstrap($VERSION); +XSLoader::load('DBD::SQLite', $VERSION); # New or old API? use constant NEWAPI => ($DBI::VERSION >= 1.608); @@ -47,6 +46,8 @@ sub driver { DBD::SQLite::db->install_method('sqlite_set_authorizer'); DBD::SQLite::db->install_method('sqlite_backup_from_file'); DBD::SQLite::db->install_method('sqlite_backup_to_file'); + DBD::SQLite::db->install_method('sqlite_backup_from_dbh'); + DBD::SQLite::db->install_method('sqlite_backup_to_dbh'); DBD::SQLite::db->install_method('sqlite_enable_load_extension'); DBD::SQLite::db->install_method('sqlite_load_extension'); DBD::SQLite::db->install_method('sqlite_register_fts3_perl_tokenizer'); @@ -57,6 +58,11 @@ sub driver { DBD::SQLite::db->install_method('sqlite_db_status', { O => 0x0004 }); DBD::SQLite::st->install_method('sqlite_st_status', { O => 0x0004 }); DBD::SQLite::db->install_method('sqlite_create_module'); + DBD::SQLite::db->install_method('sqlite_limit'); + DBD::SQLite::db->install_method('sqlite_db_config'); + DBD::SQLite::db->install_method('sqlite_get_autocommit'); + DBD::SQLite::db->install_method('sqlite_txn_state'); + DBD::SQLite::db->install_method('sqlite_error_offset'); $methods_are_installed++; } @@ -180,7 +186,7 @@ sub install_collation { # default implementation for sqlite 'REGEXP' infix operator. # Note : args are reversed, i.e. "a REGEXP b" calls REGEXP(b, a) -# (see http://www.sqlite.org/vtab.html#xfindfunction) +# (see https://www.sqlite.org/vtab.html#xfindfunction) sub regexp { use locale; return if !defined $_[0] || !defined $_[1]; @@ -190,6 +196,8 @@ sub regexp { package # hide from PAUSE DBD::SQLite::db; +use DBI qw/:sql_types/; + sub prepare { my $dbh = shift; my $sql = shift; @@ -245,19 +253,26 @@ sub ping { return $dbh->FETCH('Active') ? 1 : 0; } -sub _get_version { - return ( DBD::SQLite::db::FETCH($_[0], 'sqlite_version') ); +sub quote { + my ($self, $value, $data_type) = @_; + return "NULL" unless defined $value; + if (defined $data_type and ( + $data_type == DBI::SQL_BIT || + $data_type == DBI::SQL_BLOB || + $data_type == DBI::SQL_BINARY || + $data_type == DBI::SQL_VARBINARY || + $data_type == DBI::SQL_LONGVARBINARY)) { + return q(X') . unpack('H*', $value) . q('); + } + $value =~ s/'/''/g; + return "'$value'"; } -my %info = ( - 17 => 'SQLite', # SQL_DBMS_NAME - 18 => \&_get_version, # SQL_DBMS_VER - 29 => '"', # SQL_IDENTIFIER_QUOTE_CHAR -); - sub get_info { - my($dbh, $info_type) = @_; - my $v = $info{int($info_type)}; + my ($dbh, $info_type) = @_; + + require DBD::SQLite::GetInfo; + my $v = $DBD::SQLite::GetInfo::info{int($info_type)}; $v = $v->($dbh) if ref $v eq 'CODE'; return $v; } @@ -553,6 +568,15 @@ my @FOREIGN_KEY_INFO_SQL_CLI = qw( UNIQUE_OR_PRIMARY ); +my $DEFERRABLE_RE = qr/ + (?:(?: + on \s+ (?:delete|update) \s+ (?:set \s+ null|set \s+ default|cascade|restrict|no \s+ action) + | + match \s* (?:\S+|".+?(?selectall_arrayref("SELECT name FROM $master_table WHERE type = ?", undef, "table") or return; + my $tables = $dbh->selectall_arrayref("SELECT name, sql FROM $master_table WHERE type = ?", undef, "table") or return; for my $table (@$tables) { my $tbname = $table->[0]; + my $ddl = $table->[1]; + my (@rels, %relid2rels); next if defined $fk_table && $fk_table ne '%' && $fk_table ne $tbname; my $quoted_tbname = $dbh->quote_identifier($tbname); @@ -603,7 +629,17 @@ sub foreign_key_info { next if defined $pk_schema && $pk_schema ne '%' && $pk_schema ne $table_info{$row->{table}}{schema}; - push @fk_info, { + # cribbed from DBIx::Class::Schema::Loader::DBI::SQLite + my $rel = $rels[ $row->{id} ] ||= { + local_columns => [], + remote_columns => undef, + remote_table => $row->{table}, + }; + push @{ $rel->{local_columns} }, $row->{from}; + push @{ $rel->{remote_columns} }, $row->{to} + if defined $row->{to}; + + my $fk_row = { PKTABLE_CAT => undef, PKTABLE_SCHEM => $table_info{$row->{table}}{schema}, PKTABLE_NAME => $row->{table}, @@ -620,6 +656,44 @@ sub foreign_key_info { DEFERRABILITY => undef, UNIQUE_OR_PRIMARY => $table_info{$row->{table}}{columns}{$row->{to}} ? 'PRIMARY' : 'UNIQUE', }; + push @fk_info, $fk_row; + push @{ $relid2rels{$row->{id}} }, $fk_row; # keep so can fixup + } + + # cribbed from DBIx::Class::Schema::Loader::DBI::SQLite + # but with additional parsing of which kind of deferrable + REL: for my $relid (keys %relid2rels) { + my $rel = $rels[$relid]; + my $deferrable = $DBI_code_for_rule{'NOT DEFERRABLE'}; + my $local_cols = '"?' . (join '"? \s* , \s* "?', map quotemeta, @{ $rel->{local_columns} }) . '"?'; + my $remote_cols = '"?' . (join '"? \s* , \s* "?', map quotemeta, @{ $rel->{remote_columns} || [] }) . '"?'; + my ($deferrable_clause) = $ddl =~ / + foreign \s+ key \s* \( \s* $local_cols \s* \) \s* references \s* (?:\S+|".+?(?{local_columns} } == 1) { + my ($local_col) = @{ $rel->{local_columns} }; + my ($remote_col) = @{ $rel->{remote_columns} || [] }; + $remote_col ||= ''; + ($deferrable_clause) = $ddl =~ / + "?\Q$local_col\E"? \s* (?:\w+\s*)* (?: \( \s* \d\+ (?:\s*,\s*\d+)* \s* \) )? \s* + references \s+ (?:\S+|".+?(?{DEFERRABILITY} = $deferrable for @{ $relid2rels{$relid} }; } } } @@ -694,7 +768,7 @@ sub statistics_info { NON_UNIQUE => $row->{unique} ? 0 : 1, INDEX_QUALIFIER => undef, INDEX_NAME => $row->{name}, - TYPE => 'btree', # see http://www.sqlite.org/version3.html esp. "Traditional B-trees are still used for indices" + TYPE => 'btree', # see https://www.sqlite.org/version3.html esp. "Traditional B-trees are still used for indices" ORDINAL_POSITION => $info->{seqno} + 1, COLUMN_NAME => $info->{name}, ASC_OR_DESC => undef, @@ -721,45 +795,68 @@ sub statistics_info { return $sponge_sth; } +my @TypeInfoKeys = qw/ + TYPE_NAME + DATA_TYPE + COLUMN_SIZE + LITERAL_PREFIX + LITERAL_SUFFIX + CREATE_PARAMS + NULLABLE + CASE_SENSITIVE + SEARCHABLE + UNSIGNED_ATTRIBUTE + FIXED_PREC_SCALE + AUTO_UNIQUE_VALUE + LOCAL_TYPE_NAME + MINIMUM_SCALE + MAXIMUM_SCALE + SQL_DATA_TYPE + SQL_DATETIME_SUB + NUM_PREC_RADIX + INTERVAL_PRECISION +/; + +my %TypeInfo = ( + SQL_INTEGER ,=> { + TYPE_NAME => 'INTEGER', + DATA_TYPE => SQL_INTEGER, + NULLABLE => 2, # no for integer primary key, otherwise yes + SEARCHABLE => 3, + }, + SQL_DOUBLE ,=> { + TYPE_NAME => 'REAL', + DATA_TYPE => SQL_DOUBLE, + NULLABLE => 1, + SEARCHABLE => 3, + }, + SQL_VARCHAR ,=> { + TYPE_NAME => 'TEXT', + DATA_TYPE => SQL_VARCHAR, + LITERAL_PREFIX => "'", + LITERAL_SUFFIX => "'", + NULLABLE => 1, + SEARCHABLE => 3, + }, + SQL_BLOB ,=> { + TYPE_NAME => 'BLOB', + DATA_TYPE => SQL_BLOB, + NULLABLE => 1, + SEARCHABLE => 3, + }, + SQL_UNKNOWN_TYPE ,=> { + DATA_TYPE => SQL_UNKNOWN_TYPE, + }, +); + sub type_info_all { - return; # XXX code just copied from DBD::Oracle, not yet thought about -# return [ -# { -# TYPE_NAME => 0, -# DATA_TYPE => 1, -# COLUMN_SIZE => 2, -# LITERAL_PREFIX => 3, -# LITERAL_SUFFIX => 4, -# CREATE_PARAMS => 5, -# NULLABLE => 6, -# CASE_SENSITIVE => 7, -# SEARCHABLE => 8, -# UNSIGNED_ATTRIBUTE => 9, -# FIXED_PREC_SCALE => 10, -# AUTO_UNIQUE_VALUE => 11, -# LOCAL_TYPE_NAME => 12, -# MINIMUM_SCALE => 13, -# MAXIMUM_SCALE => 14, -# SQL_DATA_TYPE => 15, -# SQL_DATETIME_SUB => 16, -# NUM_PREC_RADIX => 17, -# }, -# [ 'CHAR', 1, 255, '\'', '\'', 'max length', 1, 1, 3, -# undef, '0', '0', undef, undef, undef, 1, undef, undef -# ], -# [ 'NUMBER', 3, 38, undef, undef, 'precision,scale', 1, '0', 3, -# '0', '0', '0', undef, '0', 38, 3, undef, 10 -# ], -# [ 'DOUBLE', 8, 15, undef, undef, undef, 1, '0', 3, -# '0', '0', '0', undef, undef, undef, 8, undef, 10 -# ], -# [ 'DATE', 9, 19, '\'', '\'', undef, 1, '0', 3, -# undef, '0', '0', undef, '0', '0', 11, undef, undef -# ], -# [ 'VARCHAR', 12, 1024*1024, '\'', '\'', 'max length', 1, 1, 3, -# undef, '0', '0', undef, undef, undef, 12, undef, undef -# ] -# ]; + my $idx = 0; + + my @info = ({map {$_ => $idx++} @TypeInfoKeys}); + for my $id (sort {$a <=> $b} keys %TypeInfo) { + push @info, [map {$TypeInfo{$id}{$_}} @TypeInfoKeys]; + } + return \@info; } my @COLUMN_INFO = qw( @@ -936,7 +1033,7 @@ DBD::SQLite - Self-contained RDBMS in a DBI Driver =head1 DESCRIPTION SQLite is a public domain file-based relational database engine that -you can find at L. +you can find at L. B is a Perl DBI driver for SQLite, that includes the entire thing in the distribution. @@ -950,7 +1047,7 @@ SQLite supports the following features: =item Implements a large subset of SQL92 -See L for details. +See L for details. =item A complete DB in a single disk file @@ -977,7 +1074,7 @@ are limited by the typeless nature of the SQLite database. =head1 SQLITE VERSION DBD::SQLite is usually compiled with a bundled SQLite library -(SQLite version S<3.22.0> as of this release) for consistency. +(SQLite version S<3.46.1> as of this release) for consistency. However, a different version of SQLite may sometimes be used for some reasons like security, or some new experimental features. @@ -1021,7 +1118,7 @@ If the filename C<$dbfile> is an empty string, then a private, temporary on-disk database will be created. This private database will be automatically deleted as soon as the database connection is closed. -As of 1.41_01, you can pass URI filename (see L) +As of 1.41_01, you can pass URI filename (see L) as well for finer control: my $dbh = DBI->connect("dbi:SQLite:uri=file:$path_to_dbfile?mode=rwc"); @@ -1038,7 +1135,7 @@ You can set sqlite_open_flags (only) when you connect to a database: sqlite_open_flags => SQLITE_OPEN_READONLY, }); -See L for details. +See L for details. As of 1.49_05, you can also make a database read-only by setting C attribute to true (only) when you connect to a database. @@ -1156,7 +1253,7 @@ like this while executing: SELECT bar FROM foo GROUP BY bar HAVING count(*) > "5"; -There are three workarounds for this. +There are four workarounds for this. =over 4 @@ -1182,6 +1279,15 @@ This is somewhat weird, but works anyway. }); $sth->execute(5); +=item Use SQL cast() function + +This is more explicit way to do the above. + + my $sth = $dbh->prepare(q{ + SELECT bar FROM foo GROUP BY bar HAVING count(*) > cast(? as integer); + }); + $sth->execute(5); + =item Set C database handle attribute As of version 1.32_02, you can use C @@ -1230,7 +1336,7 @@ SQLite supports several placeholder expressions, including C and C<:AAAA>. Consult the L and SQLite documentation for details. -L +L Note that a question mark actually means a next unused (numbered) placeholder. You're advised not to use it with other (numbered or @@ -1300,7 +1406,7 @@ in the worst case. See also L section below. =back -See L for more details. +See L for more details. =head2 Foreign Keys @@ -1328,7 +1434,7 @@ SQLite, be prepared, and please do extensive testing to ensure that your applications will continue to work when the foreign keys support is enabled by default. -See L for details. +See L for details. =head2 Transactions @@ -1382,7 +1488,7 @@ automatically begin if you execute another statement. This C mode is independent from the autocommit mode of the internal SQLite library, which always begins by a C -statement, and ends by a C or a . +statement, and ends by a C or a C. =head2 Transaction and Database Locking @@ -1451,9 +1557,22 @@ of the rest (since 1.30_01, and without creating DBI's statement handles internally since 1.47_01). If you do need to use C or C (which I don't recommend in this case, because typically there's no placeholder nor reusable part in a dump), -you can look at << $sth->{sqlite_unprepared_statements} >> to retrieve +you can look at C<< $sth->{sqlite_unprepared_statements} >> to retrieve what's left, though it usually contains nothing but white spaces. +=head2 TYPE statement attribute + +Because of historical reasons, DBD::SQLite's C statement +handle attribute returns an array ref of string values, contrary to +the DBI specification. This value is also less useful for SQLite +users because SQLite uses dynamic type system (that means, +the datatype of a value is associated with the value itself, not +with its container). + +As of version 1.61_02, if you set C +database handle attribute to true, C statement handle +attribute returns an array of integer, as an experiment. + =head2 Performance SQLite is fast, very fast. Matt processed his 72MB log file with it, @@ -1502,34 +1621,74 @@ Your sweet spot probably lies somewhere in between. =item sqlite_version Returns the version of the SQLite library which B is using, -e.g., "2.8.0". Can only be read. +e.g., "3.26.0". Can only be read. + +=item sqlite_string_mode + +SQLite strings are simple arrays of bytes, but Perl strings can store any +arbitrary Unicode code point. Thus, DBD::SQLite has to adopt some method +of translating between those two models. This parameter defines that +translation. + +Accepted values are the following constants: -=item sqlite_unicode +=over + +=item * DBD_SQLITE_STRING_MODE_BYTES: All strings are assumed to +represent bytes. A Perl string that contains any code point above 255 +will trigger an exception. This is appropriate for Latin-1 strings, +binary data, pre-encoded UTF-8 strings, etc. + +=item * DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK: All Perl strings are encoded +to UTF-8 before being given to SQLite. Perl will B to decode SQLite +strings as UTF-8 when giving them to Perl. Should any such string not be +valid UTF-8, a warning is thrown, and the string is left undecoded. -If set to a true value, B will turn the UTF-8 flag on for all -text strings coming out of the database (this feature is currently disabled -for perl < 5.8.5). For more details on the UTF-8 flag see -L. The default is for the UTF-8 flag to be turned off. +This is appropriate for strings that are decoded to characters via, +e.g., L. -Also note that due to some bizarreness in SQLite's type system (see -L), if you want to retain -blob-style behavior for B columns under C<< $dbh->{sqlite_unicode} = 1 ->> (say, to store images in the database), you have to state so +Also note that, due to some bizarreness in SQLite's type system (see +L), if you want to retain +blob-style behavior for B columns under DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK +(say, to store images in the database), you have to state so explicitly using the 3-argument form of L when doing updates: use DBI qw(:sql_types); - $dbh->{sqlite_unicode} = 1; + use DBD::SQLite::Constants ':dbd_sqlite_string_mode'; + $dbh->{sqlite_string_mode} = DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK; my $sth = $dbh->prepare("INSERT INTO mytable (blobcolumn) VALUES (?)"); - + # Binary_data will be stored as is. $sth->bind_param(1, $binary_data, SQL_BLOB); Defining the column type as C in the DDL is B sufficient. -This attribute was originally named as C, and renamed to -C for integrity since version 1.26_06. Old C -attribute is still accessible but will be deprecated in the near future. +=item * DBD_SQLITE_STRING_MODE_UNICODE_STRICT: Like +DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK but usually throws an exception +rather than a warning if SQLite sends invalid UTF-8. (In Perl callbacks +from SQLite we still warn instead.) + +=item * DBD_SQLITE_STRING_MODE_UNICODE_NAIVE: Like +DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK but uses a "naïve" UTF-8 decoding +method that forgoes validation. This is marginally faster than a validated +decode, but it can also B B B + +=item * DBD_SQLITE_STRING_MODE_PV (default, but B B B): Like +DBD_SQLITE_STRING_MODE_BYTES, but when translating Perl strings to SQLite +the Perl string's internal byte buffer is given to SQLite. B B +B, but it's been the default for many years, and changing that would +break existing applications. + +=back + +=item C or C (deprecated) + +If truthy, equivalent to setting C to +DBD_SQLITE_STRING_MODE_UNICODE_NAIVE; if falsy, equivalent to +DBD_SQLITE_STRING_MODE_PV. + +Prefer C in all new code. =item sqlite_allow_multiple_statements @@ -1556,7 +1715,12 @@ for details. =item sqlite_extended_result_codes If set to true, DBD::SQLite uses extended result codes where appropriate -(see L). +(see L). + +=item sqlite_defensive + +If set to true, language features that allow ordinary SQL to deliberately +corrupt the database file are prohibited. =back @@ -1585,7 +1749,8 @@ Returns all tables and schemas (databases) as specified in L. The schema and table arguments will do a C search. You can specify an ESCAPE character by including an 'Escape' attribute in \%attr. The C<$type> argument accepts a comma separated list of the following types 'TABLE', -'VIEW', 'LOCAL TEMPORARY' and 'SYSTEM TABLE' (by default all are returned). +'INDEX', 'VIEW', 'TRIGGER', 'LOCAL TEMPORARY' and 'SYSTEM TABLE' +(by default all are returned). Note that a statement handle is returned, and not a direct list of tables. The following fields are returned: @@ -1598,8 +1763,8 @@ databases will be in the name given when the database was attached. B: The name of the table or view. -B: The type of object returned. Will be one of 'TABLE', 'VIEW', -'LOCAL TEMPORARY' or 'SYSTEM TABLE'. +B: The type of object returned. Will be one of 'TABLE', 'INDEX', +'VIEW', 'TRIGGER', 'LOCAL TEMPORARY' or 'SYSTEM TABLE'. =head2 primary_key, primary_key_info @@ -1665,10 +1830,12 @@ B: The referential action for the DELETE rule. The codes are the same as for UPDATE_RULE. -Unfortunately, the B field is always C; -as a matter of fact, deferrability clauses are supported by SQLite, -but they can't be reported because the C -tells nothing about them. +B: +The following codes are defined: + + INITIALLY DEFERRED 5 + INITIALLY IMMEDIATE 6 + NOT DEFERRABLE 7 B: Whether the column is primary or unique. @@ -1728,7 +1895,7 @@ returns true if the database file exists (or the database is in-memory), and the The following methods can be called via the func() method with a little tweak, but the use of func() method is now discouraged by the L author for various reasons (see DBI's document -L +L for details). So, if you're using L >= 1.608, use these C methods. If you need to use an older L, you can call these like this: @@ -1755,7 +1922,8 @@ C<$dbh-Esqlite_last_insert_rowid()> directly. =head2 $dbh->sqlite_db_filename() -Retrieve the current (main) database filename. If the database is in-memory or temporary, this returns C. +Retrieve the current (main) database filename. If the database is in-memory +or temporary, this returns an empty string, or C. =head2 $dbh->sqlite_busy_timeout() @@ -1801,6 +1969,13 @@ After this, it could be used from SQL as: INSERT INTO mytable ( now() ); +The function should return a scalar value, and the value is treated as a text +(or a number if appropriate) by default. If you do need to specify a type +of the return value (like BLOB), you can return a reference to an array that +contains the value and the type, as of 1.65_01. + + $dbh->sqlite_create_function( 'md5', 1, sub { return [md5($_[0]), SQL_BLOB] } ); + =head3 REGEXP function SQLite includes syntactic support for an infix operator 'REGEXP', but @@ -2105,18 +2280,39 @@ special :memory: database, and you wish to populate it from an existing DB. This method accesses the SQLite Online Backup API, and will take a backup of the currently connected database, and write it out to the named file. +=head2 $dbh->sqlite_backup_from_dbh( $another_dbh ) + +This method accesses the SQLite Online Backup API, and will take a backup of +the database for the passed handle, copying it to, and overwriting, your current database +connection. This can be particularly handy if your current connection is to the +special :memory: database, and you wish to populate it from an existing DB. +You can use this to backup from an in-memory database to another in-memory database. + +=head2 $dbh->sqlite_backup_to_dbh( $another_dbh ) + +This method accesses the SQLite Online Backup API, and will take a backup of +the currently connected database, and write it out to the passed database handle. + =head2 $dbh->sqlite_enable_load_extension( $bool ) Calling this method with a true value enables loading (external) SQLite3 extensions. After the call, you can load extensions like this: $dbh->sqlite_enable_load_extension(1); - $sth = $dbh->prepare("select load_extension('libsqlitefunctions.so')") + $sth = $dbh->prepare("select load_extension('libmemvfs.so')") or die "Cannot prepare: " . $dbh->errstr(); =head2 $dbh->sqlite_load_extension( $file, $proc ) -Loading an extension by a select statement (with the "load_extension" SQLite3 function like above) has some limitations. If you need to, say, create other functions from an extension, use this method. $file (a path to the extension) is mandatory, and $proc (an entry point name) is optional. You need to call C before calling C. +Loading an extension by a select statement (with the "load_extension" SQLite3 function like above) has some limitations. If the extension you want to use creates other functions that are not native to SQLite, use this method instead. $file (a path to the extension) is mandatory, and $proc (an entry point name) is optional. You need to call C before calling C: + + $dbh->sqlite_enable_load_extension(1); + $dbh->sqlite_load_extension('libsqlitefunctions.so') + or die "Cannot load extension: " . $dbh->errstr(); + +If the extension uses SQLite mutex functions like C, then +the extension should be compiled with the same C compile-time +setting as this module, see C. =head2 $dbh->sqlite_trace( $code_ref ) @@ -2177,17 +2373,38 @@ is for internal use only. =head2 $dbh->sqlite_db_status() -Returns a hash reference that holds a set of status information of database connection such as cache usage. See L for details. You may also pass 0 as an argument to reset the status. +Returns a hash reference that holds a set of status information of database connection such as cache usage. See L for details. You may also pass 0 as an argument to reset the status. =head2 $sth->sqlite_st_status() -Returns a hash reference that holds a set of status information of SQLite statement handle such as full table scan count. See L for details. Statement status only holds the current value. +Returns a hash reference that holds a set of status information of SQLite statement handle such as full table scan count. See L for details. Statement status only holds the current value. my $status = $sth->sqlite_st_status(); my $cur = $status->{fullscan_step}; You may also pass 0 as an argument to reset the status. +=head2 $dbh->sqlite_db_config( $id, $new_integer_value ) + +You can change how the connected database should behave like this: + + use DBD::SQLite::Constants qw/:database_connection_configuration_options/; + + my $dbh = DBI->connect('dbi:SQLite::memory:'); + + # This disables language features that allow ordinary SQL + # to deliberately corrupt the database file + $dbh->sqlite_db_config( SQLITE_DBCONFIG_DEFENSIVE, 1 ); + + # This disables two-arg version of fts3_tokenizer. + $dbh->sqlite_db_config( SQLITE_DBCONFIG_ENABLE_FTS3_TOKENIZER, 0 ); + +C returns the new value after the call. If you just want to know the current value without changing anything, pass a negative integer value. + + my $current_value = $dbh->sqlite_db_config( SQLITE_DBCONFIG_DEFENSIVE, -1 ); + +As of this writing, C only supports options that set an integer value. C and C are not supported. See also C for details. + =head2 $dbh->sqlite_create_module() Registers a name for a I. Module names must be @@ -2195,6 +2412,33 @@ registered before creating a new virtual table using the module and before using a preexisting virtual table for the module. Virtual tables are explained in L. +=head2 $dbh->sqlite_limit( $category_id, $new_value ) + +Sets a new run-time limit for the category, and returns the current limit. +If the new value is a negative number (or omitted), the limit is unchanged +and just returns the current limit. Category ids (SQLITE_LIMIT_LENGTH, +SQLITE_LIMIT_VARIABLE_NUMBER, etc) can be imported from DBD::SQLite::Constants. + +=head2 $dbh->sqlite_get_autocommit() + +Returns true if the internal SQLite connection is in an autocommit mode. +This does not always return the same value as C<< $dbh->{AutoCommit} >>. +This returns false if you explicitly issue a C<> statement. + +=head2 $dbh->sqlite_txn_state() + +Returns the internal transaction status of SQLite (not of DBI). +Return values (SQLITE_TXN_NONE, SQLITE_TXN_READ, SQLITE_TXN_WRITE) +can be imported from DBD::SQLite::Constants. You may pass an optional +schema name (usually "main"). If SQLite does not support this function, +or if you pass a wrong schema name, -1 is returned. + +=head2 $dbh->sqlite_error_offset() + +Returns the byte offset of the start of a problematic input SQL token +or -1 if the most recent error does not reference a specific token in +the input SQL (or DBD::SQLite is built with an older version of SQLite). + =head1 DRIVER FUNCTIONS =head2 DBD::SQLite::compile_options() @@ -2205,7 +2449,7 @@ library is old or compiled with SQLITE_OMIT_COMPILEOPTION_DIAGS. =head2 DBD::SQLite::sqlite_status() -Returns a hash reference that holds a set of status information of SQLite runtime such as memory usage or page cache usage (see L for details). Each of the entry contains the current value and the highwater value. +Returns a hash reference that holds a set of status information of SQLite runtime such as memory usage or page cache usage (see L for details). Each of the entry contains the current value and the highwater value. my $status = DBD::SQLite::sqlite_status(); my $cur = $status->{memory_used}{current}; @@ -2239,7 +2483,7 @@ DELETE operation would be written as follows : The list of constants implemented in C is given below; more information can be found ad -at L. +at L. =head2 Authorizer Return Codes @@ -2299,7 +2543,7 @@ associated strings. SQLite v3 provides the ability for users to supply arbitrary comparison functions, known as user-defined "collation sequences" or "collating functions", to be used for comparing two text values. -L +L explains how collations are used in various SQL expressions. =head2 Builtin collation sequences @@ -2357,18 +2601,17 @@ or =head2 Unicode handling -If the attribute C<< $dbh->{sqlite_unicode} >> is set, strings coming from -the database and passed to the collation function will be properly -tagged with the utf8 flag; but this only works if the -C attribute is set B the first call to -a perl collation sequence . The recommended way to activate unicode -is to set the parameter at connection time : +Depending on the C<< $dbh->{sqlite_string_mode} >> value, strings coming +from the database and passed to the collation function may be decoded as +UTF-8. This only works, though, if the C attribute is +set B the first call to a perl collation sequence. The recommended +way to activate unicode is to set C at connection time: my $dbh = DBI->connect( "dbi:SQLite:dbname=foo", "", "", { - RaiseError => 1, - sqlite_unicode => 1, + RaiseError => 1, + sqlite_string_mode => DBD_SQLITE_STRING_MODE_UNICODE_STRICT, } ); @@ -2390,7 +2633,7 @@ characters : use DBD::SQLite; $DBD::SQLite::COLLATION{no_accents} = sub { my ( $a, $b ) = map lc, @_; - tr[] + tr[àâáäåãçðèêéëìîíïñòôóöõøùûúüý] [aaaaaacdeeeeiiiinoooooouuuuy] for $a, $b; $a cmp $b; }; @@ -2463,7 +2706,7 @@ then query which buildings overlap or are contained within a specified region: $minLong, $maxLong, $minLat, $maxLat); For more detail, please see the SQLite R-Tree page -(L). Note that custom R-Tree +(L). Note that custom R-Tree queries using callbacks, as mentioned in the prior link, have not been implemented yet. @@ -2547,13 +2790,17 @@ Reading/writing into blobs using C / C. =head2 Support for custom callbacks for R-Tree queries Custom queries of a R-Tree index using a callback are possible with -the SQLite C API (L), so one could +the SQLite C API (L), so one could potentially use a callback that narrowed the result set down based on a specific need, such as querying for overlapping circles. =head1 SUPPORT -Bugs should be reported via the CPAN bug tracker at +Bugs should be reported to GitHub issues: + +L + +or via RT if you prefer: L diff --git a/CPAN/arch/5.36/DBD/SQLite/Constants.pm b/CPAN/arch/5.36/DBD/SQLite/Constants.pm index a9f55dcab90..5be8f0aa4bd 100644 --- a/CPAN/arch/5.36/DBD/SQLite/Constants.pm +++ b/CPAN/arch/5.36/DBD/SQLite/Constants.pm @@ -8,6 +8,18 @@ use warnings; use base 'Exporter'; use DBD::SQLite; our @EXPORT_OK = ( + 'DBD_SQLITE_STRING_MODE_PV', + 'DBD_SQLITE_STRING_MODE_BYTES', + 'DBD_SQLITE_STRING_MODE_UNICODE_NAIVE', + 'DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK', + 'DBD_SQLITE_STRING_MODE_UNICODE_STRICT', + # allowed_return_values_from_sqlite3_txn_state + qw/ + SQLITE_TXN_NONE + SQLITE_TXN_READ + SQLITE_TXN_WRITE + /, + # authorizer_action_codes qw/ SQLITE_ALTER_TABLE @@ -57,27 +69,62 @@ our @EXPORT_OK = ( SQLITE_VERSION_NUMBER /, + # database_connection_configuration_options + qw/ + SQLITE_DBCONFIG_DEFENSIVE + SQLITE_DBCONFIG_DQS_DDL + SQLITE_DBCONFIG_DQS_DML + SQLITE_DBCONFIG_ENABLE_FKEY + SQLITE_DBCONFIG_ENABLE_FTS3_TOKENIZER + SQLITE_DBCONFIG_ENABLE_LOAD_EXTENSION + SQLITE_DBCONFIG_ENABLE_QPSG + SQLITE_DBCONFIG_ENABLE_TRIGGER + SQLITE_DBCONFIG_ENABLE_VIEW + SQLITE_DBCONFIG_LEGACY_ALTER_TABLE + SQLITE_DBCONFIG_LEGACY_FILE_FORMAT + SQLITE_DBCONFIG_LOOKASIDE + SQLITE_DBCONFIG_MAINDBNAME + SQLITE_DBCONFIG_MAX + SQLITE_DBCONFIG_NO_CKPT_ON_CLOSE + SQLITE_DBCONFIG_RESET_DATABASE + SQLITE_DBCONFIG_REVERSE_SCANORDER + SQLITE_DBCONFIG_STMT_SCANSTATUS + SQLITE_DBCONFIG_TRIGGER_EQP + SQLITE_DBCONFIG_TRUSTED_SCHEMA + SQLITE_DBCONFIG_WRITABLE_SCHEMA + /, + # extended_result_codes qw/ SQLITE_ABORT_ROLLBACK SQLITE_AUTH_USER SQLITE_BUSY_RECOVERY SQLITE_BUSY_SNAPSHOT + SQLITE_BUSY_TIMEOUT SQLITE_CANTOPEN_CONVPATH + SQLITE_CANTOPEN_DIRTYWAL SQLITE_CANTOPEN_FULLPATH SQLITE_CANTOPEN_ISDIR SQLITE_CANTOPEN_NOTEMPDIR + SQLITE_CANTOPEN_SYMLINK SQLITE_CONSTRAINT_CHECK SQLITE_CONSTRAINT_COMMITHOOK + SQLITE_CONSTRAINT_DATATYPE SQLITE_CONSTRAINT_FOREIGNKEY SQLITE_CONSTRAINT_FUNCTION SQLITE_CONSTRAINT_NOTNULL + SQLITE_CONSTRAINT_PINNED SQLITE_CONSTRAINT_PRIMARYKEY SQLITE_CONSTRAINT_ROWID SQLITE_CONSTRAINT_TRIGGER SQLITE_CONSTRAINT_UNIQUE SQLITE_CONSTRAINT_VTAB + SQLITE_CORRUPT_INDEX + SQLITE_CORRUPT_SEQUENCE SQLITE_CORRUPT_VTAB + SQLITE_ERROR_MISSING_COLLSEQ + SQLITE_ERROR_RETRY + SQLITE_ERROR_SNAPSHOT SQLITE_IOERR_ACCESS SQLITE_IOERR_AUTH SQLITE_IOERR_BEGIN_ATOMIC @@ -86,6 +133,8 @@ our @EXPORT_OK = ( SQLITE_IOERR_CLOSE SQLITE_IOERR_COMMIT_ATOMIC SQLITE_IOERR_CONVPATH + SQLITE_IOERR_CORRUPTFS + SQLITE_IOERR_DATA SQLITE_IOERR_DELETE SQLITE_IOERR_DELETE_NOENT SQLITE_IOERR_DIR_CLOSE @@ -93,6 +142,7 @@ our @EXPORT_OK = ( SQLITE_IOERR_FSTAT SQLITE_IOERR_FSYNC SQLITE_IOERR_GETTEMPPATH + SQLITE_IOERR_IN_PAGE SQLITE_IOERR_LOCK SQLITE_IOERR_MMAP SQLITE_IOERR_NOMEM @@ -110,10 +160,15 @@ our @EXPORT_OK = ( SQLITE_IOERR_VNODE SQLITE_IOERR_WRITE SQLITE_LOCKED_SHAREDCACHE + SQLITE_LOCKED_VTAB + SQLITE_NOTICE_RBU SQLITE_NOTICE_RECOVER_ROLLBACK SQLITE_NOTICE_RECOVER_WAL + SQLITE_OK_SYMLINK + SQLITE_READONLY_CANTINIT SQLITE_READONLY_CANTLOCK SQLITE_READONLY_DBMOVED + SQLITE_READONLY_DIRECTORY SQLITE_READONLY_RECOVERY SQLITE_READONLY_ROLLBACK SQLITE_WARNING_AUTOINDEX @@ -122,19 +177,26 @@ our @EXPORT_OK = ( # flags_for_file_open_operations qw/ SQLITE_OPEN_CREATE + SQLITE_OPEN_EXRESCODE SQLITE_OPEN_FULLMUTEX SQLITE_OPEN_MEMORY + SQLITE_OPEN_NOFOLLOW SQLITE_OPEN_NOMUTEX SQLITE_OPEN_PRIVATECACHE SQLITE_OPEN_READONLY SQLITE_OPEN_READWRITE SQLITE_OPEN_SHAREDCACHE + SQLITE_OPEN_SUPER_JOURNAL SQLITE_OPEN_URI /, # function_flags qw/ SQLITE_DETERMINISTIC + SQLITE_DIRECTONLY + SQLITE_INNOCUOUS + SQLITE_RESULT_SUBTYPE + SQLITE_SUBTYPE /, # fundamental_datatypes @@ -143,6 +205,7 @@ our @EXPORT_OK = ( SQLITE_FLOAT SQLITE_INTEGER SQLITE_NULL + SQLITE_TEXT /, # result_codes @@ -180,6 +243,22 @@ our @EXPORT_OK = ( SQLITE_WARNING /, + # run_time_limit_categories + qw/ + SQLITE_LIMIT_ATTACHED + SQLITE_LIMIT_COLUMN + SQLITE_LIMIT_COMPOUND_SELECT + SQLITE_LIMIT_EXPR_DEPTH + SQLITE_LIMIT_FUNCTION_ARG + SQLITE_LIMIT_LENGTH + SQLITE_LIMIT_LIKE_PATTERN_LENGTH + SQLITE_LIMIT_SQL_LENGTH + SQLITE_LIMIT_TRIGGER_DEPTH + SQLITE_LIMIT_VARIABLE_NUMBER + SQLITE_LIMIT_VDBE_OP + SQLITE_LIMIT_WORKER_THREADS + /, + ); our %EXPORT_TAGS = ( @@ -195,17 +274,22 @@ our %EXPORT_TAGS = ( SQLITE_BUSY SQLITE_BUSY_RECOVERY SQLITE_BUSY_SNAPSHOT + SQLITE_BUSY_TIMEOUT SQLITE_CANTOPEN SQLITE_CANTOPEN_CONVPATH + SQLITE_CANTOPEN_DIRTYWAL SQLITE_CANTOPEN_FULLPATH SQLITE_CANTOPEN_ISDIR SQLITE_CANTOPEN_NOTEMPDIR + SQLITE_CANTOPEN_SYMLINK SQLITE_CONSTRAINT SQLITE_CONSTRAINT_CHECK SQLITE_CONSTRAINT_COMMITHOOK + SQLITE_CONSTRAINT_DATATYPE SQLITE_CONSTRAINT_FOREIGNKEY SQLITE_CONSTRAINT_FUNCTION SQLITE_CONSTRAINT_NOTNULL + SQLITE_CONSTRAINT_PINNED SQLITE_CONSTRAINT_PRIMARYKEY SQLITE_CONSTRAINT_ROWID SQLITE_CONSTRAINT_TRIGGER @@ -213,6 +297,8 @@ our %EXPORT_TAGS = ( SQLITE_CONSTRAINT_VTAB SQLITE_COPY SQLITE_CORRUPT + SQLITE_CORRUPT_INDEX + SQLITE_CORRUPT_SEQUENCE SQLITE_CORRUPT_VTAB SQLITE_CREATE_INDEX SQLITE_CREATE_TABLE @@ -223,10 +309,37 @@ our %EXPORT_TAGS = ( SQLITE_CREATE_TRIGGER SQLITE_CREATE_VIEW SQLITE_CREATE_VTABLE + SQLITE_DBCONFIG_DEFENSIVE + SQLITE_DBCONFIG_DQS_DDL + SQLITE_DBCONFIG_DQS_DML + SQLITE_DBCONFIG_ENABLE_FKEY + SQLITE_DBCONFIG_ENABLE_FTS3_TOKENIZER + SQLITE_DBCONFIG_ENABLE_LOAD_EXTENSION + SQLITE_DBCONFIG_ENABLE_QPSG + SQLITE_DBCONFIG_ENABLE_TRIGGER + SQLITE_DBCONFIG_ENABLE_VIEW + SQLITE_DBCONFIG_LEGACY_ALTER_TABLE + SQLITE_DBCONFIG_LEGACY_FILE_FORMAT + SQLITE_DBCONFIG_LOOKASIDE + SQLITE_DBCONFIG_MAINDBNAME + SQLITE_DBCONFIG_MAX + SQLITE_DBCONFIG_NO_CKPT_ON_CLOSE + SQLITE_DBCONFIG_RESET_DATABASE + SQLITE_DBCONFIG_REVERSE_SCANORDER + SQLITE_DBCONFIG_STMT_SCANSTATUS + SQLITE_DBCONFIG_TRIGGER_EQP + SQLITE_DBCONFIG_TRUSTED_SCHEMA + SQLITE_DBCONFIG_WRITABLE_SCHEMA + DBD_SQLITE_STRING_MODE_BYTES + DBD_SQLITE_STRING_MODE_PV + DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK + DBD_SQLITE_STRING_MODE_UNICODE_NAIVE + DBD_SQLITE_STRING_MODE_UNICODE_STRICT SQLITE_DELETE SQLITE_DENY SQLITE_DETACH SQLITE_DETERMINISTIC + SQLITE_DIRECTONLY SQLITE_DONE SQLITE_DROP_INDEX SQLITE_DROP_TABLE @@ -239,11 +352,15 @@ our %EXPORT_TAGS = ( SQLITE_DROP_VTABLE SQLITE_EMPTY SQLITE_ERROR + SQLITE_ERROR_MISSING_COLLSEQ + SQLITE_ERROR_RETRY + SQLITE_ERROR_SNAPSHOT SQLITE_FLOAT SQLITE_FORMAT SQLITE_FULL SQLITE_FUNCTION SQLITE_IGNORE + SQLITE_INNOCUOUS SQLITE_INSERT SQLITE_INTEGER SQLITE_INTERNAL @@ -257,6 +374,8 @@ our %EXPORT_TAGS = ( SQLITE_IOERR_CLOSE SQLITE_IOERR_COMMIT_ATOMIC SQLITE_IOERR_CONVPATH + SQLITE_IOERR_CORRUPTFS + SQLITE_IOERR_DATA SQLITE_IOERR_DELETE SQLITE_IOERR_DELETE_NOENT SQLITE_IOERR_DIR_CLOSE @@ -264,6 +383,7 @@ our %EXPORT_TAGS = ( SQLITE_IOERR_FSTAT SQLITE_IOERR_FSYNC SQLITE_IOERR_GETTEMPPATH + SQLITE_IOERR_IN_PAGE SQLITE_IOERR_LOCK SQLITE_IOERR_MMAP SQLITE_IOERR_NOMEM @@ -280,8 +400,21 @@ our %EXPORT_TAGS = ( SQLITE_IOERR_UNLOCK SQLITE_IOERR_VNODE SQLITE_IOERR_WRITE + SQLITE_LIMIT_ATTACHED + SQLITE_LIMIT_COLUMN + SQLITE_LIMIT_COMPOUND_SELECT + SQLITE_LIMIT_EXPR_DEPTH + SQLITE_LIMIT_FUNCTION_ARG + SQLITE_LIMIT_LENGTH + SQLITE_LIMIT_LIKE_PATTERN_LENGTH + SQLITE_LIMIT_SQL_LENGTH + SQLITE_LIMIT_TRIGGER_DEPTH + SQLITE_LIMIT_VARIABLE_NUMBER + SQLITE_LIMIT_VDBE_OP + SQLITE_LIMIT_WORKER_THREADS SQLITE_LOCKED SQLITE_LOCKED_SHAREDCACHE + SQLITE_LOCKED_VTAB SQLITE_MISMATCH SQLITE_MISUSE SQLITE_NOLFS @@ -289,18 +422,23 @@ our %EXPORT_TAGS = ( SQLITE_NOTADB SQLITE_NOTFOUND SQLITE_NOTICE + SQLITE_NOTICE_RBU SQLITE_NOTICE_RECOVER_ROLLBACK SQLITE_NOTICE_RECOVER_WAL SQLITE_NULL SQLITE_OK + SQLITE_OK_SYMLINK SQLITE_OPEN_CREATE + SQLITE_OPEN_EXRESCODE SQLITE_OPEN_FULLMUTEX SQLITE_OPEN_MEMORY + SQLITE_OPEN_NOFOLLOW SQLITE_OPEN_NOMUTEX SQLITE_OPEN_PRIVATECACHE SQLITE_OPEN_READONLY SQLITE_OPEN_READWRITE SQLITE_OPEN_SHAREDCACHE + SQLITE_OPEN_SUPER_JOURNAL SQLITE_OPEN_URI SQLITE_PERM SQLITE_PRAGMA @@ -308,24 +446,38 @@ our %EXPORT_TAGS = ( SQLITE_RANGE SQLITE_READ SQLITE_READONLY + SQLITE_READONLY_CANTINIT SQLITE_READONLY_CANTLOCK SQLITE_READONLY_DBMOVED + SQLITE_READONLY_DIRECTORY SQLITE_READONLY_RECOVERY SQLITE_READONLY_ROLLBACK SQLITE_RECURSIVE SQLITE_REINDEX + SQLITE_RESULT_SUBTYPE SQLITE_ROW SQLITE_SAVEPOINT SQLITE_SCHEMA SQLITE_SELECT + SQLITE_SUBTYPE + SQLITE_TEXT SQLITE_TOOBIG SQLITE_TRANSACTION + SQLITE_TXN_NONE + SQLITE_TXN_READ + SQLITE_TXN_WRITE SQLITE_UPDATE SQLITE_VERSION_NUMBER SQLITE_WARNING SQLITE_WARNING_AUTOINDEX /], + allowed_return_values_from_sqlite3_txn_state => [qw/ + SQLITE_TXN_NONE + SQLITE_TXN_READ + SQLITE_TXN_WRITE + /], + authorizer_action_codes => [qw/ SQLITE_ALTER_TABLE SQLITE_ANALYZE @@ -372,26 +524,68 @@ our %EXPORT_TAGS = ( SQLITE_VERSION_NUMBER /], + database_connection_configuration_options => [qw/ + SQLITE_DBCONFIG_DEFENSIVE + SQLITE_DBCONFIG_DQS_DDL + SQLITE_DBCONFIG_DQS_DML + SQLITE_DBCONFIG_ENABLE_FKEY + SQLITE_DBCONFIG_ENABLE_FTS3_TOKENIZER + SQLITE_DBCONFIG_ENABLE_LOAD_EXTENSION + SQLITE_DBCONFIG_ENABLE_QPSG + SQLITE_DBCONFIG_ENABLE_TRIGGER + SQLITE_DBCONFIG_ENABLE_VIEW + SQLITE_DBCONFIG_LEGACY_ALTER_TABLE + SQLITE_DBCONFIG_LEGACY_FILE_FORMAT + SQLITE_DBCONFIG_LOOKASIDE + SQLITE_DBCONFIG_MAINDBNAME + SQLITE_DBCONFIG_MAX + SQLITE_DBCONFIG_NO_CKPT_ON_CLOSE + SQLITE_DBCONFIG_RESET_DATABASE + SQLITE_DBCONFIG_REVERSE_SCANORDER + SQLITE_DBCONFIG_STMT_SCANSTATUS + SQLITE_DBCONFIG_TRIGGER_EQP + SQLITE_DBCONFIG_TRUSTED_SCHEMA + SQLITE_DBCONFIG_WRITABLE_SCHEMA + /], + + dbd_sqlite_string_mode => [qw/ + DBD_SQLITE_STRING_MODE_BYTES + DBD_SQLITE_STRING_MODE_PV + DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK + DBD_SQLITE_STRING_MODE_UNICODE_NAIVE + DBD_SQLITE_STRING_MODE_UNICODE_STRICT + /], + extended_result_codes => [qw/ SQLITE_ABORT_ROLLBACK SQLITE_AUTH_USER SQLITE_BUSY_RECOVERY SQLITE_BUSY_SNAPSHOT + SQLITE_BUSY_TIMEOUT SQLITE_CANTOPEN_CONVPATH + SQLITE_CANTOPEN_DIRTYWAL SQLITE_CANTOPEN_FULLPATH SQLITE_CANTOPEN_ISDIR SQLITE_CANTOPEN_NOTEMPDIR + SQLITE_CANTOPEN_SYMLINK SQLITE_CONSTRAINT_CHECK SQLITE_CONSTRAINT_COMMITHOOK + SQLITE_CONSTRAINT_DATATYPE SQLITE_CONSTRAINT_FOREIGNKEY SQLITE_CONSTRAINT_FUNCTION SQLITE_CONSTRAINT_NOTNULL + SQLITE_CONSTRAINT_PINNED SQLITE_CONSTRAINT_PRIMARYKEY SQLITE_CONSTRAINT_ROWID SQLITE_CONSTRAINT_TRIGGER SQLITE_CONSTRAINT_UNIQUE SQLITE_CONSTRAINT_VTAB + SQLITE_CORRUPT_INDEX + SQLITE_CORRUPT_SEQUENCE SQLITE_CORRUPT_VTAB + SQLITE_ERROR_MISSING_COLLSEQ + SQLITE_ERROR_RETRY + SQLITE_ERROR_SNAPSHOT SQLITE_IOERR_ACCESS SQLITE_IOERR_AUTH SQLITE_IOERR_BEGIN_ATOMIC @@ -400,6 +594,8 @@ our %EXPORT_TAGS = ( SQLITE_IOERR_CLOSE SQLITE_IOERR_COMMIT_ATOMIC SQLITE_IOERR_CONVPATH + SQLITE_IOERR_CORRUPTFS + SQLITE_IOERR_DATA SQLITE_IOERR_DELETE SQLITE_IOERR_DELETE_NOENT SQLITE_IOERR_DIR_CLOSE @@ -407,6 +603,7 @@ our %EXPORT_TAGS = ( SQLITE_IOERR_FSTAT SQLITE_IOERR_FSYNC SQLITE_IOERR_GETTEMPPATH + SQLITE_IOERR_IN_PAGE SQLITE_IOERR_LOCK SQLITE_IOERR_MMAP SQLITE_IOERR_NOMEM @@ -424,10 +621,15 @@ our %EXPORT_TAGS = ( SQLITE_IOERR_VNODE SQLITE_IOERR_WRITE SQLITE_LOCKED_SHAREDCACHE + SQLITE_LOCKED_VTAB + SQLITE_NOTICE_RBU SQLITE_NOTICE_RECOVER_ROLLBACK SQLITE_NOTICE_RECOVER_WAL + SQLITE_OK_SYMLINK + SQLITE_READONLY_CANTINIT SQLITE_READONLY_CANTLOCK SQLITE_READONLY_DBMOVED + SQLITE_READONLY_DIRECTORY SQLITE_READONLY_RECOVERY SQLITE_READONLY_ROLLBACK SQLITE_WARNING_AUTOINDEX @@ -435,18 +637,25 @@ our %EXPORT_TAGS = ( flags_for_file_open_operations => [qw/ SQLITE_OPEN_CREATE + SQLITE_OPEN_EXRESCODE SQLITE_OPEN_FULLMUTEX SQLITE_OPEN_MEMORY + SQLITE_OPEN_NOFOLLOW SQLITE_OPEN_NOMUTEX SQLITE_OPEN_PRIVATECACHE SQLITE_OPEN_READONLY SQLITE_OPEN_READWRITE SQLITE_OPEN_SHAREDCACHE + SQLITE_OPEN_SUPER_JOURNAL SQLITE_OPEN_URI /], function_flags => [qw/ SQLITE_DETERMINISTIC + SQLITE_DIRECTONLY + SQLITE_INNOCUOUS + SQLITE_RESULT_SUBTYPE + SQLITE_SUBTYPE /], fundamental_datatypes => [qw/ @@ -454,6 +663,7 @@ our %EXPORT_TAGS = ( SQLITE_FLOAT SQLITE_INTEGER SQLITE_NULL + SQLITE_TEXT /], result_codes => [qw/ @@ -490,6 +700,21 @@ our %EXPORT_TAGS = ( SQLITE_WARNING /], + run_time_limit_categories => [qw/ + SQLITE_LIMIT_ATTACHED + SQLITE_LIMIT_COLUMN + SQLITE_LIMIT_COMPOUND_SELECT + SQLITE_LIMIT_EXPR_DEPTH + SQLITE_LIMIT_FUNCTION_ARG + SQLITE_LIMIT_LENGTH + SQLITE_LIMIT_LIKE_PATTERN_LENGTH + SQLITE_LIMIT_SQL_LENGTH + SQLITE_LIMIT_TRIGGER_DEPTH + SQLITE_LIMIT_VARIABLE_NUMBER + SQLITE_LIMIT_VDBE_OP + SQLITE_LIMIT_WORKER_THREADS + /], + ); $EXPORT_TAGS{version} = $EXPORT_TAGS{compile_time_library_version_numbers}; $EXPORT_TAGS{file_open} = $EXPORT_TAGS{flags_for_file_open_operations}; @@ -511,12 +736,24 @@ DBD::SQLite::Constants - common SQLite constants =head1 DESCRIPTION -You can import necessary SQLite constants from this module. Available tags are C, C, C, C (C), C, C (C), C, C (C), C. See L for the complete list of constants. +You can import necessary SQLite constants from this module. Available tags are C, C, C, C, C (C), C, C, C, C (C), C, C (C), C, C. See L for the complete list of constants. This module does not export anything by default. =head1 CONSTANTS +=head2 allowed_return_values_from_sqlite3_txn_state + +=over 4 + +=item SQLITE_TXN_NONE + +=item SQLITE_TXN_READ + +=item SQLITE_TXN_WRITE + +=back + =head2 authorizer_action_codes =over 4 @@ -609,6 +846,70 @@ This module does not export anything by default. =back +=head2 database_connection_configuration_options + +=over 4 + +=item SQLITE_DBCONFIG_LOOKASIDE + +=item SQLITE_DBCONFIG_ENABLE_FKEY + +=item SQLITE_DBCONFIG_ENABLE_TRIGGER + +=item SQLITE_DBCONFIG_ENABLE_FTS3_TOKENIZER + +=item SQLITE_DBCONFIG_ENABLE_LOAD_EXTENSION + +=item SQLITE_DBCONFIG_MAINDBNAME + +=item SQLITE_DBCONFIG_NO_CKPT_ON_CLOSE + +=item SQLITE_DBCONFIG_ENABLE_QPSG + +=item SQLITE_DBCONFIG_TRIGGER_EQP + +=item SQLITE_DBCONFIG_MAX + +=item SQLITE_DBCONFIG_RESET_DATABASE + +=item SQLITE_DBCONFIG_DEFENSIVE + +=item SQLITE_DBCONFIG_WRITABLE_SCHEMA + +=item SQLITE_DBCONFIG_LEGACY_ALTER_TABLE + +=item SQLITE_DBCONFIG_DQS_DML + +=item SQLITE_DBCONFIG_DQS_DDL + +=item SQLITE_DBCONFIG_ENABLE_VIEW + +=item SQLITE_DBCONFIG_LEGACY_FILE_FORMAT + +=item SQLITE_DBCONFIG_TRUSTED_SCHEMA + +=item SQLITE_DBCONFIG_STMT_SCANSTATUS + +=item SQLITE_DBCONFIG_REVERSE_SCANORDER + +=back + +=head2 dbd_sqlite_string_mode + +=over 4 + +=item DBD_SQLITE_STRING_MODE_PV + +=item DBD_SQLITE_STRING_MODE_BYTES + +=item DBD_SQLITE_STRING_MODE_UNICODE_NAIVE + +=item DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK + +=item DBD_SQLITE_STRING_MODE_UNICODE_STRICT + +=back + =head2 extended_result_codes =over 4 @@ -729,6 +1030,42 @@ This module does not export anything by default. =item SQLITE_IOERR_ROLLBACK_ATOMIC +=item SQLITE_ERROR_MISSING_COLLSEQ + +=item SQLITE_ERROR_RETRY + +=item SQLITE_READONLY_CANTINIT + +=item SQLITE_READONLY_DIRECTORY + +=item SQLITE_LOCKED_VTAB + +=item SQLITE_CORRUPT_SEQUENCE + +=item SQLITE_ERROR_SNAPSHOT + +=item SQLITE_CANTOPEN_DIRTYWAL + +=item SQLITE_CANTOPEN_SYMLINK + +=item SQLITE_CONSTRAINT_PINNED + +=item SQLITE_OK_SYMLINK + +=item SQLITE_IOERR_DATA + +=item SQLITE_BUSY_TIMEOUT + +=item SQLITE_CORRUPT_INDEX + +=item SQLITE_IOERR_CORRUPTFS + +=item SQLITE_CONSTRAINT_DATATYPE + +=item SQLITE_NOTICE_RBU + +=item SQLITE_IOERR_IN_PAGE + =back =head2 file_open (flags_for_file_open_operations) @@ -753,6 +1090,12 @@ This module does not export anything by default. =item SQLITE_OPEN_MEMORY +=item SQLITE_OPEN_NOFOLLOW + +=item SQLITE_OPEN_SUPER_JOURNAL + +=item SQLITE_OPEN_EXRESCODE + =back =head2 function_flags @@ -761,6 +1104,14 @@ This module does not export anything by default. =item SQLITE_DETERMINISTIC +=item SQLITE_DIRECTONLY + +=item SQLITE_SUBTYPE + +=item SQLITE_INNOCUOUS + +=item SQLITE_RESULT_SUBTYPE + =back =head2 datatypes (fundamental_datatypes) @@ -775,6 +1126,8 @@ This module does not export anything by default. =item SQLITE_NULL +=item SQLITE_TEXT + =back =head2 result_codes @@ -845,3 +1198,33 @@ This module does not export anything by default. =back +=head2 run_time_limit_categories + +=over 4 + +=item SQLITE_LIMIT_LENGTH + +=item SQLITE_LIMIT_SQL_LENGTH + +=item SQLITE_LIMIT_COLUMN + +=item SQLITE_LIMIT_EXPR_DEPTH + +=item SQLITE_LIMIT_COMPOUND_SELECT + +=item SQLITE_LIMIT_VDBE_OP + +=item SQLITE_LIMIT_FUNCTION_ARG + +=item SQLITE_LIMIT_ATTACHED + +=item SQLITE_LIMIT_LIKE_PATTERN_LENGTH + +=item SQLITE_LIMIT_VARIABLE_NUMBER + +=item SQLITE_LIMIT_TRIGGER_DEPTH + +=item SQLITE_LIMIT_WORKER_THREADS + +=back + diff --git a/CPAN/arch/5.36/DBD/SQLite/GetInfo.pm b/CPAN/arch/5.36/DBD/SQLite/GetInfo.pm new file mode 100644 index 00000000000..083bfa4c02c --- /dev/null +++ b/CPAN/arch/5.36/DBD/SQLite/GetInfo.pm @@ -0,0 +1,288 @@ +package DBD::SQLite::GetInfo; + +use 5.006; +use strict; +use warnings; + +use DBD::SQLite; + +# SQL_DRIVER_VER should be formatted as dd.dd.dddd +my $dbdversion = $DBD::SQLite::VERSION; +$dbdversion .= '_00' if $dbdversion =~ /^\d+\.\d+$/; +my $sql_driver_ver = sprintf("%02d.%02d.%04d", split(/[\._]/, $dbdversion)); + +# Full list of keys and their return types: DBI::Const::GetInfo::ODBC + +# Most of the key definitions can be gleaned from: +# +# https://docs.microsoft.com/en-us/sql/odbc/reference/syntax/sqlgetinfo-function + +our %info = ( + 20 => 'N', # SQL_ACCESSIBLE_PROCEDURES - No stored procedures to access + 19 => 'Y', # SQL_ACCESSIBLE_TABLES - SELECT access to all tables in table_info + 0 => 0, # SQL_ACTIVE_CONNECTIONS - No maximum connection limit + 116 => 0, # SQL_ACTIVE_ENVIRONMENTS - No "active environment" limit + 1 => 0, # SQL_ACTIVE_STATEMENTS - No concurrent activity limit + 169 => 127, # SQL_AGGREGATE_FUNCTIONS - Supports all SQL-92 aggregrate functions + 117 => 0, # SQL_ALTER_DOMAIN - No ALTER DOMAIN support + 86 => 1, # SQL_ALTER_TABLE - Only supports ADD COLUMN and table rename (not listed in enum) in ALTER TABLE statements + 10021 => 0, # SQL_ASYNC_MODE - No asynchronous support (in vanilla SQLite) + 120 => 0, # SQL_BATCH_ROW_COUNT - No special row counting access + 121 => 0, # SQL_BATCH_SUPPORT - No batches + 82 => 0, # SQL_BOOKMARK_PERSISTENCE - No bookmark support + 114 => 1, # SQL_CATALOG_LOCATION - Database comes first in identifiers + 10003 => 'Y', # SQL_CATALOG_NAME - Supports database names + 41 => '.', # SQL_CATALOG_NAME_SEPARATOR - Separated by dot + 42 => 'database', # SQL_CATALOG_TERM - SQLite calls catalogs databases + 92 => 1+4+8, # SQL_CATALOG_USAGE - Supported in calls to DML & table/index definiton (no procedures or permissions) + 10004 => 'UTF-8', # SQL_COLLATION_SEQ - SQLite 3 uses UTF-8 by default + 87 => 'Y', # SQL_COLUMN_ALIAS - Supports column aliases + 22 => 0, # SQL_CONCAT_NULL_BEHAVIOR - 'a'||NULL = NULL + +# SQLite has no CONVERT function, only CAST. However, it converts to every "affinity" it supports. +# +# The only SQL_CVT_* types it doesn't support are date/time types, as it has no concept of +# date/time values once inserted. These are only convertable to text-like types. GUIDs are in +# the same boat, having no real means of switching to a numeric format. +# +# text/binary types = 31723265 +# numeric types = 28926 +# date/time types = 1802240 +# total = 33554431 + + 48 => 1, # SQL_CONVERT_FUNCTIONS - CAST only + + 53 => 31723265+28926, # SQL_CONVERT_BIGINT + 54 => 31723265+28926, # SQL_CONVERT_BINARY + 55 => 31723265+28926, # SQL_CONVERT_BIT + 56 => 33554431, # SQL_CONVERT_CHAR + 57 => 31723265+1802240, # SQL_CONVERT_DATE + 58 => 31723265+28926, # SQL_CONVERT_DECIMAL + 59 => 31723265+28926, # SQL_CONVERT_DOUBLE + 60 => 31723265+28926, # SQL_CONVERT_FLOAT + 173 => 31723265, # SQL_CONVERT_GUID + 61 => 31723265+28926, # SQL_CONVERT_INTEGER + 123 => 31723265+1802240, # SQL_CONVERT_INTERVAL_DAY_TIME + 124 => 31723265+1802240, # SQL_CONVERT_INTERVAL_YEAR_MONTH + 71 => 31723265+28926, # SQL_CONVERT_LONGVARBINARY + 62 => 31723265+28926, # SQL_CONVERT_LONGVARCHAR + 63 => 31723265+28926, # SQL_CONVERT_NUMERIC + 64 => 31723265+28926, # SQL_CONVERT_REAL + 65 => 31723265+28926, # SQL_CONVERT_SMALLINT + 66 => 31723265+1802240, # SQL_CONVERT_TIME + 67 => 31723265+1802240, # SQL_CONVERT_TIMESTAMP + 68 => 31723265+28926, # SQL_CONVERT_TINYINT + 69 => 33554431, # SQL_CONVERT_VARBINARY + 70 => 33554431, # SQL_CONVERT_VARCHAR + 122 => 33554431, # SQL_CONVERT_WCHAR + 125 => 33554431, # SQL_CONVERT_WLONGVARCHAR + 126 => 33554431, # SQL_CONVERT_WVARCHAR + + 74 => 1, # SQL_CORRELATION_NAME - Table aliases are supported, but must be named differently + 127 => 0, # SQL_CREATE_ASSERTION - No CREATE ASSERTION support + 128 => 0, # SQL_CREATE_CHARACTER_SET - No CREATE CHARACTER SET support + 129 => 0, # SQL_CREATE_COLLATION - No CREATE COLLATION support + 130 => 0, # SQL_CREATE_DOMAIN - No CREATE DOMAIN support + 131 => 0, # SQL_CREATE_SCHEMA - No CREATE SCHEMA support + 132 => 16383-2-8-4096, # SQL_CREATE_TABLE - Most of the functionality of CREATE TABLE support + 133 => 0, # SQL_CREATE_TRANSLATION - No CREATE TRANSLATION support + 134 => 1, # SQL_CREATE_VIEW - CREATE VIEW, no WITH CHECK OPTION support + + 23 => 2, # SQL_CURSOR_COMMIT_BEHAVIOR - Cursors are preserved + 24 => 2, # SQL_CURSOR_ROLLBACK_BEHAVIOR - Cursors are preserved + 10001 => 0, # SQL_CURSOR_SENSITIVITY - Cursors have a concept of snapshots, though this depends on the transaction type + + 2 => \&sql_data_source_name, # SQL_DATA_SOURCE_NAME - The DSN + 25 => \&sql_data_source_read_only, # SQL_DATA_SOURCE_READ_ONLY - Might have a SQLITE_OPEN_READONLY flag + 16 => \&sql_database_name, # SQL_DATABASE_NAME - Self-explanatory + 119 => 0, # SQL_DATETIME_LITERALS - No support for SQL-92's super weird date/time literal format (ie: {d '2999-12-12'}) + 17 => 'SQLite', # SQL_DBMS_NAME - You are here + 18 => \&sql_dbms_ver, # SQL_DBMS_VER - This driver version + 170 => 1+2, # SQL_DDL_INDEX - Supports CREATE/DROP INDEX + 26 => 8, # SQL_DEFAULT_TXN_ISOLATION - Default is SERIALIZABLE (See "PRAGMA read_uncommitted") + 10002 => 'N', # SQL_DESCRIBE_PARAMETER - No DESCRIBE INPUT support + +# XXX: MySQL/Oracle fills in HDBC and HENV, but information on what should actually go there is +# hard to acquire. + +# 171 => undef, # SQL_DM_VER - Not a Driver Manager +# 3 => undef, # SQL_DRIVER_HDBC - Not a Driver Manager +# 135 => undef, # SQL_DRIVER_HDESC - Not a Driver Manager +# 4 => undef, # SQL_DRIVER_HENV - Not a Driver Manager +# 76 => undef, # SQL_DRIVER_HLIB - Not a Driver Manager +# 5 => undef, # SQL_DRIVER_HSTMT - Not a Driver Manager + 6 => 'libsqlite3odbc.so', # SQL_DRIVER_NAME - SQLite3 ODBC driver (if installed) + 77 => '03.00', # SQL_DRIVER_ODBC_VER - Same as sqlite3odbc.c + 7 => $sql_driver_ver, # SQL_DRIVER_VER - Self-explanatory + + 136 => 0, # SQL_DROP_ASSERTION - No DROP ASSERTION support + 137 => 0, # SQL_DROP_CHARACTER_SET - No DROP CHARACTER SET support + 138 => 0, # SQL_DROP_COLLATION - No DROP COLLATION support + 139 => 0, # SQL_DROP_DOMAIN - No DROP DOMAIN support + 140 => 0, # SQL_DROP_SCHEMA - No DROP SCHEMA support + 141 => 1, # SQL_DROP_TABLE - DROP TABLE support, no RESTRICT/CASCADE + 142 => 0, # SQL_DROP_TRANSLATION - No DROP TRANSLATION support + 143 => 1, # SQL_DROP_VIEW - DROP VIEW support, no RESTRICT/CASCADE + +# NOTE: This is based purely on what sqlite3odbc supports. +# +# Static CA1: NEXT, ABSOLUTE, RELATIVE, BOOKMARK, LOCK_NO_CHANGE, POSITION, UPDATE, DELETE, REFRESH, +# BULK_ADD, BULK_UPDATE_BY_BOOKMARK, BULK_DELETE_BY_BOOKMARK = 466511 +# +# Forward-only CA1: NEXT, BOOKMARK +# +# CA2: READ_ONLY_CONCURRENCY, LOCK_CONCURRENCY + + 144 => 0, # SQL_DYNAMIC_CURSOR_ATTRIBUTES1 - No dynamic cursor support + 145 => 0, # SQL_DYNAMIC_CURSOR_ATTRIBUTES2 - No dynamic cursor support + 146 => 1+8, # SQL_FORWARD_ONLY_CURSOR_ATTRIBUTES1 + 147 => 1+2, # SQL_FORWARD_ONLY_CURSOR_ATTRIBUTES2 + 150 => 0, # SQL_KEYSET_CURSOR_ATTRIBUTES1 - No keyset cursor support + 151 => 0, # SQL_KEYSET_CURSOR_ATTRIBUTES2 - No keyset cursor support + 167 => 466511, # SQL_STATIC_CURSOR_ATTRIBUTES1 + 168 => 1+2, # SQL_STATIC_CURSOR_ATTRIBUTES2 + + 27 => 'Y', # SQL_EXPRESSIONS_IN_ORDERBY - ORDER BY allows expressions + 8 => 63, # SQL_FETCH_DIRECTION - Cursors support next, first, last, prior, absolute, relative + 84 => 2, # SQL_FILE_USAGE - Single-tier driver, treats files as databases + 81 => 1+2+8, # SQL_GETDATA_EXTENSIONS - Same as sqlite3odbc.c + 88 => 3, # SQL_GROUP_BY - SELECT columns are independent of GROUP BY columns + 28 => 4, # SQL_IDENTIFIER_CASE - Not case-sensitive, stored in mixed case + 29 => '"', # SQL_IDENTIFIER_QUOTE_CHAR - Uses " for identifiers, though supports [] and ` as well + 148 => 0, # SQL_INDEX_KEYWORDS - No support for ASC/DESC/ALL for CREATE INDEX + 149 => 0, # SQL_INFO_SCHEMA_VIEWS - No support for INFORMATION_SCHEMA + 172 => 1+2, # SQL_INSERT_STATEMENT - INSERT...VALUES & INSERT...SELECT + 73 => 'N', # SQL_INTEGRITY - No support for "Integrity Enhancement Facility" + 89 => \&sql_keywords, # SQL_KEYWORDS - List of non-ODBC keywords + 113 => 'Y', # SQL_LIKE_ESCAPE_CLAUSE - Supports LIKE...ESCAPE + 78 => 1, # SQL_LOCK_TYPES - Only NO_CHANGE + + 10022 => 0, # SQL_MAX_ASYNC_CONCURRENT_STATEMENTS - No async mode + 112 => 1_000_000, # SQL_MAX_BINARY_LITERAL_LEN - SQLITE_MAX_SQL_LENGTH + 34 => 1_000_000, # SQL_MAX_CATALOG_NAME_LEN - SQLITE_MAX_SQL_LENGTH + 108 => 1_000_000, # SQL_MAX_CHAR_LITERAL_LEN - SQLITE_MAX_SQL_LENGTH + 97 => 2000, # SQL_MAX_COLUMNS_IN_GROUP_BY - SQLITE_MAX_COLUMN + 98 => 2000, # SQL_MAX_COLUMNS_IN_INDEX - SQLITE_MAX_COLUMN + 99 => 2000, # SQL_MAX_COLUMNS_IN_ORDER_BY - SQLITE_MAX_COLUMN + 100 => 2000, # SQL_MAX_COLUMNS_IN_SELECT - SQLITE_MAX_COLUMN + 101 => 2000, # SQL_MAX_COLUMNS_IN_TABLE - SQLITE_MAX_COLUMN + 30 => 1_000_000, # SQL_MAX_COLUMN_NAME_LEN - SQLITE_MAX_SQL_LENGTH + 1 => 1021, # SQL_MAX_CONCURRENT_ACTIVITIES - Typical filehandle limits + 31 => 1_000_000, # SQL_MAX_CURSOR_NAME_LEN - SQLITE_MAX_SQL_LENGTH + 0 => 1021, # SQL_MAX_DRIVER_CONNECTIONS - Typical filehandle limits + 10005 => 1_000_000, # SQL_MAX_IDENTIFIER_LEN - SQLITE_MAX_SQL_LENGTH + 102 => 2147483646*65536, # SQL_MAX_INDEX_SIZE - Tied to DB size, which is theortically 140TB + 32 => 1_000_000, # SQL_MAX_OWNER_NAME_LEN - SQLITE_MAX_SQL_LENGTH + 33 => 1_000_000, # SQL_MAX_PROCEDURE_NAME_LEN - SQLITE_MAX_SQL_LENGTH + 34 => 1_000_000, # SQL_MAX_QUALIFIER_NAME_LEN - SQLITE_MAX_SQL_LENGTH + 104 => 1_000_000, # SQL_MAX_ROW_SIZE - SQLITE_MAX_SQL_LENGTH (since INSERT has to be used) + 103 => 'Y', # SQL_MAX_ROW_SIZE_INCLUDES_LONG + 32 => 1_000_000, # SQL_MAX_SCHEMA_NAME_LEN - SQLITE_MAX_SQL_LENGTH + 105 => 1_000_000, # SQL_MAX_STATEMENT_LEN - SQLITE_MAX_SQL_LENGTH + 106 => 64, # SQL_MAX_TABLES_IN_SELECT - 64 tables, because of the bitmap in the query optimizer + 35 => 1_000_000, # SQL_MAX_TABLE_NAME_LEN - SQLITE_MAX_SQL_LENGTH + 107 => 0, # SQL_MAX_USER_NAME_LEN - No user support + + 37 => 'Y', # SQL_MULTIPLE_ACTIVE_TXN - Supports mulitple txns, though not nested + 36 => 'N', # SQL_MULT_RESULT_SETS - No batches + 111 => 'N', # SQL_NEED_LONG_DATA_LEN - Doesn't care about LONG + 75 => 1, # SQL_NON_NULLABLE_COLUMNS - Supports NOT NULL + 85 => 1, # SQL_NULL_COLLATION - NULLs first on ASC (low end) + 49 => 4194304+1, # SQL_NUMERIC_FUNCTIONS - Just ABS & ROUND (has RANDOM, but not RAND) + + 9 => 1, # SQL_ODBC_API_CONFORMANCE - Same as sqlite3odbc.c + 152 => 1, # SQL_ODBC_INTERFACE_CONFORMANCE - Same as sqlite3odbc.c + 12 => 0, # SQL_ODBC_SAG_CLI_CONFORMANCE - Same as sqlite3odbc.c + 15 => 0, # SQL_ODBC_SQL_CONFORMANCE - Same as sqlite3odbc.c + 10 => '03.00', # SQL_ODBC_VER - Same as sqlite3odbc.c + + 115 => 1+8+16+32+64, # SQL_OJ_CAPABILITIES - Supports all OUTER JOINs except RIGHT & FULL + 90 => 'N', # SQL_ORDER_BY_COLUMNS_IN_SELECT - ORDER BY columns don't have to be in the SELECT list + 38 => 'Y', # SQL_OUTER_JOINS - Supports OUTER JOINs + 153 => 2, # SQL_PARAM_ARRAY_ROW_COUNTS - Only has row counts for executed statements + 154 => 3, # SQL_PARAM_ARRAY_SELECTS - No support for arrays of parameters + 80 => 0, # SQL_POSITIONED_STATEMENTS - No support for positioned statements (WHERE CURRENT OF or SELECT FOR UPDATE) + 79 => 31, # SQL_POS_OPERATIONS - Supports all SQLSetPos operations + 21 => 'N', # SQL_PROCEDURES - No procedures + 40 => '', # SQL_PROCEDURE_TERM - No procedures + 93 => 4, # SQL_QUOTED_IDENTIFIER_CASE - Even quoted identifiers are case-insensitive + 11 => 'N', # SQL_ROW_UPDATES - No fancy cursor update support + 39 => '', # SQL_SCHEMA_TERM - No schemas + 91 => 0, # SQL_SCHEMA_USAGE - No schemas + 43 => 2, # SQL_SCROLL_CONCURRENCY - Updates/deletes on cursors lock the database + 44 => 1+16, # SQL_SCROLL_OPTIONS - Only supports static & forward-only cursors + 14 => '\\', # SQL_SEARCH_PATTERN_ESCAPE - Default escape character for LIKE is \ + 13 => \&sql_server_name, # SQL_SERVER_NAME - Just $dbh->{Name} + 94 => '', # SQL_SPECIAL_CHARACTERS - Other drivers tend to stick to the ASCII/Latin-1 range, and SQLite uses all of + # the lower 7-bit punctuation for other things + + 155 => 7, # SQL_SQL92_DATETIME_FUNCTIONS - Supports CURRENT_(DATE|TIME|TIMESTAMP) + 156 => 1+2+4+8, # SQL_SQL92_FOREIGN_KEY_DELETE_RULE - Support all ON DELETE options + 157 => 1+2+4+8, # SQL_SQL92_FOREIGN_KEY_UPDATE_RULE - Support all ON UPDATE options + 158 => 0, # SQL_SQL92_GRANT - No users; no support for GRANT + 159 => 0, # SQL_SQL92_NUMERIC_VALUE_FUNCTIONS - No support for any of the listed functions + 160 => 1+2+4+512+1024+2048+4096+8192, # SQL_SQL92_PREDICATES - Supports the important comparison operators + 161 => 2+16+64+128, # SQL_SQL92_RELATIONAL_JOIN_OPERATORS - Supports the important ones except RIGHT/FULL OUTER JOINs + 162 => 0, # SQL_SQL92_REVOKE - No users; no support for REVOKE + 163 => 1+2+8, # SQL_SQL92_ROW_VALUE_CONSTRUCTOR - Supports most row value constructors + 164 => 2+4, # SQL_SQL92_STRING_FUNCTIONS - Just UPPER & LOWER (has SUBSTR, but not SUBSTRING and SQL-92's weird TRIM syntax) + 165 => 1+2+4+8, # SQL_SQL92_VALUE_EXPRESSIONS - Supports all SQL-92 value expressions + + 118 => 1, # SQL_SQL_CONFORMANCE - SQL-92 Entry level + 83 => 0, # SQL_STATIC_SENSITIVITY - Cursors would lock the DB, so only old data is visible + 50 => 8+16+256+1024+16384+131072, # SQL_STRING_FUNCTIONS - LTRIM, LENGTH, REPLACE, RTRIM, CHAR, SOUNDEX + 95 => 1+2+4+8+16, # SQL_SUBQUERIES - Supports all of the subquery types + 51 => 4, # SQL_SYSTEM_FUNCTIONS - Only IFNULL + 45 => 'table', # SQL_TABLE_TERM - Tables are called tables + 109 => 0, # SQL_TIMEDATE_ADD_INTERVALS - No support for INTERVAL + 110 => 0, # SQL_TIMEDATE_DIFF_INTERVALS - No support for INTERVAL + 52 => 0x20000+0x40000+0x80000, # SQL_TIMEDATE_FUNCTIONS - Only supports CURRENT_(DATE|TIME|TIMESTAMP) + 46 => 2, # SQL_TXN_CAPABLE - Full transaction support for both DML & DDL + 72 => 1+8, # SQL_TXN_ISOLATION_OPTION - Supports read uncommitted and serializable + 96 => 1+2, # SQL_UNION - Supports UNION and UNION ALL + 47 => '', # SQL_USER_NAME - No users + + 166 => 1, # SQL_STANDARD_CLI_CONFORMANCE - X/Open CLI Version 1.0 + 10000 => 1992, # SQL_XOPEN_CLI_YEAR - Year for V1.0 +); + +sub sql_dbms_ver { + my $dbh = shift; + return $dbh->FETCH('sqlite_version'); +} + +sub sql_data_source_name { + my $dbh = shift; + return "dbi:SQLite:".$dbh->{Name}; +} + +sub sql_data_source_read_only { + my $dbh = shift; + my $flags = $dbh->FETCH('sqlite_open_flags') || 0; + return $dbh->{ReadOnly} || ($flags & DBD::SQLite::OPEN_READONLY()) ? 'Y' : 'N'; +} + +sub sql_database_name { + my $dbh = shift; + my $databases = $dbh->selectall_hashref('PRAGMA database_list', 'seq'); + return $databases->{0}{name}; +} + +sub sql_keywords { + # SQLite keywords minus ODBC keywords + return join ',', (qw< + ABORT AFTER ANALYZE ATTACH AUTOINCREMENT BEFORE CONFLICT DATABASE DETACH EACH EXCLUSIVE + EXPLAIN FAIL GLOB IF IGNORE INDEXED INSTEAD ISNULL LIMIT NOTNULL OFFSET + PLAN PRAGMA QUERY RAISE RECURSIVE REGEXP REINDEX RELEASE RENAME REPLACE ROW + SAVEPOINT TEMP TRIGGER VACUUM VIRTUAL WITHOUT + >); +} + +sub sql_server_name { + my $dbh = shift; + return $dbh->{Name}; +} + +1; + +__END__ diff --git a/CPAN/arch/5.36/DBD/SQLite/VirtualTable.pm b/CPAN/arch/5.36/DBD/SQLite/VirtualTable.pm index f8e054a7077..efcc19b72d9 100644 --- a/CPAN/arch/5.36/DBD/SQLite/VirtualTable.pm +++ b/CPAN/arch/5.36/DBD/SQLite/VirtualTable.pm @@ -5,7 +5,7 @@ use strict; use warnings; use Scalar::Util qw/weaken/; -our $VERSION = '1.58'; +our $VERSION = '1.76'; our @ISA; diff --git a/CPAN/arch/5.36/DBD/SQLite/VirtualTable/PerlData.pm b/CPAN/arch/5.36/DBD/SQLite/VirtualTable/PerlData.pm index 5af9977757c..0e58d7d0dae 100644 --- a/CPAN/arch/5.36/DBD/SQLite/VirtualTable/PerlData.pm +++ b/CPAN/arch/5.36/DBD/SQLite/VirtualTable/PerlData.pm @@ -88,7 +88,7 @@ sub BEST_INDEX { # in FILTER() for deciding which rows match the constraints. my @conditions; my $ix = 0; - foreach my $constraint (grep {$_->{usable}} @$constraints) { + foreach my $constraint (grep {$_->{usable} and exists $SQLOP2PERLOP{ $_->{op} } } @$constraints) { my $col = $constraint->{col}; my ($member, $optype); @@ -389,7 +389,7 @@ time. Here is a way to do it with a virtual table : my @files = ... ; # list of files to inspect # apply the L function to each file - our $file_stats = [ map {($_, stat $_)} @files]; + our $file_stats = [ map { [ $_, stat $_ ] } @files]; # create a temporary virtual table $dbh->do(<<""); diff --git a/CPAN/arch/5.36/aarch64-linux-thread-multi/auto/DBD/SQLite/SQLite.so b/CPAN/arch/5.36/aarch64-linux-thread-multi/auto/DBD/SQLite/SQLite.so index 893d666248f..c73333f80c2 100755 Binary files a/CPAN/arch/5.36/aarch64-linux-thread-multi/auto/DBD/SQLite/SQLite.so and b/CPAN/arch/5.36/aarch64-linux-thread-multi/auto/DBD/SQLite/SQLite.so differ diff --git a/CPAN/arch/5.36/arm-linux-gnueabihf-thread-multi-64int/auto/DBD/SQLite/SQLite.so b/CPAN/arch/5.36/arm-linux-gnueabihf-thread-multi-64int/auto/DBD/SQLite/SQLite.so index 23d05515511..4472fec8cb4 100755 Binary files a/CPAN/arch/5.36/arm-linux-gnueabihf-thread-multi-64int/auto/DBD/SQLite/SQLite.so and b/CPAN/arch/5.36/arm-linux-gnueabihf-thread-multi-64int/auto/DBD/SQLite/SQLite.so differ diff --git a/CPAN/arch/5.36/x86_64-linux-thread-multi/auto/DBD/SQLite/SQLite.so b/CPAN/arch/5.36/x86_64-linux-thread-multi/auto/DBD/SQLite/SQLite.so old mode 100644 new mode 100755 index 91f54fd4ea7..b90357ad143 Binary files a/CPAN/arch/5.36/x86_64-linux-thread-multi/auto/DBD/SQLite/SQLite.so and b/CPAN/arch/5.36/x86_64-linux-thread-multi/auto/DBD/SQLite/SQLite.so differ diff --git a/CPAN/arch/5.38/DBD/SQLite.pm b/CPAN/arch/5.38/DBD/SQLite.pm index a719c10ea75..1032e1dcc70 100644 --- a/CPAN/arch/5.38/DBD/SQLite.pm +++ b/CPAN/arch/5.38/DBD/SQLite.pm @@ -3,10 +3,9 @@ package DBD::SQLite; use 5.006; use strict; use DBI 1.57 (); -use DynaLoader (); +use XSLoader (); -our $VERSION = '1.58'; -our @ISA = 'DynaLoader'; +our $VERSION = '1.76'; # sqlite_version cache (set in the XS bootstrap) our ($sqlite_version, $sqlite_version_number); @@ -14,7 +13,7 @@ our ($sqlite_version, $sqlite_version_number); # not sure if we still need these... our ($err, $errstr); -__PACKAGE__->bootstrap($VERSION); +XSLoader::load('DBD::SQLite', $VERSION); # New or old API? use constant NEWAPI => ($DBI::VERSION >= 1.608); @@ -47,6 +46,8 @@ sub driver { DBD::SQLite::db->install_method('sqlite_set_authorizer'); DBD::SQLite::db->install_method('sqlite_backup_from_file'); DBD::SQLite::db->install_method('sqlite_backup_to_file'); + DBD::SQLite::db->install_method('sqlite_backup_from_dbh'); + DBD::SQLite::db->install_method('sqlite_backup_to_dbh'); DBD::SQLite::db->install_method('sqlite_enable_load_extension'); DBD::SQLite::db->install_method('sqlite_load_extension'); DBD::SQLite::db->install_method('sqlite_register_fts3_perl_tokenizer'); @@ -57,6 +58,11 @@ sub driver { DBD::SQLite::db->install_method('sqlite_db_status', { O => 0x0004 }); DBD::SQLite::st->install_method('sqlite_st_status', { O => 0x0004 }); DBD::SQLite::db->install_method('sqlite_create_module'); + DBD::SQLite::db->install_method('sqlite_limit'); + DBD::SQLite::db->install_method('sqlite_db_config'); + DBD::SQLite::db->install_method('sqlite_get_autocommit'); + DBD::SQLite::db->install_method('sqlite_txn_state'); + DBD::SQLite::db->install_method('sqlite_error_offset'); $methods_are_installed++; } @@ -180,7 +186,7 @@ sub install_collation { # default implementation for sqlite 'REGEXP' infix operator. # Note : args are reversed, i.e. "a REGEXP b" calls REGEXP(b, a) -# (see http://www.sqlite.org/vtab.html#xfindfunction) +# (see https://www.sqlite.org/vtab.html#xfindfunction) sub regexp { use locale; return if !defined $_[0] || !defined $_[1]; @@ -190,6 +196,8 @@ sub regexp { package # hide from PAUSE DBD::SQLite::db; +use DBI qw/:sql_types/; + sub prepare { my $dbh = shift; my $sql = shift; @@ -245,19 +253,26 @@ sub ping { return $dbh->FETCH('Active') ? 1 : 0; } -sub _get_version { - return ( DBD::SQLite::db::FETCH($_[0], 'sqlite_version') ); +sub quote { + my ($self, $value, $data_type) = @_; + return "NULL" unless defined $value; + if (defined $data_type and ( + $data_type == DBI::SQL_BIT || + $data_type == DBI::SQL_BLOB || + $data_type == DBI::SQL_BINARY || + $data_type == DBI::SQL_VARBINARY || + $data_type == DBI::SQL_LONGVARBINARY)) { + return q(X') . unpack('H*', $value) . q('); + } + $value =~ s/'/''/g; + return "'$value'"; } -my %info = ( - 17 => 'SQLite', # SQL_DBMS_NAME - 18 => \&_get_version, # SQL_DBMS_VER - 29 => '"', # SQL_IDENTIFIER_QUOTE_CHAR -); - sub get_info { - my($dbh, $info_type) = @_; - my $v = $info{int($info_type)}; + my ($dbh, $info_type) = @_; + + require DBD::SQLite::GetInfo; + my $v = $DBD::SQLite::GetInfo::info{int($info_type)}; $v = $v->($dbh) if ref $v eq 'CODE'; return $v; } @@ -553,6 +568,15 @@ my @FOREIGN_KEY_INFO_SQL_CLI = qw( UNIQUE_OR_PRIMARY ); +my $DEFERRABLE_RE = qr/ + (?:(?: + on \s+ (?:delete|update) \s+ (?:set \s+ null|set \s+ default|cascade|restrict|no \s+ action) + | + match \s* (?:\S+|".+?(?selectall_arrayref("SELECT name FROM $master_table WHERE type = ?", undef, "table") or return; + my $tables = $dbh->selectall_arrayref("SELECT name, sql FROM $master_table WHERE type = ?", undef, "table") or return; for my $table (@$tables) { my $tbname = $table->[0]; + my $ddl = $table->[1]; + my (@rels, %relid2rels); next if defined $fk_table && $fk_table ne '%' && $fk_table ne $tbname; my $quoted_tbname = $dbh->quote_identifier($tbname); @@ -603,7 +629,17 @@ sub foreign_key_info { next if defined $pk_schema && $pk_schema ne '%' && $pk_schema ne $table_info{$row->{table}}{schema}; - push @fk_info, { + # cribbed from DBIx::Class::Schema::Loader::DBI::SQLite + my $rel = $rels[ $row->{id} ] ||= { + local_columns => [], + remote_columns => undef, + remote_table => $row->{table}, + }; + push @{ $rel->{local_columns} }, $row->{from}; + push @{ $rel->{remote_columns} }, $row->{to} + if defined $row->{to}; + + my $fk_row = { PKTABLE_CAT => undef, PKTABLE_SCHEM => $table_info{$row->{table}}{schema}, PKTABLE_NAME => $row->{table}, @@ -620,6 +656,44 @@ sub foreign_key_info { DEFERRABILITY => undef, UNIQUE_OR_PRIMARY => $table_info{$row->{table}}{columns}{$row->{to}} ? 'PRIMARY' : 'UNIQUE', }; + push @fk_info, $fk_row; + push @{ $relid2rels{$row->{id}} }, $fk_row; # keep so can fixup + } + + # cribbed from DBIx::Class::Schema::Loader::DBI::SQLite + # but with additional parsing of which kind of deferrable + REL: for my $relid (keys %relid2rels) { + my $rel = $rels[$relid]; + my $deferrable = $DBI_code_for_rule{'NOT DEFERRABLE'}; + my $local_cols = '"?' . (join '"? \s* , \s* "?', map quotemeta, @{ $rel->{local_columns} }) . '"?'; + my $remote_cols = '"?' . (join '"? \s* , \s* "?', map quotemeta, @{ $rel->{remote_columns} || [] }) . '"?'; + my ($deferrable_clause) = $ddl =~ / + foreign \s+ key \s* \( \s* $local_cols \s* \) \s* references \s* (?:\S+|".+?(?{local_columns} } == 1) { + my ($local_col) = @{ $rel->{local_columns} }; + my ($remote_col) = @{ $rel->{remote_columns} || [] }; + $remote_col ||= ''; + ($deferrable_clause) = $ddl =~ / + "?\Q$local_col\E"? \s* (?:\w+\s*)* (?: \( \s* \d\+ (?:\s*,\s*\d+)* \s* \) )? \s* + references \s+ (?:\S+|".+?(?{DEFERRABILITY} = $deferrable for @{ $relid2rels{$relid} }; } } } @@ -694,7 +768,7 @@ sub statistics_info { NON_UNIQUE => $row->{unique} ? 0 : 1, INDEX_QUALIFIER => undef, INDEX_NAME => $row->{name}, - TYPE => 'btree', # see http://www.sqlite.org/version3.html esp. "Traditional B-trees are still used for indices" + TYPE => 'btree', # see https://www.sqlite.org/version3.html esp. "Traditional B-trees are still used for indices" ORDINAL_POSITION => $info->{seqno} + 1, COLUMN_NAME => $info->{name}, ASC_OR_DESC => undef, @@ -721,45 +795,68 @@ sub statistics_info { return $sponge_sth; } +my @TypeInfoKeys = qw/ + TYPE_NAME + DATA_TYPE + COLUMN_SIZE + LITERAL_PREFIX + LITERAL_SUFFIX + CREATE_PARAMS + NULLABLE + CASE_SENSITIVE + SEARCHABLE + UNSIGNED_ATTRIBUTE + FIXED_PREC_SCALE + AUTO_UNIQUE_VALUE + LOCAL_TYPE_NAME + MINIMUM_SCALE + MAXIMUM_SCALE + SQL_DATA_TYPE + SQL_DATETIME_SUB + NUM_PREC_RADIX + INTERVAL_PRECISION +/; + +my %TypeInfo = ( + SQL_INTEGER ,=> { + TYPE_NAME => 'INTEGER', + DATA_TYPE => SQL_INTEGER, + NULLABLE => 2, # no for integer primary key, otherwise yes + SEARCHABLE => 3, + }, + SQL_DOUBLE ,=> { + TYPE_NAME => 'REAL', + DATA_TYPE => SQL_DOUBLE, + NULLABLE => 1, + SEARCHABLE => 3, + }, + SQL_VARCHAR ,=> { + TYPE_NAME => 'TEXT', + DATA_TYPE => SQL_VARCHAR, + LITERAL_PREFIX => "'", + LITERAL_SUFFIX => "'", + NULLABLE => 1, + SEARCHABLE => 3, + }, + SQL_BLOB ,=> { + TYPE_NAME => 'BLOB', + DATA_TYPE => SQL_BLOB, + NULLABLE => 1, + SEARCHABLE => 3, + }, + SQL_UNKNOWN_TYPE ,=> { + DATA_TYPE => SQL_UNKNOWN_TYPE, + }, +); + sub type_info_all { - return; # XXX code just copied from DBD::Oracle, not yet thought about -# return [ -# { -# TYPE_NAME => 0, -# DATA_TYPE => 1, -# COLUMN_SIZE => 2, -# LITERAL_PREFIX => 3, -# LITERAL_SUFFIX => 4, -# CREATE_PARAMS => 5, -# NULLABLE => 6, -# CASE_SENSITIVE => 7, -# SEARCHABLE => 8, -# UNSIGNED_ATTRIBUTE => 9, -# FIXED_PREC_SCALE => 10, -# AUTO_UNIQUE_VALUE => 11, -# LOCAL_TYPE_NAME => 12, -# MINIMUM_SCALE => 13, -# MAXIMUM_SCALE => 14, -# SQL_DATA_TYPE => 15, -# SQL_DATETIME_SUB => 16, -# NUM_PREC_RADIX => 17, -# }, -# [ 'CHAR', 1, 255, '\'', '\'', 'max length', 1, 1, 3, -# undef, '0', '0', undef, undef, undef, 1, undef, undef -# ], -# [ 'NUMBER', 3, 38, undef, undef, 'precision,scale', 1, '0', 3, -# '0', '0', '0', undef, '0', 38, 3, undef, 10 -# ], -# [ 'DOUBLE', 8, 15, undef, undef, undef, 1, '0', 3, -# '0', '0', '0', undef, undef, undef, 8, undef, 10 -# ], -# [ 'DATE', 9, 19, '\'', '\'', undef, 1, '0', 3, -# undef, '0', '0', undef, '0', '0', 11, undef, undef -# ], -# [ 'VARCHAR', 12, 1024*1024, '\'', '\'', 'max length', 1, 1, 3, -# undef, '0', '0', undef, undef, undef, 12, undef, undef -# ] -# ]; + my $idx = 0; + + my @info = ({map {$_ => $idx++} @TypeInfoKeys}); + for my $id (sort {$a <=> $b} keys %TypeInfo) { + push @info, [map {$TypeInfo{$id}{$_}} @TypeInfoKeys]; + } + return \@info; } my @COLUMN_INFO = qw( @@ -936,7 +1033,7 @@ DBD::SQLite - Self-contained RDBMS in a DBI Driver =head1 DESCRIPTION SQLite is a public domain file-based relational database engine that -you can find at L. +you can find at L. B is a Perl DBI driver for SQLite, that includes the entire thing in the distribution. @@ -950,7 +1047,7 @@ SQLite supports the following features: =item Implements a large subset of SQL92 -See L for details. +See L for details. =item A complete DB in a single disk file @@ -977,7 +1074,7 @@ are limited by the typeless nature of the SQLite database. =head1 SQLITE VERSION DBD::SQLite is usually compiled with a bundled SQLite library -(SQLite version S<3.22.0> as of this release) for consistency. +(SQLite version S<3.46.1> as of this release) for consistency. However, a different version of SQLite may sometimes be used for some reasons like security, or some new experimental features. @@ -1021,7 +1118,7 @@ If the filename C<$dbfile> is an empty string, then a private, temporary on-disk database will be created. This private database will be automatically deleted as soon as the database connection is closed. -As of 1.41_01, you can pass URI filename (see L) +As of 1.41_01, you can pass URI filename (see L) as well for finer control: my $dbh = DBI->connect("dbi:SQLite:uri=file:$path_to_dbfile?mode=rwc"); @@ -1038,7 +1135,7 @@ You can set sqlite_open_flags (only) when you connect to a database: sqlite_open_flags => SQLITE_OPEN_READONLY, }); -See L for details. +See L for details. As of 1.49_05, you can also make a database read-only by setting C attribute to true (only) when you connect to a database. @@ -1156,7 +1253,7 @@ like this while executing: SELECT bar FROM foo GROUP BY bar HAVING count(*) > "5"; -There are three workarounds for this. +There are four workarounds for this. =over 4 @@ -1182,6 +1279,15 @@ This is somewhat weird, but works anyway. }); $sth->execute(5); +=item Use SQL cast() function + +This is more explicit way to do the above. + + my $sth = $dbh->prepare(q{ + SELECT bar FROM foo GROUP BY bar HAVING count(*) > cast(? as integer); + }); + $sth->execute(5); + =item Set C database handle attribute As of version 1.32_02, you can use C @@ -1230,7 +1336,7 @@ SQLite supports several placeholder expressions, including C and C<:AAAA>. Consult the L and SQLite documentation for details. -L +L Note that a question mark actually means a next unused (numbered) placeholder. You're advised not to use it with other (numbered or @@ -1300,7 +1406,7 @@ in the worst case. See also L section below. =back -See L for more details. +See L for more details. =head2 Foreign Keys @@ -1328,7 +1434,7 @@ SQLite, be prepared, and please do extensive testing to ensure that your applications will continue to work when the foreign keys support is enabled by default. -See L for details. +See L for details. =head2 Transactions @@ -1382,7 +1488,7 @@ automatically begin if you execute another statement. This C mode is independent from the autocommit mode of the internal SQLite library, which always begins by a C -statement, and ends by a C or a . +statement, and ends by a C or a C. =head2 Transaction and Database Locking @@ -1451,9 +1557,22 @@ of the rest (since 1.30_01, and without creating DBI's statement handles internally since 1.47_01). If you do need to use C or C (which I don't recommend in this case, because typically there's no placeholder nor reusable part in a dump), -you can look at << $sth->{sqlite_unprepared_statements} >> to retrieve +you can look at C<< $sth->{sqlite_unprepared_statements} >> to retrieve what's left, though it usually contains nothing but white spaces. +=head2 TYPE statement attribute + +Because of historical reasons, DBD::SQLite's C statement +handle attribute returns an array ref of string values, contrary to +the DBI specification. This value is also less useful for SQLite +users because SQLite uses dynamic type system (that means, +the datatype of a value is associated with the value itself, not +with its container). + +As of version 1.61_02, if you set C +database handle attribute to true, C statement handle +attribute returns an array of integer, as an experiment. + =head2 Performance SQLite is fast, very fast. Matt processed his 72MB log file with it, @@ -1502,34 +1621,74 @@ Your sweet spot probably lies somewhere in between. =item sqlite_version Returns the version of the SQLite library which B is using, -e.g., "2.8.0". Can only be read. +e.g., "3.26.0". Can only be read. + +=item sqlite_string_mode + +SQLite strings are simple arrays of bytes, but Perl strings can store any +arbitrary Unicode code point. Thus, DBD::SQLite has to adopt some method +of translating between those two models. This parameter defines that +translation. + +Accepted values are the following constants: -=item sqlite_unicode +=over + +=item * DBD_SQLITE_STRING_MODE_BYTES: All strings are assumed to +represent bytes. A Perl string that contains any code point above 255 +will trigger an exception. This is appropriate for Latin-1 strings, +binary data, pre-encoded UTF-8 strings, etc. + +=item * DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK: All Perl strings are encoded +to UTF-8 before being given to SQLite. Perl will B to decode SQLite +strings as UTF-8 when giving them to Perl. Should any such string not be +valid UTF-8, a warning is thrown, and the string is left undecoded. -If set to a true value, B will turn the UTF-8 flag on for all -text strings coming out of the database (this feature is currently disabled -for perl < 5.8.5). For more details on the UTF-8 flag see -L. The default is for the UTF-8 flag to be turned off. +This is appropriate for strings that are decoded to characters via, +e.g., L. -Also note that due to some bizarreness in SQLite's type system (see -L), if you want to retain -blob-style behavior for B columns under C<< $dbh->{sqlite_unicode} = 1 ->> (say, to store images in the database), you have to state so +Also note that, due to some bizarreness in SQLite's type system (see +L), if you want to retain +blob-style behavior for B columns under DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK +(say, to store images in the database), you have to state so explicitly using the 3-argument form of L when doing updates: use DBI qw(:sql_types); - $dbh->{sqlite_unicode} = 1; + use DBD::SQLite::Constants ':dbd_sqlite_string_mode'; + $dbh->{sqlite_string_mode} = DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK; my $sth = $dbh->prepare("INSERT INTO mytable (blobcolumn) VALUES (?)"); - + # Binary_data will be stored as is. $sth->bind_param(1, $binary_data, SQL_BLOB); Defining the column type as C in the DDL is B sufficient. -This attribute was originally named as C, and renamed to -C for integrity since version 1.26_06. Old C -attribute is still accessible but will be deprecated in the near future. +=item * DBD_SQLITE_STRING_MODE_UNICODE_STRICT: Like +DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK but usually throws an exception +rather than a warning if SQLite sends invalid UTF-8. (In Perl callbacks +from SQLite we still warn instead.) + +=item * DBD_SQLITE_STRING_MODE_UNICODE_NAIVE: Like +DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK but uses a "naïve" UTF-8 decoding +method that forgoes validation. This is marginally faster than a validated +decode, but it can also B B B + +=item * DBD_SQLITE_STRING_MODE_PV (default, but B B B): Like +DBD_SQLITE_STRING_MODE_BYTES, but when translating Perl strings to SQLite +the Perl string's internal byte buffer is given to SQLite. B B +B, but it's been the default for many years, and changing that would +break existing applications. + +=back + +=item C or C (deprecated) + +If truthy, equivalent to setting C to +DBD_SQLITE_STRING_MODE_UNICODE_NAIVE; if falsy, equivalent to +DBD_SQLITE_STRING_MODE_PV. + +Prefer C in all new code. =item sqlite_allow_multiple_statements @@ -1556,7 +1715,12 @@ for details. =item sqlite_extended_result_codes If set to true, DBD::SQLite uses extended result codes where appropriate -(see L). +(see L). + +=item sqlite_defensive + +If set to true, language features that allow ordinary SQL to deliberately +corrupt the database file are prohibited. =back @@ -1585,7 +1749,8 @@ Returns all tables and schemas (databases) as specified in L. The schema and table arguments will do a C search. You can specify an ESCAPE character by including an 'Escape' attribute in \%attr. The C<$type> argument accepts a comma separated list of the following types 'TABLE', -'VIEW', 'LOCAL TEMPORARY' and 'SYSTEM TABLE' (by default all are returned). +'INDEX', 'VIEW', 'TRIGGER', 'LOCAL TEMPORARY' and 'SYSTEM TABLE' +(by default all are returned). Note that a statement handle is returned, and not a direct list of tables. The following fields are returned: @@ -1598,8 +1763,8 @@ databases will be in the name given when the database was attached. B: The name of the table or view. -B: The type of object returned. Will be one of 'TABLE', 'VIEW', -'LOCAL TEMPORARY' or 'SYSTEM TABLE'. +B: The type of object returned. Will be one of 'TABLE', 'INDEX', +'VIEW', 'TRIGGER', 'LOCAL TEMPORARY' or 'SYSTEM TABLE'. =head2 primary_key, primary_key_info @@ -1665,10 +1830,12 @@ B: The referential action for the DELETE rule. The codes are the same as for UPDATE_RULE. -Unfortunately, the B field is always C; -as a matter of fact, deferrability clauses are supported by SQLite, -but they can't be reported because the C -tells nothing about them. +B: +The following codes are defined: + + INITIALLY DEFERRED 5 + INITIALLY IMMEDIATE 6 + NOT DEFERRABLE 7 B: Whether the column is primary or unique. @@ -1728,7 +1895,7 @@ returns true if the database file exists (or the database is in-memory), and the The following methods can be called via the func() method with a little tweak, but the use of func() method is now discouraged by the L author for various reasons (see DBI's document -L +L for details). So, if you're using L >= 1.608, use these C methods. If you need to use an older L, you can call these like this: @@ -1755,7 +1922,8 @@ C<$dbh-Esqlite_last_insert_rowid()> directly. =head2 $dbh->sqlite_db_filename() -Retrieve the current (main) database filename. If the database is in-memory or temporary, this returns C. +Retrieve the current (main) database filename. If the database is in-memory +or temporary, this returns an empty string, or C. =head2 $dbh->sqlite_busy_timeout() @@ -1801,6 +1969,13 @@ After this, it could be used from SQL as: INSERT INTO mytable ( now() ); +The function should return a scalar value, and the value is treated as a text +(or a number if appropriate) by default. If you do need to specify a type +of the return value (like BLOB), you can return a reference to an array that +contains the value and the type, as of 1.65_01. + + $dbh->sqlite_create_function( 'md5', 1, sub { return [md5($_[0]), SQL_BLOB] } ); + =head3 REGEXP function SQLite includes syntactic support for an infix operator 'REGEXP', but @@ -2105,18 +2280,39 @@ special :memory: database, and you wish to populate it from an existing DB. This method accesses the SQLite Online Backup API, and will take a backup of the currently connected database, and write it out to the named file. +=head2 $dbh->sqlite_backup_from_dbh( $another_dbh ) + +This method accesses the SQLite Online Backup API, and will take a backup of +the database for the passed handle, copying it to, and overwriting, your current database +connection. This can be particularly handy if your current connection is to the +special :memory: database, and you wish to populate it from an existing DB. +You can use this to backup from an in-memory database to another in-memory database. + +=head2 $dbh->sqlite_backup_to_dbh( $another_dbh ) + +This method accesses the SQLite Online Backup API, and will take a backup of +the currently connected database, and write it out to the passed database handle. + =head2 $dbh->sqlite_enable_load_extension( $bool ) Calling this method with a true value enables loading (external) SQLite3 extensions. After the call, you can load extensions like this: $dbh->sqlite_enable_load_extension(1); - $sth = $dbh->prepare("select load_extension('libsqlitefunctions.so')") + $sth = $dbh->prepare("select load_extension('libmemvfs.so')") or die "Cannot prepare: " . $dbh->errstr(); =head2 $dbh->sqlite_load_extension( $file, $proc ) -Loading an extension by a select statement (with the "load_extension" SQLite3 function like above) has some limitations. If you need to, say, create other functions from an extension, use this method. $file (a path to the extension) is mandatory, and $proc (an entry point name) is optional. You need to call C before calling C. +Loading an extension by a select statement (with the "load_extension" SQLite3 function like above) has some limitations. If the extension you want to use creates other functions that are not native to SQLite, use this method instead. $file (a path to the extension) is mandatory, and $proc (an entry point name) is optional. You need to call C before calling C: + + $dbh->sqlite_enable_load_extension(1); + $dbh->sqlite_load_extension('libsqlitefunctions.so') + or die "Cannot load extension: " . $dbh->errstr(); + +If the extension uses SQLite mutex functions like C, then +the extension should be compiled with the same C compile-time +setting as this module, see C. =head2 $dbh->sqlite_trace( $code_ref ) @@ -2177,17 +2373,38 @@ is for internal use only. =head2 $dbh->sqlite_db_status() -Returns a hash reference that holds a set of status information of database connection such as cache usage. See L for details. You may also pass 0 as an argument to reset the status. +Returns a hash reference that holds a set of status information of database connection such as cache usage. See L for details. You may also pass 0 as an argument to reset the status. =head2 $sth->sqlite_st_status() -Returns a hash reference that holds a set of status information of SQLite statement handle such as full table scan count. See L for details. Statement status only holds the current value. +Returns a hash reference that holds a set of status information of SQLite statement handle such as full table scan count. See L for details. Statement status only holds the current value. my $status = $sth->sqlite_st_status(); my $cur = $status->{fullscan_step}; You may also pass 0 as an argument to reset the status. +=head2 $dbh->sqlite_db_config( $id, $new_integer_value ) + +You can change how the connected database should behave like this: + + use DBD::SQLite::Constants qw/:database_connection_configuration_options/; + + my $dbh = DBI->connect('dbi:SQLite::memory:'); + + # This disables language features that allow ordinary SQL + # to deliberately corrupt the database file + $dbh->sqlite_db_config( SQLITE_DBCONFIG_DEFENSIVE, 1 ); + + # This disables two-arg version of fts3_tokenizer. + $dbh->sqlite_db_config( SQLITE_DBCONFIG_ENABLE_FTS3_TOKENIZER, 0 ); + +C returns the new value after the call. If you just want to know the current value without changing anything, pass a negative integer value. + + my $current_value = $dbh->sqlite_db_config( SQLITE_DBCONFIG_DEFENSIVE, -1 ); + +As of this writing, C only supports options that set an integer value. C and C are not supported. See also C for details. + =head2 $dbh->sqlite_create_module() Registers a name for a I. Module names must be @@ -2195,6 +2412,33 @@ registered before creating a new virtual table using the module and before using a preexisting virtual table for the module. Virtual tables are explained in L. +=head2 $dbh->sqlite_limit( $category_id, $new_value ) + +Sets a new run-time limit for the category, and returns the current limit. +If the new value is a negative number (or omitted), the limit is unchanged +and just returns the current limit. Category ids (SQLITE_LIMIT_LENGTH, +SQLITE_LIMIT_VARIABLE_NUMBER, etc) can be imported from DBD::SQLite::Constants. + +=head2 $dbh->sqlite_get_autocommit() + +Returns true if the internal SQLite connection is in an autocommit mode. +This does not always return the same value as C<< $dbh->{AutoCommit} >>. +This returns false if you explicitly issue a C<> statement. + +=head2 $dbh->sqlite_txn_state() + +Returns the internal transaction status of SQLite (not of DBI). +Return values (SQLITE_TXN_NONE, SQLITE_TXN_READ, SQLITE_TXN_WRITE) +can be imported from DBD::SQLite::Constants. You may pass an optional +schema name (usually "main"). If SQLite does not support this function, +or if you pass a wrong schema name, -1 is returned. + +=head2 $dbh->sqlite_error_offset() + +Returns the byte offset of the start of a problematic input SQL token +or -1 if the most recent error does not reference a specific token in +the input SQL (or DBD::SQLite is built with an older version of SQLite). + =head1 DRIVER FUNCTIONS =head2 DBD::SQLite::compile_options() @@ -2205,7 +2449,7 @@ library is old or compiled with SQLITE_OMIT_COMPILEOPTION_DIAGS. =head2 DBD::SQLite::sqlite_status() -Returns a hash reference that holds a set of status information of SQLite runtime such as memory usage or page cache usage (see L for details). Each of the entry contains the current value and the highwater value. +Returns a hash reference that holds a set of status information of SQLite runtime such as memory usage or page cache usage (see L for details). Each of the entry contains the current value and the highwater value. my $status = DBD::SQLite::sqlite_status(); my $cur = $status->{memory_used}{current}; @@ -2239,7 +2483,7 @@ DELETE operation would be written as follows : The list of constants implemented in C is given below; more information can be found ad -at L. +at L. =head2 Authorizer Return Codes @@ -2299,7 +2543,7 @@ associated strings. SQLite v3 provides the ability for users to supply arbitrary comparison functions, known as user-defined "collation sequences" or "collating functions", to be used for comparing two text values. -L +L explains how collations are used in various SQL expressions. =head2 Builtin collation sequences @@ -2357,18 +2601,17 @@ or =head2 Unicode handling -If the attribute C<< $dbh->{sqlite_unicode} >> is set, strings coming from -the database and passed to the collation function will be properly -tagged with the utf8 flag; but this only works if the -C attribute is set B the first call to -a perl collation sequence . The recommended way to activate unicode -is to set the parameter at connection time : +Depending on the C<< $dbh->{sqlite_string_mode} >> value, strings coming +from the database and passed to the collation function may be decoded as +UTF-8. This only works, though, if the C attribute is +set B the first call to a perl collation sequence. The recommended +way to activate unicode is to set C at connection time: my $dbh = DBI->connect( "dbi:SQLite:dbname=foo", "", "", { - RaiseError => 1, - sqlite_unicode => 1, + RaiseError => 1, + sqlite_string_mode => DBD_SQLITE_STRING_MODE_UNICODE_STRICT, } ); @@ -2390,7 +2633,7 @@ characters : use DBD::SQLite; $DBD::SQLite::COLLATION{no_accents} = sub { my ( $a, $b ) = map lc, @_; - tr[] + tr[àâáäåãçðèêéëìîíïñòôóöõøùûúüý] [aaaaaacdeeeeiiiinoooooouuuuy] for $a, $b; $a cmp $b; }; @@ -2463,7 +2706,7 @@ then query which buildings overlap or are contained within a specified region: $minLong, $maxLong, $minLat, $maxLat); For more detail, please see the SQLite R-Tree page -(L). Note that custom R-Tree +(L). Note that custom R-Tree queries using callbacks, as mentioned in the prior link, have not been implemented yet. @@ -2547,13 +2790,17 @@ Reading/writing into blobs using C / C. =head2 Support for custom callbacks for R-Tree queries Custom queries of a R-Tree index using a callback are possible with -the SQLite C API (L), so one could +the SQLite C API (L), so one could potentially use a callback that narrowed the result set down based on a specific need, such as querying for overlapping circles. =head1 SUPPORT -Bugs should be reported via the CPAN bug tracker at +Bugs should be reported to GitHub issues: + +L + +or via RT if you prefer: L diff --git a/CPAN/arch/5.38/DBD/SQLite/Constants.pm b/CPAN/arch/5.38/DBD/SQLite/Constants.pm index a9f55dcab90..5be8f0aa4bd 100644 --- a/CPAN/arch/5.38/DBD/SQLite/Constants.pm +++ b/CPAN/arch/5.38/DBD/SQLite/Constants.pm @@ -8,6 +8,18 @@ use warnings; use base 'Exporter'; use DBD::SQLite; our @EXPORT_OK = ( + 'DBD_SQLITE_STRING_MODE_PV', + 'DBD_SQLITE_STRING_MODE_BYTES', + 'DBD_SQLITE_STRING_MODE_UNICODE_NAIVE', + 'DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK', + 'DBD_SQLITE_STRING_MODE_UNICODE_STRICT', + # allowed_return_values_from_sqlite3_txn_state + qw/ + SQLITE_TXN_NONE + SQLITE_TXN_READ + SQLITE_TXN_WRITE + /, + # authorizer_action_codes qw/ SQLITE_ALTER_TABLE @@ -57,27 +69,62 @@ our @EXPORT_OK = ( SQLITE_VERSION_NUMBER /, + # database_connection_configuration_options + qw/ + SQLITE_DBCONFIG_DEFENSIVE + SQLITE_DBCONFIG_DQS_DDL + SQLITE_DBCONFIG_DQS_DML + SQLITE_DBCONFIG_ENABLE_FKEY + SQLITE_DBCONFIG_ENABLE_FTS3_TOKENIZER + SQLITE_DBCONFIG_ENABLE_LOAD_EXTENSION + SQLITE_DBCONFIG_ENABLE_QPSG + SQLITE_DBCONFIG_ENABLE_TRIGGER + SQLITE_DBCONFIG_ENABLE_VIEW + SQLITE_DBCONFIG_LEGACY_ALTER_TABLE + SQLITE_DBCONFIG_LEGACY_FILE_FORMAT + SQLITE_DBCONFIG_LOOKASIDE + SQLITE_DBCONFIG_MAINDBNAME + SQLITE_DBCONFIG_MAX + SQLITE_DBCONFIG_NO_CKPT_ON_CLOSE + SQLITE_DBCONFIG_RESET_DATABASE + SQLITE_DBCONFIG_REVERSE_SCANORDER + SQLITE_DBCONFIG_STMT_SCANSTATUS + SQLITE_DBCONFIG_TRIGGER_EQP + SQLITE_DBCONFIG_TRUSTED_SCHEMA + SQLITE_DBCONFIG_WRITABLE_SCHEMA + /, + # extended_result_codes qw/ SQLITE_ABORT_ROLLBACK SQLITE_AUTH_USER SQLITE_BUSY_RECOVERY SQLITE_BUSY_SNAPSHOT + SQLITE_BUSY_TIMEOUT SQLITE_CANTOPEN_CONVPATH + SQLITE_CANTOPEN_DIRTYWAL SQLITE_CANTOPEN_FULLPATH SQLITE_CANTOPEN_ISDIR SQLITE_CANTOPEN_NOTEMPDIR + SQLITE_CANTOPEN_SYMLINK SQLITE_CONSTRAINT_CHECK SQLITE_CONSTRAINT_COMMITHOOK + SQLITE_CONSTRAINT_DATATYPE SQLITE_CONSTRAINT_FOREIGNKEY SQLITE_CONSTRAINT_FUNCTION SQLITE_CONSTRAINT_NOTNULL + SQLITE_CONSTRAINT_PINNED SQLITE_CONSTRAINT_PRIMARYKEY SQLITE_CONSTRAINT_ROWID SQLITE_CONSTRAINT_TRIGGER SQLITE_CONSTRAINT_UNIQUE SQLITE_CONSTRAINT_VTAB + SQLITE_CORRUPT_INDEX + SQLITE_CORRUPT_SEQUENCE SQLITE_CORRUPT_VTAB + SQLITE_ERROR_MISSING_COLLSEQ + SQLITE_ERROR_RETRY + SQLITE_ERROR_SNAPSHOT SQLITE_IOERR_ACCESS SQLITE_IOERR_AUTH SQLITE_IOERR_BEGIN_ATOMIC @@ -86,6 +133,8 @@ our @EXPORT_OK = ( SQLITE_IOERR_CLOSE SQLITE_IOERR_COMMIT_ATOMIC SQLITE_IOERR_CONVPATH + SQLITE_IOERR_CORRUPTFS + SQLITE_IOERR_DATA SQLITE_IOERR_DELETE SQLITE_IOERR_DELETE_NOENT SQLITE_IOERR_DIR_CLOSE @@ -93,6 +142,7 @@ our @EXPORT_OK = ( SQLITE_IOERR_FSTAT SQLITE_IOERR_FSYNC SQLITE_IOERR_GETTEMPPATH + SQLITE_IOERR_IN_PAGE SQLITE_IOERR_LOCK SQLITE_IOERR_MMAP SQLITE_IOERR_NOMEM @@ -110,10 +160,15 @@ our @EXPORT_OK = ( SQLITE_IOERR_VNODE SQLITE_IOERR_WRITE SQLITE_LOCKED_SHAREDCACHE + SQLITE_LOCKED_VTAB + SQLITE_NOTICE_RBU SQLITE_NOTICE_RECOVER_ROLLBACK SQLITE_NOTICE_RECOVER_WAL + SQLITE_OK_SYMLINK + SQLITE_READONLY_CANTINIT SQLITE_READONLY_CANTLOCK SQLITE_READONLY_DBMOVED + SQLITE_READONLY_DIRECTORY SQLITE_READONLY_RECOVERY SQLITE_READONLY_ROLLBACK SQLITE_WARNING_AUTOINDEX @@ -122,19 +177,26 @@ our @EXPORT_OK = ( # flags_for_file_open_operations qw/ SQLITE_OPEN_CREATE + SQLITE_OPEN_EXRESCODE SQLITE_OPEN_FULLMUTEX SQLITE_OPEN_MEMORY + SQLITE_OPEN_NOFOLLOW SQLITE_OPEN_NOMUTEX SQLITE_OPEN_PRIVATECACHE SQLITE_OPEN_READONLY SQLITE_OPEN_READWRITE SQLITE_OPEN_SHAREDCACHE + SQLITE_OPEN_SUPER_JOURNAL SQLITE_OPEN_URI /, # function_flags qw/ SQLITE_DETERMINISTIC + SQLITE_DIRECTONLY + SQLITE_INNOCUOUS + SQLITE_RESULT_SUBTYPE + SQLITE_SUBTYPE /, # fundamental_datatypes @@ -143,6 +205,7 @@ our @EXPORT_OK = ( SQLITE_FLOAT SQLITE_INTEGER SQLITE_NULL + SQLITE_TEXT /, # result_codes @@ -180,6 +243,22 @@ our @EXPORT_OK = ( SQLITE_WARNING /, + # run_time_limit_categories + qw/ + SQLITE_LIMIT_ATTACHED + SQLITE_LIMIT_COLUMN + SQLITE_LIMIT_COMPOUND_SELECT + SQLITE_LIMIT_EXPR_DEPTH + SQLITE_LIMIT_FUNCTION_ARG + SQLITE_LIMIT_LENGTH + SQLITE_LIMIT_LIKE_PATTERN_LENGTH + SQLITE_LIMIT_SQL_LENGTH + SQLITE_LIMIT_TRIGGER_DEPTH + SQLITE_LIMIT_VARIABLE_NUMBER + SQLITE_LIMIT_VDBE_OP + SQLITE_LIMIT_WORKER_THREADS + /, + ); our %EXPORT_TAGS = ( @@ -195,17 +274,22 @@ our %EXPORT_TAGS = ( SQLITE_BUSY SQLITE_BUSY_RECOVERY SQLITE_BUSY_SNAPSHOT + SQLITE_BUSY_TIMEOUT SQLITE_CANTOPEN SQLITE_CANTOPEN_CONVPATH + SQLITE_CANTOPEN_DIRTYWAL SQLITE_CANTOPEN_FULLPATH SQLITE_CANTOPEN_ISDIR SQLITE_CANTOPEN_NOTEMPDIR + SQLITE_CANTOPEN_SYMLINK SQLITE_CONSTRAINT SQLITE_CONSTRAINT_CHECK SQLITE_CONSTRAINT_COMMITHOOK + SQLITE_CONSTRAINT_DATATYPE SQLITE_CONSTRAINT_FOREIGNKEY SQLITE_CONSTRAINT_FUNCTION SQLITE_CONSTRAINT_NOTNULL + SQLITE_CONSTRAINT_PINNED SQLITE_CONSTRAINT_PRIMARYKEY SQLITE_CONSTRAINT_ROWID SQLITE_CONSTRAINT_TRIGGER @@ -213,6 +297,8 @@ our %EXPORT_TAGS = ( SQLITE_CONSTRAINT_VTAB SQLITE_COPY SQLITE_CORRUPT + SQLITE_CORRUPT_INDEX + SQLITE_CORRUPT_SEQUENCE SQLITE_CORRUPT_VTAB SQLITE_CREATE_INDEX SQLITE_CREATE_TABLE @@ -223,10 +309,37 @@ our %EXPORT_TAGS = ( SQLITE_CREATE_TRIGGER SQLITE_CREATE_VIEW SQLITE_CREATE_VTABLE + SQLITE_DBCONFIG_DEFENSIVE + SQLITE_DBCONFIG_DQS_DDL + SQLITE_DBCONFIG_DQS_DML + SQLITE_DBCONFIG_ENABLE_FKEY + SQLITE_DBCONFIG_ENABLE_FTS3_TOKENIZER + SQLITE_DBCONFIG_ENABLE_LOAD_EXTENSION + SQLITE_DBCONFIG_ENABLE_QPSG + SQLITE_DBCONFIG_ENABLE_TRIGGER + SQLITE_DBCONFIG_ENABLE_VIEW + SQLITE_DBCONFIG_LEGACY_ALTER_TABLE + SQLITE_DBCONFIG_LEGACY_FILE_FORMAT + SQLITE_DBCONFIG_LOOKASIDE + SQLITE_DBCONFIG_MAINDBNAME + SQLITE_DBCONFIG_MAX + SQLITE_DBCONFIG_NO_CKPT_ON_CLOSE + SQLITE_DBCONFIG_RESET_DATABASE + SQLITE_DBCONFIG_REVERSE_SCANORDER + SQLITE_DBCONFIG_STMT_SCANSTATUS + SQLITE_DBCONFIG_TRIGGER_EQP + SQLITE_DBCONFIG_TRUSTED_SCHEMA + SQLITE_DBCONFIG_WRITABLE_SCHEMA + DBD_SQLITE_STRING_MODE_BYTES + DBD_SQLITE_STRING_MODE_PV + DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK + DBD_SQLITE_STRING_MODE_UNICODE_NAIVE + DBD_SQLITE_STRING_MODE_UNICODE_STRICT SQLITE_DELETE SQLITE_DENY SQLITE_DETACH SQLITE_DETERMINISTIC + SQLITE_DIRECTONLY SQLITE_DONE SQLITE_DROP_INDEX SQLITE_DROP_TABLE @@ -239,11 +352,15 @@ our %EXPORT_TAGS = ( SQLITE_DROP_VTABLE SQLITE_EMPTY SQLITE_ERROR + SQLITE_ERROR_MISSING_COLLSEQ + SQLITE_ERROR_RETRY + SQLITE_ERROR_SNAPSHOT SQLITE_FLOAT SQLITE_FORMAT SQLITE_FULL SQLITE_FUNCTION SQLITE_IGNORE + SQLITE_INNOCUOUS SQLITE_INSERT SQLITE_INTEGER SQLITE_INTERNAL @@ -257,6 +374,8 @@ our %EXPORT_TAGS = ( SQLITE_IOERR_CLOSE SQLITE_IOERR_COMMIT_ATOMIC SQLITE_IOERR_CONVPATH + SQLITE_IOERR_CORRUPTFS + SQLITE_IOERR_DATA SQLITE_IOERR_DELETE SQLITE_IOERR_DELETE_NOENT SQLITE_IOERR_DIR_CLOSE @@ -264,6 +383,7 @@ our %EXPORT_TAGS = ( SQLITE_IOERR_FSTAT SQLITE_IOERR_FSYNC SQLITE_IOERR_GETTEMPPATH + SQLITE_IOERR_IN_PAGE SQLITE_IOERR_LOCK SQLITE_IOERR_MMAP SQLITE_IOERR_NOMEM @@ -280,8 +400,21 @@ our %EXPORT_TAGS = ( SQLITE_IOERR_UNLOCK SQLITE_IOERR_VNODE SQLITE_IOERR_WRITE + SQLITE_LIMIT_ATTACHED + SQLITE_LIMIT_COLUMN + SQLITE_LIMIT_COMPOUND_SELECT + SQLITE_LIMIT_EXPR_DEPTH + SQLITE_LIMIT_FUNCTION_ARG + SQLITE_LIMIT_LENGTH + SQLITE_LIMIT_LIKE_PATTERN_LENGTH + SQLITE_LIMIT_SQL_LENGTH + SQLITE_LIMIT_TRIGGER_DEPTH + SQLITE_LIMIT_VARIABLE_NUMBER + SQLITE_LIMIT_VDBE_OP + SQLITE_LIMIT_WORKER_THREADS SQLITE_LOCKED SQLITE_LOCKED_SHAREDCACHE + SQLITE_LOCKED_VTAB SQLITE_MISMATCH SQLITE_MISUSE SQLITE_NOLFS @@ -289,18 +422,23 @@ our %EXPORT_TAGS = ( SQLITE_NOTADB SQLITE_NOTFOUND SQLITE_NOTICE + SQLITE_NOTICE_RBU SQLITE_NOTICE_RECOVER_ROLLBACK SQLITE_NOTICE_RECOVER_WAL SQLITE_NULL SQLITE_OK + SQLITE_OK_SYMLINK SQLITE_OPEN_CREATE + SQLITE_OPEN_EXRESCODE SQLITE_OPEN_FULLMUTEX SQLITE_OPEN_MEMORY + SQLITE_OPEN_NOFOLLOW SQLITE_OPEN_NOMUTEX SQLITE_OPEN_PRIVATECACHE SQLITE_OPEN_READONLY SQLITE_OPEN_READWRITE SQLITE_OPEN_SHAREDCACHE + SQLITE_OPEN_SUPER_JOURNAL SQLITE_OPEN_URI SQLITE_PERM SQLITE_PRAGMA @@ -308,24 +446,38 @@ our %EXPORT_TAGS = ( SQLITE_RANGE SQLITE_READ SQLITE_READONLY + SQLITE_READONLY_CANTINIT SQLITE_READONLY_CANTLOCK SQLITE_READONLY_DBMOVED + SQLITE_READONLY_DIRECTORY SQLITE_READONLY_RECOVERY SQLITE_READONLY_ROLLBACK SQLITE_RECURSIVE SQLITE_REINDEX + SQLITE_RESULT_SUBTYPE SQLITE_ROW SQLITE_SAVEPOINT SQLITE_SCHEMA SQLITE_SELECT + SQLITE_SUBTYPE + SQLITE_TEXT SQLITE_TOOBIG SQLITE_TRANSACTION + SQLITE_TXN_NONE + SQLITE_TXN_READ + SQLITE_TXN_WRITE SQLITE_UPDATE SQLITE_VERSION_NUMBER SQLITE_WARNING SQLITE_WARNING_AUTOINDEX /], + allowed_return_values_from_sqlite3_txn_state => [qw/ + SQLITE_TXN_NONE + SQLITE_TXN_READ + SQLITE_TXN_WRITE + /], + authorizer_action_codes => [qw/ SQLITE_ALTER_TABLE SQLITE_ANALYZE @@ -372,26 +524,68 @@ our %EXPORT_TAGS = ( SQLITE_VERSION_NUMBER /], + database_connection_configuration_options => [qw/ + SQLITE_DBCONFIG_DEFENSIVE + SQLITE_DBCONFIG_DQS_DDL + SQLITE_DBCONFIG_DQS_DML + SQLITE_DBCONFIG_ENABLE_FKEY + SQLITE_DBCONFIG_ENABLE_FTS3_TOKENIZER + SQLITE_DBCONFIG_ENABLE_LOAD_EXTENSION + SQLITE_DBCONFIG_ENABLE_QPSG + SQLITE_DBCONFIG_ENABLE_TRIGGER + SQLITE_DBCONFIG_ENABLE_VIEW + SQLITE_DBCONFIG_LEGACY_ALTER_TABLE + SQLITE_DBCONFIG_LEGACY_FILE_FORMAT + SQLITE_DBCONFIG_LOOKASIDE + SQLITE_DBCONFIG_MAINDBNAME + SQLITE_DBCONFIG_MAX + SQLITE_DBCONFIG_NO_CKPT_ON_CLOSE + SQLITE_DBCONFIG_RESET_DATABASE + SQLITE_DBCONFIG_REVERSE_SCANORDER + SQLITE_DBCONFIG_STMT_SCANSTATUS + SQLITE_DBCONFIG_TRIGGER_EQP + SQLITE_DBCONFIG_TRUSTED_SCHEMA + SQLITE_DBCONFIG_WRITABLE_SCHEMA + /], + + dbd_sqlite_string_mode => [qw/ + DBD_SQLITE_STRING_MODE_BYTES + DBD_SQLITE_STRING_MODE_PV + DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK + DBD_SQLITE_STRING_MODE_UNICODE_NAIVE + DBD_SQLITE_STRING_MODE_UNICODE_STRICT + /], + extended_result_codes => [qw/ SQLITE_ABORT_ROLLBACK SQLITE_AUTH_USER SQLITE_BUSY_RECOVERY SQLITE_BUSY_SNAPSHOT + SQLITE_BUSY_TIMEOUT SQLITE_CANTOPEN_CONVPATH + SQLITE_CANTOPEN_DIRTYWAL SQLITE_CANTOPEN_FULLPATH SQLITE_CANTOPEN_ISDIR SQLITE_CANTOPEN_NOTEMPDIR + SQLITE_CANTOPEN_SYMLINK SQLITE_CONSTRAINT_CHECK SQLITE_CONSTRAINT_COMMITHOOK + SQLITE_CONSTRAINT_DATATYPE SQLITE_CONSTRAINT_FOREIGNKEY SQLITE_CONSTRAINT_FUNCTION SQLITE_CONSTRAINT_NOTNULL + SQLITE_CONSTRAINT_PINNED SQLITE_CONSTRAINT_PRIMARYKEY SQLITE_CONSTRAINT_ROWID SQLITE_CONSTRAINT_TRIGGER SQLITE_CONSTRAINT_UNIQUE SQLITE_CONSTRAINT_VTAB + SQLITE_CORRUPT_INDEX + SQLITE_CORRUPT_SEQUENCE SQLITE_CORRUPT_VTAB + SQLITE_ERROR_MISSING_COLLSEQ + SQLITE_ERROR_RETRY + SQLITE_ERROR_SNAPSHOT SQLITE_IOERR_ACCESS SQLITE_IOERR_AUTH SQLITE_IOERR_BEGIN_ATOMIC @@ -400,6 +594,8 @@ our %EXPORT_TAGS = ( SQLITE_IOERR_CLOSE SQLITE_IOERR_COMMIT_ATOMIC SQLITE_IOERR_CONVPATH + SQLITE_IOERR_CORRUPTFS + SQLITE_IOERR_DATA SQLITE_IOERR_DELETE SQLITE_IOERR_DELETE_NOENT SQLITE_IOERR_DIR_CLOSE @@ -407,6 +603,7 @@ our %EXPORT_TAGS = ( SQLITE_IOERR_FSTAT SQLITE_IOERR_FSYNC SQLITE_IOERR_GETTEMPPATH + SQLITE_IOERR_IN_PAGE SQLITE_IOERR_LOCK SQLITE_IOERR_MMAP SQLITE_IOERR_NOMEM @@ -424,10 +621,15 @@ our %EXPORT_TAGS = ( SQLITE_IOERR_VNODE SQLITE_IOERR_WRITE SQLITE_LOCKED_SHAREDCACHE + SQLITE_LOCKED_VTAB + SQLITE_NOTICE_RBU SQLITE_NOTICE_RECOVER_ROLLBACK SQLITE_NOTICE_RECOVER_WAL + SQLITE_OK_SYMLINK + SQLITE_READONLY_CANTINIT SQLITE_READONLY_CANTLOCK SQLITE_READONLY_DBMOVED + SQLITE_READONLY_DIRECTORY SQLITE_READONLY_RECOVERY SQLITE_READONLY_ROLLBACK SQLITE_WARNING_AUTOINDEX @@ -435,18 +637,25 @@ our %EXPORT_TAGS = ( flags_for_file_open_operations => [qw/ SQLITE_OPEN_CREATE + SQLITE_OPEN_EXRESCODE SQLITE_OPEN_FULLMUTEX SQLITE_OPEN_MEMORY + SQLITE_OPEN_NOFOLLOW SQLITE_OPEN_NOMUTEX SQLITE_OPEN_PRIVATECACHE SQLITE_OPEN_READONLY SQLITE_OPEN_READWRITE SQLITE_OPEN_SHAREDCACHE + SQLITE_OPEN_SUPER_JOURNAL SQLITE_OPEN_URI /], function_flags => [qw/ SQLITE_DETERMINISTIC + SQLITE_DIRECTONLY + SQLITE_INNOCUOUS + SQLITE_RESULT_SUBTYPE + SQLITE_SUBTYPE /], fundamental_datatypes => [qw/ @@ -454,6 +663,7 @@ our %EXPORT_TAGS = ( SQLITE_FLOAT SQLITE_INTEGER SQLITE_NULL + SQLITE_TEXT /], result_codes => [qw/ @@ -490,6 +700,21 @@ our %EXPORT_TAGS = ( SQLITE_WARNING /], + run_time_limit_categories => [qw/ + SQLITE_LIMIT_ATTACHED + SQLITE_LIMIT_COLUMN + SQLITE_LIMIT_COMPOUND_SELECT + SQLITE_LIMIT_EXPR_DEPTH + SQLITE_LIMIT_FUNCTION_ARG + SQLITE_LIMIT_LENGTH + SQLITE_LIMIT_LIKE_PATTERN_LENGTH + SQLITE_LIMIT_SQL_LENGTH + SQLITE_LIMIT_TRIGGER_DEPTH + SQLITE_LIMIT_VARIABLE_NUMBER + SQLITE_LIMIT_VDBE_OP + SQLITE_LIMIT_WORKER_THREADS + /], + ); $EXPORT_TAGS{version} = $EXPORT_TAGS{compile_time_library_version_numbers}; $EXPORT_TAGS{file_open} = $EXPORT_TAGS{flags_for_file_open_operations}; @@ -511,12 +736,24 @@ DBD::SQLite::Constants - common SQLite constants =head1 DESCRIPTION -You can import necessary SQLite constants from this module. Available tags are C, C, C, C (C), C, C (C), C, C (C), C. See L for the complete list of constants. +You can import necessary SQLite constants from this module. Available tags are C, C, C, C, C (C), C, C, C, C (C), C, C (C), C, C. See L for the complete list of constants. This module does not export anything by default. =head1 CONSTANTS +=head2 allowed_return_values_from_sqlite3_txn_state + +=over 4 + +=item SQLITE_TXN_NONE + +=item SQLITE_TXN_READ + +=item SQLITE_TXN_WRITE + +=back + =head2 authorizer_action_codes =over 4 @@ -609,6 +846,70 @@ This module does not export anything by default. =back +=head2 database_connection_configuration_options + +=over 4 + +=item SQLITE_DBCONFIG_LOOKASIDE + +=item SQLITE_DBCONFIG_ENABLE_FKEY + +=item SQLITE_DBCONFIG_ENABLE_TRIGGER + +=item SQLITE_DBCONFIG_ENABLE_FTS3_TOKENIZER + +=item SQLITE_DBCONFIG_ENABLE_LOAD_EXTENSION + +=item SQLITE_DBCONFIG_MAINDBNAME + +=item SQLITE_DBCONFIG_NO_CKPT_ON_CLOSE + +=item SQLITE_DBCONFIG_ENABLE_QPSG + +=item SQLITE_DBCONFIG_TRIGGER_EQP + +=item SQLITE_DBCONFIG_MAX + +=item SQLITE_DBCONFIG_RESET_DATABASE + +=item SQLITE_DBCONFIG_DEFENSIVE + +=item SQLITE_DBCONFIG_WRITABLE_SCHEMA + +=item SQLITE_DBCONFIG_LEGACY_ALTER_TABLE + +=item SQLITE_DBCONFIG_DQS_DML + +=item SQLITE_DBCONFIG_DQS_DDL + +=item SQLITE_DBCONFIG_ENABLE_VIEW + +=item SQLITE_DBCONFIG_LEGACY_FILE_FORMAT + +=item SQLITE_DBCONFIG_TRUSTED_SCHEMA + +=item SQLITE_DBCONFIG_STMT_SCANSTATUS + +=item SQLITE_DBCONFIG_REVERSE_SCANORDER + +=back + +=head2 dbd_sqlite_string_mode + +=over 4 + +=item DBD_SQLITE_STRING_MODE_PV + +=item DBD_SQLITE_STRING_MODE_BYTES + +=item DBD_SQLITE_STRING_MODE_UNICODE_NAIVE + +=item DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK + +=item DBD_SQLITE_STRING_MODE_UNICODE_STRICT + +=back + =head2 extended_result_codes =over 4 @@ -729,6 +1030,42 @@ This module does not export anything by default. =item SQLITE_IOERR_ROLLBACK_ATOMIC +=item SQLITE_ERROR_MISSING_COLLSEQ + +=item SQLITE_ERROR_RETRY + +=item SQLITE_READONLY_CANTINIT + +=item SQLITE_READONLY_DIRECTORY + +=item SQLITE_LOCKED_VTAB + +=item SQLITE_CORRUPT_SEQUENCE + +=item SQLITE_ERROR_SNAPSHOT + +=item SQLITE_CANTOPEN_DIRTYWAL + +=item SQLITE_CANTOPEN_SYMLINK + +=item SQLITE_CONSTRAINT_PINNED + +=item SQLITE_OK_SYMLINK + +=item SQLITE_IOERR_DATA + +=item SQLITE_BUSY_TIMEOUT + +=item SQLITE_CORRUPT_INDEX + +=item SQLITE_IOERR_CORRUPTFS + +=item SQLITE_CONSTRAINT_DATATYPE + +=item SQLITE_NOTICE_RBU + +=item SQLITE_IOERR_IN_PAGE + =back =head2 file_open (flags_for_file_open_operations) @@ -753,6 +1090,12 @@ This module does not export anything by default. =item SQLITE_OPEN_MEMORY +=item SQLITE_OPEN_NOFOLLOW + +=item SQLITE_OPEN_SUPER_JOURNAL + +=item SQLITE_OPEN_EXRESCODE + =back =head2 function_flags @@ -761,6 +1104,14 @@ This module does not export anything by default. =item SQLITE_DETERMINISTIC +=item SQLITE_DIRECTONLY + +=item SQLITE_SUBTYPE + +=item SQLITE_INNOCUOUS + +=item SQLITE_RESULT_SUBTYPE + =back =head2 datatypes (fundamental_datatypes) @@ -775,6 +1126,8 @@ This module does not export anything by default. =item SQLITE_NULL +=item SQLITE_TEXT + =back =head2 result_codes @@ -845,3 +1198,33 @@ This module does not export anything by default. =back +=head2 run_time_limit_categories + +=over 4 + +=item SQLITE_LIMIT_LENGTH + +=item SQLITE_LIMIT_SQL_LENGTH + +=item SQLITE_LIMIT_COLUMN + +=item SQLITE_LIMIT_EXPR_DEPTH + +=item SQLITE_LIMIT_COMPOUND_SELECT + +=item SQLITE_LIMIT_VDBE_OP + +=item SQLITE_LIMIT_FUNCTION_ARG + +=item SQLITE_LIMIT_ATTACHED + +=item SQLITE_LIMIT_LIKE_PATTERN_LENGTH + +=item SQLITE_LIMIT_VARIABLE_NUMBER + +=item SQLITE_LIMIT_TRIGGER_DEPTH + +=item SQLITE_LIMIT_WORKER_THREADS + +=back + diff --git a/CPAN/arch/5.38/DBD/SQLite/GetInfo.pm b/CPAN/arch/5.38/DBD/SQLite/GetInfo.pm new file mode 100644 index 00000000000..083bfa4c02c --- /dev/null +++ b/CPAN/arch/5.38/DBD/SQLite/GetInfo.pm @@ -0,0 +1,288 @@ +package DBD::SQLite::GetInfo; + +use 5.006; +use strict; +use warnings; + +use DBD::SQLite; + +# SQL_DRIVER_VER should be formatted as dd.dd.dddd +my $dbdversion = $DBD::SQLite::VERSION; +$dbdversion .= '_00' if $dbdversion =~ /^\d+\.\d+$/; +my $sql_driver_ver = sprintf("%02d.%02d.%04d", split(/[\._]/, $dbdversion)); + +# Full list of keys and their return types: DBI::Const::GetInfo::ODBC + +# Most of the key definitions can be gleaned from: +# +# https://docs.microsoft.com/en-us/sql/odbc/reference/syntax/sqlgetinfo-function + +our %info = ( + 20 => 'N', # SQL_ACCESSIBLE_PROCEDURES - No stored procedures to access + 19 => 'Y', # SQL_ACCESSIBLE_TABLES - SELECT access to all tables in table_info + 0 => 0, # SQL_ACTIVE_CONNECTIONS - No maximum connection limit + 116 => 0, # SQL_ACTIVE_ENVIRONMENTS - No "active environment" limit + 1 => 0, # SQL_ACTIVE_STATEMENTS - No concurrent activity limit + 169 => 127, # SQL_AGGREGATE_FUNCTIONS - Supports all SQL-92 aggregrate functions + 117 => 0, # SQL_ALTER_DOMAIN - No ALTER DOMAIN support + 86 => 1, # SQL_ALTER_TABLE - Only supports ADD COLUMN and table rename (not listed in enum) in ALTER TABLE statements + 10021 => 0, # SQL_ASYNC_MODE - No asynchronous support (in vanilla SQLite) + 120 => 0, # SQL_BATCH_ROW_COUNT - No special row counting access + 121 => 0, # SQL_BATCH_SUPPORT - No batches + 82 => 0, # SQL_BOOKMARK_PERSISTENCE - No bookmark support + 114 => 1, # SQL_CATALOG_LOCATION - Database comes first in identifiers + 10003 => 'Y', # SQL_CATALOG_NAME - Supports database names + 41 => '.', # SQL_CATALOG_NAME_SEPARATOR - Separated by dot + 42 => 'database', # SQL_CATALOG_TERM - SQLite calls catalogs databases + 92 => 1+4+8, # SQL_CATALOG_USAGE - Supported in calls to DML & table/index definiton (no procedures or permissions) + 10004 => 'UTF-8', # SQL_COLLATION_SEQ - SQLite 3 uses UTF-8 by default + 87 => 'Y', # SQL_COLUMN_ALIAS - Supports column aliases + 22 => 0, # SQL_CONCAT_NULL_BEHAVIOR - 'a'||NULL = NULL + +# SQLite has no CONVERT function, only CAST. However, it converts to every "affinity" it supports. +# +# The only SQL_CVT_* types it doesn't support are date/time types, as it has no concept of +# date/time values once inserted. These are only convertable to text-like types. GUIDs are in +# the same boat, having no real means of switching to a numeric format. +# +# text/binary types = 31723265 +# numeric types = 28926 +# date/time types = 1802240 +# total = 33554431 + + 48 => 1, # SQL_CONVERT_FUNCTIONS - CAST only + + 53 => 31723265+28926, # SQL_CONVERT_BIGINT + 54 => 31723265+28926, # SQL_CONVERT_BINARY + 55 => 31723265+28926, # SQL_CONVERT_BIT + 56 => 33554431, # SQL_CONVERT_CHAR + 57 => 31723265+1802240, # SQL_CONVERT_DATE + 58 => 31723265+28926, # SQL_CONVERT_DECIMAL + 59 => 31723265+28926, # SQL_CONVERT_DOUBLE + 60 => 31723265+28926, # SQL_CONVERT_FLOAT + 173 => 31723265, # SQL_CONVERT_GUID + 61 => 31723265+28926, # SQL_CONVERT_INTEGER + 123 => 31723265+1802240, # SQL_CONVERT_INTERVAL_DAY_TIME + 124 => 31723265+1802240, # SQL_CONVERT_INTERVAL_YEAR_MONTH + 71 => 31723265+28926, # SQL_CONVERT_LONGVARBINARY + 62 => 31723265+28926, # SQL_CONVERT_LONGVARCHAR + 63 => 31723265+28926, # SQL_CONVERT_NUMERIC + 64 => 31723265+28926, # SQL_CONVERT_REAL + 65 => 31723265+28926, # SQL_CONVERT_SMALLINT + 66 => 31723265+1802240, # SQL_CONVERT_TIME + 67 => 31723265+1802240, # SQL_CONVERT_TIMESTAMP + 68 => 31723265+28926, # SQL_CONVERT_TINYINT + 69 => 33554431, # SQL_CONVERT_VARBINARY + 70 => 33554431, # SQL_CONVERT_VARCHAR + 122 => 33554431, # SQL_CONVERT_WCHAR + 125 => 33554431, # SQL_CONVERT_WLONGVARCHAR + 126 => 33554431, # SQL_CONVERT_WVARCHAR + + 74 => 1, # SQL_CORRELATION_NAME - Table aliases are supported, but must be named differently + 127 => 0, # SQL_CREATE_ASSERTION - No CREATE ASSERTION support + 128 => 0, # SQL_CREATE_CHARACTER_SET - No CREATE CHARACTER SET support + 129 => 0, # SQL_CREATE_COLLATION - No CREATE COLLATION support + 130 => 0, # SQL_CREATE_DOMAIN - No CREATE DOMAIN support + 131 => 0, # SQL_CREATE_SCHEMA - No CREATE SCHEMA support + 132 => 16383-2-8-4096, # SQL_CREATE_TABLE - Most of the functionality of CREATE TABLE support + 133 => 0, # SQL_CREATE_TRANSLATION - No CREATE TRANSLATION support + 134 => 1, # SQL_CREATE_VIEW - CREATE VIEW, no WITH CHECK OPTION support + + 23 => 2, # SQL_CURSOR_COMMIT_BEHAVIOR - Cursors are preserved + 24 => 2, # SQL_CURSOR_ROLLBACK_BEHAVIOR - Cursors are preserved + 10001 => 0, # SQL_CURSOR_SENSITIVITY - Cursors have a concept of snapshots, though this depends on the transaction type + + 2 => \&sql_data_source_name, # SQL_DATA_SOURCE_NAME - The DSN + 25 => \&sql_data_source_read_only, # SQL_DATA_SOURCE_READ_ONLY - Might have a SQLITE_OPEN_READONLY flag + 16 => \&sql_database_name, # SQL_DATABASE_NAME - Self-explanatory + 119 => 0, # SQL_DATETIME_LITERALS - No support for SQL-92's super weird date/time literal format (ie: {d '2999-12-12'}) + 17 => 'SQLite', # SQL_DBMS_NAME - You are here + 18 => \&sql_dbms_ver, # SQL_DBMS_VER - This driver version + 170 => 1+2, # SQL_DDL_INDEX - Supports CREATE/DROP INDEX + 26 => 8, # SQL_DEFAULT_TXN_ISOLATION - Default is SERIALIZABLE (See "PRAGMA read_uncommitted") + 10002 => 'N', # SQL_DESCRIBE_PARAMETER - No DESCRIBE INPUT support + +# XXX: MySQL/Oracle fills in HDBC and HENV, but information on what should actually go there is +# hard to acquire. + +# 171 => undef, # SQL_DM_VER - Not a Driver Manager +# 3 => undef, # SQL_DRIVER_HDBC - Not a Driver Manager +# 135 => undef, # SQL_DRIVER_HDESC - Not a Driver Manager +# 4 => undef, # SQL_DRIVER_HENV - Not a Driver Manager +# 76 => undef, # SQL_DRIVER_HLIB - Not a Driver Manager +# 5 => undef, # SQL_DRIVER_HSTMT - Not a Driver Manager + 6 => 'libsqlite3odbc.so', # SQL_DRIVER_NAME - SQLite3 ODBC driver (if installed) + 77 => '03.00', # SQL_DRIVER_ODBC_VER - Same as sqlite3odbc.c + 7 => $sql_driver_ver, # SQL_DRIVER_VER - Self-explanatory + + 136 => 0, # SQL_DROP_ASSERTION - No DROP ASSERTION support + 137 => 0, # SQL_DROP_CHARACTER_SET - No DROP CHARACTER SET support + 138 => 0, # SQL_DROP_COLLATION - No DROP COLLATION support + 139 => 0, # SQL_DROP_DOMAIN - No DROP DOMAIN support + 140 => 0, # SQL_DROP_SCHEMA - No DROP SCHEMA support + 141 => 1, # SQL_DROP_TABLE - DROP TABLE support, no RESTRICT/CASCADE + 142 => 0, # SQL_DROP_TRANSLATION - No DROP TRANSLATION support + 143 => 1, # SQL_DROP_VIEW - DROP VIEW support, no RESTRICT/CASCADE + +# NOTE: This is based purely on what sqlite3odbc supports. +# +# Static CA1: NEXT, ABSOLUTE, RELATIVE, BOOKMARK, LOCK_NO_CHANGE, POSITION, UPDATE, DELETE, REFRESH, +# BULK_ADD, BULK_UPDATE_BY_BOOKMARK, BULK_DELETE_BY_BOOKMARK = 466511 +# +# Forward-only CA1: NEXT, BOOKMARK +# +# CA2: READ_ONLY_CONCURRENCY, LOCK_CONCURRENCY + + 144 => 0, # SQL_DYNAMIC_CURSOR_ATTRIBUTES1 - No dynamic cursor support + 145 => 0, # SQL_DYNAMIC_CURSOR_ATTRIBUTES2 - No dynamic cursor support + 146 => 1+8, # SQL_FORWARD_ONLY_CURSOR_ATTRIBUTES1 + 147 => 1+2, # SQL_FORWARD_ONLY_CURSOR_ATTRIBUTES2 + 150 => 0, # SQL_KEYSET_CURSOR_ATTRIBUTES1 - No keyset cursor support + 151 => 0, # SQL_KEYSET_CURSOR_ATTRIBUTES2 - No keyset cursor support + 167 => 466511, # SQL_STATIC_CURSOR_ATTRIBUTES1 + 168 => 1+2, # SQL_STATIC_CURSOR_ATTRIBUTES2 + + 27 => 'Y', # SQL_EXPRESSIONS_IN_ORDERBY - ORDER BY allows expressions + 8 => 63, # SQL_FETCH_DIRECTION - Cursors support next, first, last, prior, absolute, relative + 84 => 2, # SQL_FILE_USAGE - Single-tier driver, treats files as databases + 81 => 1+2+8, # SQL_GETDATA_EXTENSIONS - Same as sqlite3odbc.c + 88 => 3, # SQL_GROUP_BY - SELECT columns are independent of GROUP BY columns + 28 => 4, # SQL_IDENTIFIER_CASE - Not case-sensitive, stored in mixed case + 29 => '"', # SQL_IDENTIFIER_QUOTE_CHAR - Uses " for identifiers, though supports [] and ` as well + 148 => 0, # SQL_INDEX_KEYWORDS - No support for ASC/DESC/ALL for CREATE INDEX + 149 => 0, # SQL_INFO_SCHEMA_VIEWS - No support for INFORMATION_SCHEMA + 172 => 1+2, # SQL_INSERT_STATEMENT - INSERT...VALUES & INSERT...SELECT + 73 => 'N', # SQL_INTEGRITY - No support for "Integrity Enhancement Facility" + 89 => \&sql_keywords, # SQL_KEYWORDS - List of non-ODBC keywords + 113 => 'Y', # SQL_LIKE_ESCAPE_CLAUSE - Supports LIKE...ESCAPE + 78 => 1, # SQL_LOCK_TYPES - Only NO_CHANGE + + 10022 => 0, # SQL_MAX_ASYNC_CONCURRENT_STATEMENTS - No async mode + 112 => 1_000_000, # SQL_MAX_BINARY_LITERAL_LEN - SQLITE_MAX_SQL_LENGTH + 34 => 1_000_000, # SQL_MAX_CATALOG_NAME_LEN - SQLITE_MAX_SQL_LENGTH + 108 => 1_000_000, # SQL_MAX_CHAR_LITERAL_LEN - SQLITE_MAX_SQL_LENGTH + 97 => 2000, # SQL_MAX_COLUMNS_IN_GROUP_BY - SQLITE_MAX_COLUMN + 98 => 2000, # SQL_MAX_COLUMNS_IN_INDEX - SQLITE_MAX_COLUMN + 99 => 2000, # SQL_MAX_COLUMNS_IN_ORDER_BY - SQLITE_MAX_COLUMN + 100 => 2000, # SQL_MAX_COLUMNS_IN_SELECT - SQLITE_MAX_COLUMN + 101 => 2000, # SQL_MAX_COLUMNS_IN_TABLE - SQLITE_MAX_COLUMN + 30 => 1_000_000, # SQL_MAX_COLUMN_NAME_LEN - SQLITE_MAX_SQL_LENGTH + 1 => 1021, # SQL_MAX_CONCURRENT_ACTIVITIES - Typical filehandle limits + 31 => 1_000_000, # SQL_MAX_CURSOR_NAME_LEN - SQLITE_MAX_SQL_LENGTH + 0 => 1021, # SQL_MAX_DRIVER_CONNECTIONS - Typical filehandle limits + 10005 => 1_000_000, # SQL_MAX_IDENTIFIER_LEN - SQLITE_MAX_SQL_LENGTH + 102 => 2147483646*65536, # SQL_MAX_INDEX_SIZE - Tied to DB size, which is theortically 140TB + 32 => 1_000_000, # SQL_MAX_OWNER_NAME_LEN - SQLITE_MAX_SQL_LENGTH + 33 => 1_000_000, # SQL_MAX_PROCEDURE_NAME_LEN - SQLITE_MAX_SQL_LENGTH + 34 => 1_000_000, # SQL_MAX_QUALIFIER_NAME_LEN - SQLITE_MAX_SQL_LENGTH + 104 => 1_000_000, # SQL_MAX_ROW_SIZE - SQLITE_MAX_SQL_LENGTH (since INSERT has to be used) + 103 => 'Y', # SQL_MAX_ROW_SIZE_INCLUDES_LONG + 32 => 1_000_000, # SQL_MAX_SCHEMA_NAME_LEN - SQLITE_MAX_SQL_LENGTH + 105 => 1_000_000, # SQL_MAX_STATEMENT_LEN - SQLITE_MAX_SQL_LENGTH + 106 => 64, # SQL_MAX_TABLES_IN_SELECT - 64 tables, because of the bitmap in the query optimizer + 35 => 1_000_000, # SQL_MAX_TABLE_NAME_LEN - SQLITE_MAX_SQL_LENGTH + 107 => 0, # SQL_MAX_USER_NAME_LEN - No user support + + 37 => 'Y', # SQL_MULTIPLE_ACTIVE_TXN - Supports mulitple txns, though not nested + 36 => 'N', # SQL_MULT_RESULT_SETS - No batches + 111 => 'N', # SQL_NEED_LONG_DATA_LEN - Doesn't care about LONG + 75 => 1, # SQL_NON_NULLABLE_COLUMNS - Supports NOT NULL + 85 => 1, # SQL_NULL_COLLATION - NULLs first on ASC (low end) + 49 => 4194304+1, # SQL_NUMERIC_FUNCTIONS - Just ABS & ROUND (has RANDOM, but not RAND) + + 9 => 1, # SQL_ODBC_API_CONFORMANCE - Same as sqlite3odbc.c + 152 => 1, # SQL_ODBC_INTERFACE_CONFORMANCE - Same as sqlite3odbc.c + 12 => 0, # SQL_ODBC_SAG_CLI_CONFORMANCE - Same as sqlite3odbc.c + 15 => 0, # SQL_ODBC_SQL_CONFORMANCE - Same as sqlite3odbc.c + 10 => '03.00', # SQL_ODBC_VER - Same as sqlite3odbc.c + + 115 => 1+8+16+32+64, # SQL_OJ_CAPABILITIES - Supports all OUTER JOINs except RIGHT & FULL + 90 => 'N', # SQL_ORDER_BY_COLUMNS_IN_SELECT - ORDER BY columns don't have to be in the SELECT list + 38 => 'Y', # SQL_OUTER_JOINS - Supports OUTER JOINs + 153 => 2, # SQL_PARAM_ARRAY_ROW_COUNTS - Only has row counts for executed statements + 154 => 3, # SQL_PARAM_ARRAY_SELECTS - No support for arrays of parameters + 80 => 0, # SQL_POSITIONED_STATEMENTS - No support for positioned statements (WHERE CURRENT OF or SELECT FOR UPDATE) + 79 => 31, # SQL_POS_OPERATIONS - Supports all SQLSetPos operations + 21 => 'N', # SQL_PROCEDURES - No procedures + 40 => '', # SQL_PROCEDURE_TERM - No procedures + 93 => 4, # SQL_QUOTED_IDENTIFIER_CASE - Even quoted identifiers are case-insensitive + 11 => 'N', # SQL_ROW_UPDATES - No fancy cursor update support + 39 => '', # SQL_SCHEMA_TERM - No schemas + 91 => 0, # SQL_SCHEMA_USAGE - No schemas + 43 => 2, # SQL_SCROLL_CONCURRENCY - Updates/deletes on cursors lock the database + 44 => 1+16, # SQL_SCROLL_OPTIONS - Only supports static & forward-only cursors + 14 => '\\', # SQL_SEARCH_PATTERN_ESCAPE - Default escape character for LIKE is \ + 13 => \&sql_server_name, # SQL_SERVER_NAME - Just $dbh->{Name} + 94 => '', # SQL_SPECIAL_CHARACTERS - Other drivers tend to stick to the ASCII/Latin-1 range, and SQLite uses all of + # the lower 7-bit punctuation for other things + + 155 => 7, # SQL_SQL92_DATETIME_FUNCTIONS - Supports CURRENT_(DATE|TIME|TIMESTAMP) + 156 => 1+2+4+8, # SQL_SQL92_FOREIGN_KEY_DELETE_RULE - Support all ON DELETE options + 157 => 1+2+4+8, # SQL_SQL92_FOREIGN_KEY_UPDATE_RULE - Support all ON UPDATE options + 158 => 0, # SQL_SQL92_GRANT - No users; no support for GRANT + 159 => 0, # SQL_SQL92_NUMERIC_VALUE_FUNCTIONS - No support for any of the listed functions + 160 => 1+2+4+512+1024+2048+4096+8192, # SQL_SQL92_PREDICATES - Supports the important comparison operators + 161 => 2+16+64+128, # SQL_SQL92_RELATIONAL_JOIN_OPERATORS - Supports the important ones except RIGHT/FULL OUTER JOINs + 162 => 0, # SQL_SQL92_REVOKE - No users; no support for REVOKE + 163 => 1+2+8, # SQL_SQL92_ROW_VALUE_CONSTRUCTOR - Supports most row value constructors + 164 => 2+4, # SQL_SQL92_STRING_FUNCTIONS - Just UPPER & LOWER (has SUBSTR, but not SUBSTRING and SQL-92's weird TRIM syntax) + 165 => 1+2+4+8, # SQL_SQL92_VALUE_EXPRESSIONS - Supports all SQL-92 value expressions + + 118 => 1, # SQL_SQL_CONFORMANCE - SQL-92 Entry level + 83 => 0, # SQL_STATIC_SENSITIVITY - Cursors would lock the DB, so only old data is visible + 50 => 8+16+256+1024+16384+131072, # SQL_STRING_FUNCTIONS - LTRIM, LENGTH, REPLACE, RTRIM, CHAR, SOUNDEX + 95 => 1+2+4+8+16, # SQL_SUBQUERIES - Supports all of the subquery types + 51 => 4, # SQL_SYSTEM_FUNCTIONS - Only IFNULL + 45 => 'table', # SQL_TABLE_TERM - Tables are called tables + 109 => 0, # SQL_TIMEDATE_ADD_INTERVALS - No support for INTERVAL + 110 => 0, # SQL_TIMEDATE_DIFF_INTERVALS - No support for INTERVAL + 52 => 0x20000+0x40000+0x80000, # SQL_TIMEDATE_FUNCTIONS - Only supports CURRENT_(DATE|TIME|TIMESTAMP) + 46 => 2, # SQL_TXN_CAPABLE - Full transaction support for both DML & DDL + 72 => 1+8, # SQL_TXN_ISOLATION_OPTION - Supports read uncommitted and serializable + 96 => 1+2, # SQL_UNION - Supports UNION and UNION ALL + 47 => '', # SQL_USER_NAME - No users + + 166 => 1, # SQL_STANDARD_CLI_CONFORMANCE - X/Open CLI Version 1.0 + 10000 => 1992, # SQL_XOPEN_CLI_YEAR - Year for V1.0 +); + +sub sql_dbms_ver { + my $dbh = shift; + return $dbh->FETCH('sqlite_version'); +} + +sub sql_data_source_name { + my $dbh = shift; + return "dbi:SQLite:".$dbh->{Name}; +} + +sub sql_data_source_read_only { + my $dbh = shift; + my $flags = $dbh->FETCH('sqlite_open_flags') || 0; + return $dbh->{ReadOnly} || ($flags & DBD::SQLite::OPEN_READONLY()) ? 'Y' : 'N'; +} + +sub sql_database_name { + my $dbh = shift; + my $databases = $dbh->selectall_hashref('PRAGMA database_list', 'seq'); + return $databases->{0}{name}; +} + +sub sql_keywords { + # SQLite keywords minus ODBC keywords + return join ',', (qw< + ABORT AFTER ANALYZE ATTACH AUTOINCREMENT BEFORE CONFLICT DATABASE DETACH EACH EXCLUSIVE + EXPLAIN FAIL GLOB IF IGNORE INDEXED INSTEAD ISNULL LIMIT NOTNULL OFFSET + PLAN PRAGMA QUERY RAISE RECURSIVE REGEXP REINDEX RELEASE RENAME REPLACE ROW + SAVEPOINT TEMP TRIGGER VACUUM VIRTUAL WITHOUT + >); +} + +sub sql_server_name { + my $dbh = shift; + return $dbh->{Name}; +} + +1; + +__END__ diff --git a/CPAN/arch/5.38/DBD/SQLite/VirtualTable.pm b/CPAN/arch/5.38/DBD/SQLite/VirtualTable.pm index f8e054a7077..efcc19b72d9 100644 --- a/CPAN/arch/5.38/DBD/SQLite/VirtualTable.pm +++ b/CPAN/arch/5.38/DBD/SQLite/VirtualTable.pm @@ -5,7 +5,7 @@ use strict; use warnings; use Scalar::Util qw/weaken/; -our $VERSION = '1.58'; +our $VERSION = '1.76'; our @ISA; diff --git a/CPAN/arch/5.38/DBD/SQLite/VirtualTable/PerlData.pm b/CPAN/arch/5.38/DBD/SQLite/VirtualTable/PerlData.pm index 5af9977757c..0e58d7d0dae 100644 --- a/CPAN/arch/5.38/DBD/SQLite/VirtualTable/PerlData.pm +++ b/CPAN/arch/5.38/DBD/SQLite/VirtualTable/PerlData.pm @@ -88,7 +88,7 @@ sub BEST_INDEX { # in FILTER() for deciding which rows match the constraints. my @conditions; my $ix = 0; - foreach my $constraint (grep {$_->{usable}} @$constraints) { + foreach my $constraint (grep {$_->{usable} and exists $SQLOP2PERLOP{ $_->{op} } } @$constraints) { my $col = $constraint->{col}; my ($member, $optype); @@ -389,7 +389,7 @@ time. Here is a way to do it with a virtual table : my @files = ... ; # list of files to inspect # apply the L function to each file - our $file_stats = [ map {($_, stat $_)} @files]; + our $file_stats = [ map { [ $_, stat $_ ] } @files]; # create a temporary virtual table $dbh->do(<<""); diff --git a/CPAN/arch/5.38/x86_64-linux-thread-multi/auto/DBD/SQLite/SQLite.so b/CPAN/arch/5.38/x86_64-linux-thread-multi/auto/DBD/SQLite/SQLite.so old mode 100644 new mode 100755 index 2d893e52fbb..344723defcb Binary files a/CPAN/arch/5.38/x86_64-linux-thread-multi/auto/DBD/SQLite/SQLite.so and b/CPAN/arch/5.38/x86_64-linux-thread-multi/auto/DBD/SQLite/SQLite.so differ diff --git a/Changelog9.html b/Changelog9.html index cea77683921..bb3eca8b7f4 100644 --- a/Changelog9.html +++ b/Changelog9.html @@ -1,3 +1,56 @@ +

Version 9.1.0

+
    +
  • Upstream fixes from Lyrion Music Server 9.0.x
  • +
    + +
  • New Features:
  • +
      +
    • Implement an artist portrait picture handler. This will read images from folders where you've stored them under the artist's name, or from the artist folder in a typical artist/album/track hierarchy.
    • +
    • Allow GETting the JSONRPC.js handler with a "request" parameter to simplify access by limited clients.
    • +
    +
    + +
  • Server Changes:
  • +
      +
    • Improve support for 3rd party player icons, add some for piCorePlayer, SqueezeAMP, WiiM players.
    • +
    • Update downloader now validates the installers checksum.
    • +
    • #1245 - Added a Simple WebSocket client capability for 3rd Party Plugins to support this protocol (@expectingtofly)
    • +
    • #1356 - Use ORIGINALDATE tag with Flac (@jbylsma)
    • +
    • #1363 - Allow item removal even if playlist has only 1 item (@mw9)
    • +
    • #1364 - store/return playqueue entry context flag ("addedFromWork")
    • +
    +
    + +
  • Platform Support:
  • +
      +
    • Make Docker a first class citizan: add Slim::Utils::OS::Docker insted of a Custom.pm
    • +
    • Remove Win32 legacy support files, code, control panels, build pipeline, etc.
    • +
    • Remove legacy Mac installer from build pipeline.
    • +
    • Remove code dealing with Perl < 5.10.
    • +
    • Upgrade DBD::SQLite to v1.75 for Perl 5.38 (Linux x86_64), 5.36 (Linux x86_64, aarch64, armv7), 5.34 (Linux x86_64, aarch64; macOS), 5.32 (Linux x86_64, aarch64, armv7).
    • +
    • #73 - Add a note about setting the hostname in a Docker container (thanks @hartzell!)
    • +
    • #86 - Add more tags to Docker images to better support automated updates (thanks @stavros-k!)
    • +
    +
    + +
  • Bug Fixes:
  • +
      +
    • #1287 - fix method name for spdr protocol handler.
    • +
    • #1359 - Update ConnectionManager.pm to add checks for Wav and Opus (@BoringName15).
    • +
    • +
    +
    + +
  • Other:
  • +
      +
    • Remove more left-overs from removed picture/video scanning.
    • +
    • Remove more left-overs from removed MySqueezebox integration.
    • +
    • Remove support for MySQL. Existing configurations using it will log an error.
    • +
    +
    +
+ +

Version 9.0.3

  • New Features:
  • @@ -53,20 +106,20 @@

    Version 9.0.2 - 2025-03-13 (1470c9412)

  • #1193 - Don't throw error when fulltext search is being used before the end of a scan.
  • #1214 - If item in queue can't be played, StreamingController leaves player in a bad state, failing further playback.
  • #1288 - Update Carp::Assert to latest to fix compatibility with recent Perl versions.
  • -
  • #1303 - Fix an issue where browsing releases would sometimes create thousands of parameters (and more - thanks @darrel-k!).
  • +
  • #1303 - Fix an issue where browsing releases would sometimes create thousands of parameters (and more - thanks @darrell-k!).
  • #1306 - Don't run the scanner before we're done with the setup wizard.
  • #1307 - Fix scanner progress information in the web UI.
  • -
  • #1309 - Limit works advanced search to discovered albums. (@darrel-k)
  • +
  • #1309 - Limit works advanced search to discovered albums. (@darrell-k)
  • #1314 - The server would seemingly hang when trying to connect to the Material skin as long as no work has been found.
  • -
  • #1319 - Don't filter by release types if user pref is ignoreReleaseTypes (@darrel-k).
  • -
  • #1325 - Fix scanning multiple MusicBrainz IDs (@darrel-k).
  • +
  • #1319 - Don't filter by release types if user pref is ignoreReleaseTypes (@darrell-k).
  • +
  • #1325 - Fix scanning multiple MusicBrainz IDs (@darrell-k).
  • Improve compatibility with modern HTML/JS and more strict browsers (eg. Safari).

  • Other:
    • -
    • #1315 - Return contiguous/non-contiguous flag in statusQuery (thanks @darrel-k).
    • +
    • #1315 - Return contiguous/non-contiguous flag in statusQuery (thanks @darrell-k).

    @@ -106,15 +159,15 @@

    Version 9.0.1 - 2025-01-09 (e3effbe91)

  • Only re-initialize menu settings for connected players - otherwise Analytics considers them "active" due to a prefs change.
  • Fix display of final "Scan done" message in Material skin.
  • Fix track count caching in "titles" query.
  • -
  • #1235 - Need to utf8Decode album title for new & changed (thanks @darrel-k!)
  • +
  • #1235 - Need to utf8Decode album title for new & changed (thanks @darrell-k!)
  • #1237 - Fix create table syntax for MySQL (MariaDB) (thanks @JKDingwall!)
  • -
  • #1238 - Merge multiple works per track into one single work (thanks @darrel-k!)
  • -
  • #1240 - Add option to limit works scanning to classical genre(s) (thanks @darrel-k!)
  • +
  • #1238 - Merge multiple works per track into one single work (thanks @darrell-k!)
  • +
  • #1240 - Add option to limit works scanning to classical genre(s) (thanks @darrell-k!)
  • #1242 - Fix plugin download - must wait for the download to finish before restarting the server
  • #1247 - Fix display of final "Scan done" message and "Abort scan" link in Material/Classic skins.
  • #1250 - Radio stations wouldn't show album artwork any more.
  • #1246 - Windows registry value "DataPath" is in the wrong place.
  • -
  • #1273 - Remove grouping & discsubtitle in new & changed scan if tags were removed (thanks @darrel-k!)
  • +
  • #1273 - Remove grouping & discsubtitle in new & changed scan if tags were removed (thanks @darrell-k!)
  • @@ -129,12 +182,12 @@

    Introducing... Lyrion Music Server Version
  • New product name! Welcome Lyrion Music Server!
  • New visuals - thanks @gobuleberbu & @mikes!
  • Default skin refresh (the old version is still available as "Logic Teal")
  • -
  • Massive upgrade for (Classical) music lovers: add support for Works, Performances, Disc Subtitles, Roles. Thanks a ton @darrel-k!
  • +
  • Massive upgrade for (Classical) music lovers: add support for Works, Performances, Disc Subtitles, Roles. Thanks a ton @darrell-k!
  • Improved first start setup: suggest a few plugins to install on initial startup.
  • Add new "Recently Changed" browse mode to complement the "New Music" menu. The latter is no longer based on the file's timestamp, but on the time added to the collection, as stored in the persistant track table.
  • #1095 - Link from online tracks and albums to local library (if possible).
  • #1115 - Add option to show tracks from a given year, even if their album would be listed in a different year.
  • -
  • #1132 - Allow user defined contributor roles (thanks @darrel-k!).
  • +
  • #1132 - Allow user defined contributor roles (thanks @darrell-k!).
  • #1228 - Allow user to define how many HTTP requests to follow.

  • @@ -167,11 +220,11 @@

    Introducing... Lyrion Music Server Version
  • Bug Fixes:
    • -
    • #1027 - Play count increase with in-track jumps (thanks @darrel-k!)
    • -
    • #1116 - Fix album info track count when there are more than 50 tracks in an album (thanks @darrel-k!)
    • -
    • #1138 - "Add all songs" from search not working (thanks @darrel-k!)
    • +
    • #1027 - Play count increase with in-track jumps (thanks @darrell-k!)
    • +
    • #1116 - Fix album info track count when there are more than 50 tracks in an album (thanks @darrell-k!)
    • +
    • #1138 - "Add all songs" from search not working (thanks @darrell-k!)
    • #1146 - Restore partial Cometd support for CLI clients (thanks @sodface!)
    • -
    • #1203 - Fix display of album roles in the playlist (thanks @darrel-k!)
    • +
    • #1203 - Fix display of album roles in the playlist (thanks @darrell-k!)
    • #1213 - Modify #CURRTRACK to first track when playlist finishes
    • #1229 - Only allow audio tracks for RandomPlay (thanks @jbylsma!)
    diff --git a/HTML/EN/html/images/Players/squeezeesp32.png b/HTML/EN/html/images/Players/squeezeesp32.png new file mode 100644 index 00000000000..6531084e08c Binary files /dev/null and b/HTML/EN/html/images/Players/squeezeesp32.png differ diff --git a/HTML/EN/html/images/Players/squeezelite-pcp.png b/HTML/EN/html/images/Players/squeezelite-pcp.png new file mode 100644 index 00000000000..343147bce07 Binary files /dev/null and b/HTML/EN/html/images/Players/squeezelite-pcp.png differ diff --git a/HTML/EN/html/images/Players/wiimplayer.png b/HTML/EN/html/images/Players/wiimplayer.png new file mode 100644 index 00000000000..7da0eb47ec6 Binary files /dev/null and b/HTML/EN/html/images/Players/wiimplayer.png differ diff --git a/HTML/EN/html/images/icon_grey.png b/HTML/EN/html/images/icon_grey.png deleted file mode 100644 index 82dd908aaa6..00000000000 Binary files a/HTML/EN/html/images/icon_grey.png and /dev/null differ diff --git a/HTML/EN/html/images/lms.png b/HTML/EN/html/images/lms.png deleted file mode 100644 index 5f6bb3539b7..00000000000 Binary files a/HTML/EN/html/images/lms.png and /dev/null differ diff --git a/HTML/EN/settings/server/formatting.html b/HTML/EN/settings/server/formatting.html index b6ad52d933a..bf6c9d92857 100644 --- a/HTML/EN/settings/server/formatting.html +++ b/HTML/EN/settings/server/formatting.html @@ -8,6 +8,13 @@ [% END %] + [% WRAPPER setting title="SETUP_NO_PORTRAITS" desc="" %] + + [% END %] + [% WRAPPER setting title="SETUP_GUESSFILEFORMATS" desc="SETUP_GROUP_GUESSFILEFORMATS_DESC" %] [% FOREACH format = prefs.pref_guessFileFormats %]
    diff --git a/README.md b/README.md index 23b345c2697..d89a351c51a 100644 --- a/README.md +++ b/README.md @@ -77,8 +77,8 @@ Don't forget to give the project a star! Thanks again! [issues-url]: https://github.com/LMS-Community/slimserver/issues [pulls-shield]: https://img.shields.io/github/issues-pr/LMS-Community/slimserver.svg?style=flat [pulls-url]: https://github.com/LMS-Community/slimserver/pulls -[docker-pulls-shield]: https://img.shields.io/docker/pulls/lmscommunity/logitechmediaserver?style=flat -[docker-pulls-url]: https://hub.docker.com/r/lmscommunity/logitechmediaserver +[docker-pulls-shield]: https://img.shields.io/docker/pulls/lmscommunity/lyrionmusicserver?style=flat +[docker-pulls-url]: https://hub.docker.com/r/lmscommunity/lyrionmusicserver [lyrion-screenshot]: https://lyrion.org/assets/screenshot.png [Perl]: https://img.shields.io/badge/Written_in-perl-orange?logo=perl [Perl-url]: https://perl.org/ diff --git a/SQL/SQLite/schema_24_up.sql b/SQL/SQLite/schema_24_up.sql index 0424a900bfe..81af10be5dd 100644 --- a/SQL/SQLite/schema_24_up.sql +++ b/SQL/SQLite/schema_24_up.sql @@ -1,2 +1,5 @@ +DROP TABLE IF EXISTS videos; +DROP TABLE IF EXISTS images; + ALTER TABLE tracks ADD performance blob; ALTER TABLE tracks ADD discsubtitle blob; diff --git a/SQL/SQLite/schema_25_down.sql b/SQL/SQLite/schema_25_down.sql new file mode 100644 index 00000000000..e69de29bb2d diff --git a/SQL/SQLite/schema_25_up.sql b/SQL/SQLite/schema_25_up.sql new file mode 100644 index 00000000000..ddf98f50850 --- /dev/null +++ b/SQL/SQLite/schema_25_up.sql @@ -0,0 +1,4 @@ +ALTER TABLE contributors ADD portrait blob default NULL; + +ALTER TABLE contributors ADD portraitid char(8) default NULL; +CREATE INDEX portraitidIndex ON contributors (portraitid); diff --git a/SQL/mysql/schema_24_up.sql b/SQL/mysql/schema_24_up.sql index 0424a900bfe..81af10be5dd 100644 --- a/SQL/mysql/schema_24_up.sql +++ b/SQL/mysql/schema_24_up.sql @@ -1,2 +1,5 @@ +DROP TABLE IF EXISTS videos; +DROP TABLE IF EXISTS images; + ALTER TABLE tracks ADD performance blob; ALTER TABLE tracks ADD discsubtitle blob; diff --git a/SQL/mysql/schema_25_down.sql b/SQL/mysql/schema_25_down.sql new file mode 100644 index 00000000000..e69de29bb2d diff --git a/SQL/mysql/schema_25_up.sql b/SQL/mysql/schema_25_up.sql new file mode 100644 index 00000000000..ddf98f50850 --- /dev/null +++ b/SQL/mysql/schema_25_up.sql @@ -0,0 +1,4 @@ +ALTER TABLE contributors ADD portrait blob default NULL; + +ALTER TABLE contributors ADD portraitid char(8) default NULL; +CREATE INDEX portraitidIndex ON contributors (portraitid); diff --git a/Slim/Buttons/Playlist.pm b/Slim/Buttons/Playlist.pm index a11b57fc9c0..13051031d6d 100644 --- a/Slim/Buttons/Playlist.pm +++ b/Slim/Buttons/Playlist.pm @@ -562,7 +562,7 @@ sub browseplaylistindex { my $client = shift; if ( main::DEBUGLOG && @_ && $playlistlog->is_debug ) { - $log->debug("New playlistindex: $_[0]"); + $playlistlog->debug("New playlistindex: $_[0]"); } # update list length for the knob. ### HACK ATTACK ### diff --git a/Slim/Control/Commands.pm b/Slim/Control/Commands.pm index 6ffb0a08c52..a3fbb748375 100644 --- a/Slim/Control/Commands.pm +++ b/Slim/Control/Commands.pm @@ -1859,6 +1859,7 @@ sub playlistcontrolCommand { my $client = $request->client(); my $cmd = $request->getParam('cmd'); my $jumpIndex = $request->getParam('play_index'); + my $workId = $request->getParam('work_id') || ''; if (Slim::Music::Import->stillScanning()) { $request->addResult('rescan', "1"); @@ -1987,9 +1988,9 @@ sub playlistcontrolCommand { return; } - } elsif (defined(my $work_id = $request->getParam('work_id'))) { + } elsif ($workId && $workId ne '-1') { - my $criteria = {work => [ '=' => $work_id ]}; + my $criteria = {work => [ '=' => $workId ]}; if (defined (my $album_id = $request->getParam('album_id'))) { my @albumIds = split(',', $album_id); @@ -2038,6 +2039,10 @@ sub playlistcontrolCommand { my $what = {}; + if ($workId eq '-1') { + $what->{'track.work'} = { '!=' => undef }; + } + if (defined(my $genre_id = $request->getParam('genre_id'))) { $what->{'genre.id'} = { 'in' => [ split(/,/, $genre_id) ] }; $info[0] = join(', ', map { $_->name } Slim::Schema->search('Genre', { 'id' => { 'in' => [ split(/,/, $genre_id) ] } })->all); @@ -2099,6 +2104,12 @@ sub playlistcontrolCommand { # don't call Xtracks if we got no songs if (@tracks) { + if ($workId) { + foreach my $track (@tracks) { + $track->added_from_work("1"); + } + } + if ($load || $add || $insert) { $info[0] ||= $tracks[0]->title; @@ -3118,7 +3129,6 @@ sub pragmaCommand { my $pragma = join( ' ', grep { $_ ne 'pragma' } $request->renderAsArray ); - # XXX need to pass pragma to artwork cache even if using MySQL Slim::Utils::OSDetect->getOS()->sqlHelperClass()->pragma($pragma); $request->setStatusDone(); diff --git a/Slim/Control/Queries.pm b/Slim/Control/Queries.pm index 43de4be9555..b3047a91f30 100644 --- a/Slim/Control/Queries.pm +++ b/Slim/Control/Queries.pm @@ -1,7 +1,7 @@ package Slim::Control::Queries; # Logitech Media Server Copyright 2001-2024 Logitech. -# Lyrion Music Server Copyright 2024 Lyrion Community. +# Lyrion Music Server Copyright 2025 Lyrion Community. # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License, # version 2. @@ -251,7 +251,6 @@ sub _colNamesWithASMapping { my ($c, $as, $sql) = @_; # Add selected columns - # Bug 15997, AS mapping needed for MySQL # ** use customised 'AS' if provided in $as->{} ** my @cols = sort keys %{$c}; $sql = sprintf $sql, join( ', ', map { $_ . " AS '" . ($as->{$_} || $_) . "'" } @cols ); @@ -645,6 +644,10 @@ sub albumsQuery { $as->{$col} = 'group_structure'; } + if ( $tags =~ /4/ && !$work ) { + $c->{'contributors.portraitid'} = 1; + } + if ( @{$w} ) { $sql .= 'WHERE '; my $s .= join( ' AND ', @{$w} ); @@ -864,9 +867,8 @@ sub albumsQuery { #Don't use albums.contributor to set artist_id/artist for Works, it may well be completely wrong! if ( !$work ) { $tags =~ /S/ && $request->addResultLoopIfValueDefined($loopname, $chunkCount, 'artist_id', $c->{'albums.contributor'}); - if ($tags =~ /a/) { - $request->addResultLoopIfValueDefined($loopname, $chunkCount, 'artist', $c->{'contributors.name'}); - } + $tags =~ /a/ && $request->addResultLoopIfValueDefined($loopname, $chunkCount, 'artist', $c->{'contributors.name'}); + $tags =~ /4/ && $request->addResultLoopIfValueDefined($loopname, $chunkCount, 'portraitid', $c->{'contributors.portraitid'}); } if ($tags =~ /s/) { @@ -1213,8 +1215,10 @@ sub artistsQuery { } } - $sql = sprintf($sql, 'contributors.id, contributors.name, contributors.namesort' . ($tags =~ /E/ ? ', contributors.extid' : '')) - . 'GROUP BY contributors.id '; + $sql = sprintf($sql, 'contributors.id, contributors.name, contributors.namesort' + . ($tags =~ /E/ ? ', contributors.extid' : '') + . ($tags =~ /4/ ? ', contributors.portraitid' : '') + ) . 'GROUP BY contributors.id '; $sql .= "ORDER BY $sort " unless $tags eq 'CC'; @@ -1291,9 +1295,10 @@ sub artistsQuery { my $sth = $dbh->prepare_cached($sql); $sth->execute( @{$p} ); - my ($id, $name, $namesort, $extid); + my ($id, $name, $namesort, $portraitid, $extid); my @bind = (\$id, \$name, \$namesort); push @bind, \$extid if $tags =~ /E/; + push @bind, \$portraitid if $tags =~ /4/; $sth->bind_columns(@bind); my $process = sub { @@ -1304,15 +1309,16 @@ sub artistsQuery { $request->addResultLoop($loopname, $chunkCount, 'id', $id); $request->addResultLoop($loopname, $chunkCount, 'artist', $name); + if ($tags =~ /s/) { # Bug 11070: Don't display large V at beginning of browse Artists my $textKey = ($count_va && $chunkCount == 0) ? ' ' : substr($namesort, 0, 1); $request->addResultLoop($loopname, $chunkCount, 'textkey', $textKey); } - if ($tags =~ /E/ && $extid) { - $request->addResultLoop($loopname, $chunkCount, 'extid', $extid); - } + $request->addResultLoop($loopname, $chunkCount, 'extid', $extid) if $tags =~ /E/ && $extid; + $request->addResultLoop($loopname, $chunkCount, 'portraitid', $portraitid) if $tags =~ /4/ && $portraitid; + $request->addResultLoop($loopname, $chunkCount, 'favorites_url', 'db:contributor.name=' . URI::Escape::uri_escape_utf8( $name ) ); $chunkCount++; @@ -4249,10 +4255,12 @@ sub statusQuery { $start += 0; $request->addResult('offset', $request->getParam('_index')) if $menuMode; - my (@tracks, @trackIds); + my (@tracks, @trackIds, @addedFromWork); foreach my $track ( Slim::Player::Playlist::songs($client, $start, $end) ) { next unless defined $track; + push @addedFromWork, $track->added_from_work; + if ( $track->remote ) { push @tracks, $track; } @@ -4301,7 +4309,7 @@ sub statusQuery { else { _addSong( $request, $loop, $count, $data, $tags, - 'playlist index', $idx, $fast + 'playlist index', $idx, $fast, @addedFromWork[$count] ); if ( $tags =~ /2/ ) { @@ -5274,17 +5282,18 @@ sub dynamicAutoQuery { ################################################################################ sub _addSong { - my $request = shift; # request - my $loop = shift; # loop - my $index = shift; # loop index - my $pathOrObj = shift; # song path or object, or hash from titlesQuery - my $tags = shift; # tags to use - my $prefixKey = shift; # prefix key, if any - my $prefixVal = shift; # prefix value, if any - my $fast = shift; + my $request = shift; # request + my $loop = shift; # loop + my $index = shift; # loop index + my $pathOrObj = shift; # song path or object, or hash from titlesQuery + my $tags = shift; # tags to use + my $prefixKey = shift; # prefix key, if any + my $prefixVal = shift; # prefix value, if any + my $fast = shift; + my $addedFromWork = shift; # get the hash with the data - my $hashRef = _songData($request, $pathOrObj, $tags, $fast); + my $hashRef = _songData($request, $pathOrObj, $tags, $fast, $addedFromWork); # add the prefix in the first position, use a fancy feature of # Tie::LLHash @@ -5539,6 +5548,7 @@ my %tagMap = ( #-------------------------------------------------------------------------------------------------- 'A' => ['', '', 'contributors', 'name'], #->contributors[role].name 'S' => ['_ids', '', 'contributors', 'id'], #->contributors[role].id + '4' => ['portraitid', '', 'primary_artist','portraitid'], #->contributors.portraitid 'q' => ['disccount', '', 'album', 'discc'], #->album.discc 'J' => ['artwork_track_id', 'COVERART', 'album', 'artwork'], #->album.artwork @@ -5550,6 +5560,7 @@ my %tagMap = ( 'P' => ['genre_ids', '', 'genres', 'id'], #->genre_track->genres.id 'k' => ['comment', 'COMMENT', 'comment'], #->comment_object + '2' => 1, # to trigger addition of the input parameter # Tags handled in code only #-------------------------------------------------------------------------------------------------- @@ -5566,6 +5577,7 @@ my %colMap = ( P => 'genre_ids', a => 'contributors.name', 's' => 'contributors.id', + 4 => 'contributors.portraitid', l => 'albums.title', e => 'tracks.album', d => 'tracks.secs', @@ -5608,7 +5620,7 @@ my %colMap = ( ); sub _songDataFromHash { - my ( $request, $res, $tags, $fast ) = @_; + my ( $request, $res, $tags, $fast, $addedFromWork ) = @_; my %returnHash; @@ -5669,6 +5681,11 @@ sub _songDataFromHash { } } + # Special case for 2: at track level, triggers addition of the play queue context $addedFromWork + elsif ( $tag eq '2' && $addedFromWork ) { + $returnHash{added_from_work} = $addedFromWork; + } + # eg. the web UI is requesting some tags which are only available for remote tracks, # such as 'B' (custom button handler). They would return empty here - ignore them. elsif ( my $map = $colMap{$tag} ) { @@ -5684,14 +5701,15 @@ sub _songDataFromHash { } sub _songData { - my $request = shift; # current request object - my $pathOrObj = shift; # song path or object - my $tags = shift; # tags to use - my $fast = shift; # don't use Tie::IxHash for performance + my $request = shift; # current request object + my $pathOrObj = shift; # song path or object + my $tags = shift; # tags to use + my $fast = shift; # don't use Tie::IxHash for performance + my $addedFromWork = shift; if ( ref $pathOrObj eq 'HASH' ) { # Hash from direct DBI query in titlesQuery - return _songDataFromHash($request, $pathOrObj, $tags, $fast); + return _songDataFromHash($request, $pathOrObj, $tags, $fast, $addedFromWork); } # figure out the track object @@ -5802,6 +5820,17 @@ sub _songData { $returnHash{$tagref->[0]} = 1; } + # special case: return composer and work for tag 'b' + elsif ($tag eq 'b') { + $returnHash{work} = $remoteMeta->{$tag}; + $returnHash{composer} = $remoteMeta->{composer} if $remoteMeta->{composer}; + } + + # Special case for 2: at track level, triggers addition of the play queue context $addedFromWork + elsif ( $tag eq '2' && $addedFromWork ) { + $returnHash{added_from_work} = $addedFromWork; + } + # special case artists (tag A and S) elsif ($tag eq 'A' || $tag eq 'S') { if ( my $meta = $remoteMeta->{$tag} ) { @@ -6354,6 +6383,11 @@ sub _getTagDataForTracks { $c->{'contributors.id'} = 1; }; + $tags =~ /4/ && do { + $join_contributors->(); + $c->{'contributors.portraitid'} = 1; + }; + $tags =~ /l/ && do { $join_albums->(); $c->{'albums.title'} = 1; diff --git a/Slim/Control/XMLBrowser.pm b/Slim/Control/XMLBrowser.pm index 6e9886900d4..29f91ef8c5c 100644 --- a/Slim/Control/XMLBrowser.pm +++ b/Slim/Control/XMLBrowser.pm @@ -427,6 +427,12 @@ sub _cliQuery_done { delete $subFeed->{fetched}; } + # Invalidate previously fetched data if it was fetched with a smaller quantity than requested now + if ($subFeed->{fetched} && $subFeed->{fetchSize} && $subFeed->{fetchSize} < $quantity) { + main::DEBUGLOG && $log->is_debug && $log->debug(" Invalidating short cached data (has ", $subFeed->{fetchSize}, " want $quantity)"); + delete $subFeed->{fetched}; + } + # If the feed is another URL, fetch it and insert it into the # current cached feed if ( (!$subFeed->{'type'} || ($subFeed->{'type'} ne 'audio')) && defined $subFeed->{'url'} && !$subFeed->{'fetched'} @@ -1499,6 +1505,7 @@ sub _cliQuery_done { # After fetching, insert the contents into the original feed sub _cliQuerySubFeed_done { my ( $feed, $params ) = @_; + my $request = $params->{request}; # If there's a command we need to run, run it. This is used in various # places to trigger actions from an OPML result, such as to start playing @@ -1506,7 +1513,7 @@ sub _cliQuerySubFeed_done { if ( $feed->{command} ) { my @p = map { uri_unescape($_) } split / /, $feed->{command}; - my $client = $params->{request}->client(); + my $client = $request->client(); if ($client) { main::DEBUGLOG && $log->is_debug && $log->debug( "Executing command: " . Data::Dump::dump(\@p) ); @@ -1545,6 +1552,7 @@ sub _cliQuerySubFeed_done { } $subFeed->{'fetched'} = 1; + $subFeed->{'fetchSize'} = $request->getParam('_quantity'); # Pass-through forceRefresh flag if ( $feed->{forceRefresh} ) { diff --git a/Slim/Display/Lib/Fonts.pm b/Slim/Display/Lib/Fonts.pm index 0ad67e0ed17..89a224b19e2 100644 --- a/Slim/Display/Lib/Fonts.pm +++ b/Slim/Display/Lib/Fonts.pm @@ -95,8 +95,8 @@ my ($ft, $TTFFontFile); tie my %TTFCache, 'Tie::Cache::LRU', 256; %TTFCache = (); -# template for unpacking strings: U - unpacks Unicode chars into ords, C - is needed for 5.6 perl's -my $unpackTemplate = ($] > 5.007) ? 'U*' : 'C*'; +# template for unpacking strings: U - unpacks Unicode chars into ords +my $unpackTemplate = 'U*'; my $bidiR = qr/\p{BidiClass:R}/; my $bidiL = qr/\p{BidiClass:L}/; diff --git a/Slim/Formats.pm b/Slim/Formats.pm index 202762c0b2a..d48d1cbc34e 100644 --- a/Slim/Formats.pm +++ b/Slim/Formats.pm @@ -346,6 +346,12 @@ sub sanitizeTagValues { } } +sub sanitizeYearTag { + my ($class, $year) = @_; + $year =~ s/.*(\d\d\d\d).*/$1/ if $year; + return $year; +} + 1; __END__ diff --git a/Slim/Formats/FLAC.pm b/Slim/Formats/FLAC.pm index d02d43f9235..5e4cc192ae1 100644 --- a/Slim/Formats/FLAC.pm +++ b/Slim/Formats/FLAC.pm @@ -57,6 +57,7 @@ my %tagMapping = ( 'MUSICBRAINZ_TRMID' => 'MUSICBRAINZ_TRM_ID', 'DESCRIPTION' => 'COMMENT', 'ORIGINALYEAR' => 'YEAR', + 'ORIGINALDATE' => 'DATE', 'UNSYNCEDLYRICS' => "LYRICS", # J.River once again.. can't these people use existing standards? @@ -252,7 +253,7 @@ sub doTagMapping { $tags->{DATE} = $years[0]; } - ($tags->{YEAR} = $tags->{DATE}) =~ s/.*(\d\d\d\d).*/$1/; + $tags->{YEAR} = $class->sanitizeYearTag($tags->{DATE}); } # Sometimes the BPM is not an integer so we try to convert. diff --git a/Slim/Formats/MP3.pm b/Slim/Formats/MP3.pm index 3ad95c0469a..775af390cb7 100644 --- a/Slim/Formats/MP3.pm +++ b/Slim/Formats/MP3.pm @@ -409,11 +409,7 @@ sub doTagMapping { # the first. $year = $year->[0] if ref $year eq 'ARRAY'; - if ( $year =~ /(\d\d\d\d)/ ) { - $year = $1; - } - - $tags->{YEAR} = $year; + $tags->{YEAR} = $class->sanitizeYearTag($year); } # Sometimes the BPM is not an integer so we try to convert. diff --git a/Slim/Formats/Movie.pm b/Slim/Formats/Movie.pm index a879977d0fb..cd9028f3255 100644 --- a/Slim/Formats/Movie.pm +++ b/Slim/Formats/Movie.pm @@ -153,7 +153,7 @@ sub _doTagMapping { # Special handling for DATE tags # Parse the date down to just the year, for compatibility with other formats if ( defined $tags->{YEAR} ) { - $tags->{YEAR} =~ s/.*(\d\d\d\d).*/$1/; + $tags->{YEAR} = $class->sanitizeYearTag($tags->{YEAR}); } # Unroll the disc info. diff --git a/Slim/Formats/Ogg.pm b/Slim/Formats/Ogg.pm index 3a4d293dc65..abfc2cc3357 100644 --- a/Slim/Formats/Ogg.pm +++ b/Slim/Formats/Ogg.pm @@ -27,6 +27,8 @@ use strict; use base qw(Slim::Formats); use Fcntl qw(:seek); +use List::Util qw(first); + use Slim::Utils::Log; use Slim::Utils::Strings qw(string); @@ -95,11 +97,9 @@ sub getTag { # Special handling for DATE tags # Parse the date down to just the year, for compatibility with other formats - foreach (qw(ORIGINALYEAR ORIGINALDATE DATE)) { - if (defined $tags->{$_} && !defined $tags->{YEAR}) { - ($tags->{YEAR} = $tags->{$_}) =~ s/.*(\d\d\d\d).*/$1/; - } - } + $tags->{YEAR} ||= first { $_ } map { + $class->sanitizeYearTag($tags->{$_}) + } qw(ORIGINALYEAR ORIGINALDATE DATE); # Sometimes the BPM is not an integer so we try to convert. $tags->{BPM} = int($tags->{BPM}) if defined $tags->{BPM}; diff --git a/Slim/Formats/Playlists/Base.pm b/Slim/Formats/Playlists/Base.pm index 8dc05c0eabb..b5e6778680f 100644 --- a/Slim/Formats/Playlists/Base.pm +++ b/Slim/Formats/Playlists/Base.pm @@ -21,6 +21,7 @@ sub _updateMetaData { my $entry = shift; my $metadata = shift; my $playlistUrl = shift; + my $addedFromWork = shift; my $attributes = {}; @@ -48,6 +49,7 @@ sub _updateMetaData { if ( !scalar keys %{$attributes} ) { $track = Slim::Schema->objectForUrl($entry); + $track->added_from_work($addedFromWork); } if ( !defined $track ) { @@ -89,14 +91,11 @@ sub _filehandleFromNameOrString { }; # Always write out in UTF-8 with a BOM. - if ($] > 5.007) { + binmode($output, ":raw"); - binmode($output, ":raw"); + print $output $File::BOM::enc2bom{'utf8'}; - print $output $File::BOM::enc2bom{'utf8'}; - - binmode($output, ":encoding(utf8)"); - } + binmode($output, ":encoding(utf8)"); } else { diff --git a/Slim/Formats/Playlists/CUE.pm b/Slim/Formats/Playlists/CUE.pm index 74d2f978616..91f6c2eaebc 100644 --- a/Slim/Formats/Playlists/CUE.pm +++ b/Slim/Formats/Playlists/CUE.pm @@ -399,6 +399,7 @@ sub parse { # EAC CUE sheet has REM DATE not REM YEAR, and no quotes _mergeCommand('DATE', 'YEAR', $cuesheet, $cuesheet); + $cuesheet->{YEAR} = Slim::Formats->sanitizeYearTag($cuesheet->{YEAR}) if defined $cuesheet->{YEAR}; for my $key (sort {$a <=> $b} keys %$tracks) { @@ -425,6 +426,7 @@ sub parse { # EAC CUE sheet has REM DATE not REM YEAR, and no quotes _mergeCommand('DATE', 'YEAR', $track, $track); + $track->{YEAR} = Slim::Formats->sanitizeYearTag($track->{YEAR}) if defined $track->{YEAR}; _mergeCommand('DISCNUMBER', 'DISC', $track, $track); } diff --git a/Slim/Formats/Playlists/M3U.pm b/Slim/Formats/Playlists/M3U.pm index b55adb85971..f5fe73d4fbc 100644 --- a/Slim/Formats/Playlists/M3U.pm +++ b/Slim/Formats/Playlists/M3U.pm @@ -28,7 +28,7 @@ sub read { my ($class, $file, $baseDir, $url) = @_; my @items = (); - my ($secs, $artist, $album, $title, $trackurl); + my ($secs, $artist, $album, $title, $trackurl, $addedFromWork); my $checkedBOM = 0; my $fh; my $mediadirs; @@ -114,6 +114,12 @@ sub read { main::DEBUGLOG && $log->debug(" found trackurl: $trackurl"); } + elsif ( $entry =~ /^#ADDEDFROMWORK:(.*?)$/ ) { + $addedFromWork = $1; + + main::DEBUGLOG && $log->debug(" found addedFromWork: $addedFromWork"); + } + next if $entry =~ /^#/; next if $entry =~ /#CURTRACK/; next if $entry eq ""; @@ -142,7 +148,7 @@ sub read { if ($class->playlistEntryIsValid($trackurl, $url)) { - push @items, $class->_item($trackurl, $artist, $album, $title, $secs, $url); + push @items, $class->_item($trackurl, $artist, $album, $title, $secs, $url, $addedFromWork); } else { @@ -154,7 +160,7 @@ sub read { if ($class->playlistEntryIsValid($trackurl, $url)) { - push @items, $class->_item($trackurl, $artist, $album, $title, $secs, $url); + push @items, $class->_item($trackurl, $artist, $album, $title, $secs, $url, $addedFromWork); last; } @@ -162,7 +168,7 @@ sub read { } # reset the title - ($secs, $artist, $album, $title, $trackurl) = (); + ($secs, $artist, $album, $title, $trackurl, $addedFromWork) = (); } if ( main::INFOLOG && $log->is_info ) { @@ -175,7 +181,7 @@ sub read { } sub _item { - my ($class, $trackurl, $artist, $album, $title, $secs, $playlistUrl) = @_; + my ($class, $trackurl, $artist, $album, $title, $secs, $playlistUrl, $addedFromWork) = @_; main::DEBUGLOG && $log->debug(" valid entry: $trackurl"); @@ -184,7 +190,9 @@ sub _item { 'ALBUM' => $album, 'ARTIST' => $artist, 'SECS' => ( defined $secs && $secs > 0 ) ? $secs : undef, - }, $playlistUrl ); + }, + $playlistUrl, + $addedFromWork ); } sub readCurTrackForM3U { @@ -285,6 +293,10 @@ sub write { if ($title) { print $output "#EXTINF:$secs,$title\n"; } + + if (my $addedFromWork = $track->added_from_work) { + print $output "#ADDEDFROMWORK:$addedFromWork\n"; + } } my $path = Slim::Utils::Unicode::utf8decode_locale( $class->_pathForItem($track->url) ); diff --git a/Slim/Formats/XML.pm b/Slim/Formats/XML.pm index e282336d857..d86df392484 100644 --- a/Slim/Formats/XML.pm +++ b/Slim/Formats/XML.pm @@ -769,13 +769,6 @@ sub unescapeAndTrim { # strip all markup tags $data =~ s/<[a-zA-Z\/][^>]*>//gi; - # the following taken from Rss News plugin, but apparently - # it results in an unnecessary decode, which actually causes problems - # and things seem to work fine without it, so commenting it out. - #if ($] >= 5.008) { - # utf8::decode($data); - #} - return $data; } diff --git a/Slim/GUI/ControlPanel.pm b/Slim/GUI/ControlPanel.pm deleted file mode 100644 index 7e38c59c1a9..00000000000 --- a/Slim/GUI/ControlPanel.pm +++ /dev/null @@ -1,516 +0,0 @@ -package Slim::GUI::ControlPanel::MainFrame; - -# Logitech Media Server Copyright 2001-2024 Logitech. -# Lyrion Music Server Copyright 2024 Lyrion Community. -# This program is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License, -# version 2. - -use strict; -use base 'Wx::Frame'; - -use Slim::Utils::Light; -use File::Spec::Functions; -use File::Slurp; - -use Wx qw(:everything); -use Wx::Event qw(EVT_BUTTON EVT_NOTEBOOK_PAGE_CHANGED); - -use Slim::GUI::ControlPanel::Settings; -use Slim::GUI::ControlPanel::Music; -use Slim::GUI::ControlPanel::Advanced; -use Slim::GUI::ControlPanel::Status; -use Slim::GUI::ControlPanel::Diagnostics; -use Slim::Utils::OSDetect; -use Slim::Utils::ServiceManager; - -use constant PAGE_STATUS => 3; -use constant PAGE_SCAN => 1; - -my $pollTimer; -my $btnOk; - -my $svcMgr = Slim::Utils::ServiceManager->new(); - -sub new { - my $ref = shift; - my $args = shift; - - Slim::Utils::OSDetect::init(); - - # if we're running for the first time, show the SN page - my $initialSetup = $svcMgr->isRunning() && !Slim::GUI::ControlPanel->getPref('wizardDone'); - - my $self = $ref->SUPER::new( - undef, - -1, - $initialSetup ? string('WELCOME_TO_SQUEEZEBOX_SERVER') : string('CONTROLPANEL_TITLE'), - [-1, -1], - main::ISWINDOWS ? [550, 610] : [700, 700], - wxMINIMIZE_BOX | wxMAXIMIZE_BOX | wxCAPTION | wxCLOSE_BOX | wxSYSTEM_MENU | wxRESIZE_BORDER, - 'WELCOME_TO_SQUEEZEBOX_SERVER' - ); - - my $file = $self->_fixIcon('SqueezeCenter.ico'); - if ($file && (my $icon = Wx::Icon->new($file, wxBITMAP_TYPE_ICO)) ) { - $self->SetIcon($icon); - } - - my $panel = Wx::Panel->new($self); - my $mainSizer = Wx::BoxSizer->new(wxVERTICAL); - - $pollTimer = Slim::GUI::ControlPanel::Timer->new(); - - $btnOk = Slim::GUI::ControlPanel::OkButton->new( $panel, wxID_OK, string('OK') ); - EVT_BUTTON( $self, $btnOk, sub { - $btnOk->do($svcMgr->checkServiceState()); - Slim::Utils::OS::Win32->cleanupTempDirs() if main::ISWINDOWS; - $_[0]->Destroy; - } ); - - my $notebook = Wx::Notebook->new($panel); - - EVT_NOTEBOOK_PAGE_CHANGED($self, $notebook, sub { - my ($self, $event) = @_; - - eval { - my $child = $notebook->GetPage($notebook->GetSelection()); - if ($child && $child->can('_update')) { - $child->_update($event); - }; - } - }); - - $notebook->AddPage(Slim::GUI::ControlPanel::Settings->new($notebook, $self), string('CONTROLPANEL_SERVERSTATUS'), 1); - $notebook->AddPage(Slim::GUI::ControlPanel::Music->new($notebook, $self), string('CONTROLPANEL_MUSIC_LIBRARY')); - $notebook->AddPage(Slim::GUI::ControlPanel::Advanced->new($notebook, $self, $args), string('ADVANCED_SETTINGS')); - $notebook->AddPage(Slim::GUI::ControlPanel::Diagnostics->new($notebook, $self, $args), string('CONTROLPANEL_DIAGNOSTICS')); - $notebook->AddPage(Slim::GUI::ControlPanel::Status->new($notebook, $self), string('INFORMATION')); - - $mainSizer->Add($notebook, 1, wxALL | wxGROW, 10); - - my $footerSizer = Wx::BoxSizer->new(wxHORIZONTAL); - - my $btnsizer = Wx::StdDialogButtonSizer->new(); - $btnsizer->AddButton($btnOk); - - if (!$initialSetup) { - my $btnApply = Wx::Button->new( $panel, wxID_APPLY, string('APPLY') ); - EVT_BUTTON( $self, $btnApply, sub { - $btnOk->do($svcMgr->checkServiceState()); - } ); - - $btnsizer->AddButton($btnApply); - } - - my $btnCancel = Wx::Button->new( $panel, wxID_CANCEL, string('CANCEL') ); - - EVT_BUTTON( $self, $btnCancel, sub { - Slim::Utils::OS::Win32->cleanupTempDirs() if main::ISWINDOWS; - $_[0]->Destroy; - } ); - - $btnsizer->AddButton($btnCancel); - - $btnsizer->Realize(); - - my $footerSizer2 = Wx::BoxSizer->new(wxVERTICAL); - $footerSizer2->Add($btnsizer, 0, wxEXPAND); - $footerSizer2->AddSpacer(7); - $footerSizer2->Add(Wx::StaticText->new($panel, -1, string('COPYRIGHT')), 0, wxALIGN_RIGHT | wxRIGHT, 3); - - my ($version) = parseRevision(); - $version = sprintf(string('VERSION'), $version); - $footerSizer2->Add(Wx::StaticText->new($panel, -1, $version), 0, wxALIGN_RIGHT | wxRIGHT, 3); - - $footerSizer->Add($footerSizer2, wxEXPAND); - $mainSizer->Add($footerSizer, 0, wxLEFT | wxRIGHT | wxGROW, 8); - - $panel->SetSizer($mainSizer); - - $pollTimer->Start(5000, wxTIMER_CONTINUOUS); - $pollTimer->Notify(); - - return $self; -} - -sub addApplyHandler { - my $self = shift; - $btnOk->addActionHandler(@_); -} - -sub addStatusListener { - my $self = shift; - $pollTimer->addListener(@_); -} - -sub checkServiceStatus { - $pollTimer->Notify(); -} - -sub _fixIcon { - my $self = shift; - my $iconFile = shift; - - return unless main::ISWINDOWS; - - # bug 12904 - Windows 2000 can't read hires icon file... - return if $iconFile =~ /.ico$/i && Slim::Utils::OSDetect::details->{osName} =~ /Windows 2000/i; - - # set the application icon - my $file = "../platforms/win32/res/$iconFile"; - - if (main::ISACTIVEPERL && defined $PerlApp::VERSION && !-f $file) { - $file = PerlApp::extract_bound_file($iconFile); - } - - else { - $file = $iconFile; - } - - return $file if -f $file; -} - -# stolen from Slim::Utils::Misc -sub parseRevision { - # The revision file may not exist for svn copies. - my $tempBuildInfo = eval { File::Slurp::read_file( - catdir(scalar Slim::Utils::OSDetect::dirsFor('revision'), 'revision.txt') - ) } || "TRUNK\nUNKNOWN"; - - # Once we've read the file, split it up so we have the Revision and Build Date - return split (/\n/, $tempBuildInfo); -} - -1; - - -# Our own timer object, checking for SC availability -package Slim::GUI::ControlPanel::Timer; - -use base 'Wx::Timer'; -use Slim::Utils::ServiceManager; - -my %listeners; - -sub addListener { - my ($self, $item, $callback) = @_; - - # if no callback is given, then enable the element if SC is running, or disable otherwise - $listeners{$item} = $callback || sub { $item->Enable($_[0] == SC_STATE_RUNNING) }; -} - -sub Notify { - my $status = $svcMgr->checkServiceState(); - - foreach my $listener (keys %listeners) { - - if (my $callback = $listeners{$listener}) { - &$callback($status); - } - } -} - -1; - - -# Ok button will apply our changes -package Slim::GUI::ControlPanel::OkButton; - -use base 'Wx::Button'; - -sub new { - my $self = shift; - - $self = $self->SUPER::new(@_); - $self->{actionHandlers} = {}; - $self->SetDefault(); - - return $self; -} - -sub addActionHandler { - my ($self, $item, $callback) = @_; - $self->{actionHandlers}->{$item} = $callback; -} - -sub do { - my ($self, $status) = @_; - - Slim::GUI::ControlPanel->setPref('wizardDone', 1); - - foreach my $actionHandler (keys %{ $self->{actionHandlers} }) { - - if (my $action = $self->{actionHandlers}->{$actionHandler}) { - &$action($status); - } - } -} - -1; - - -# The CleanupGUI main class -package Slim::GUI::ControlPanel; - -use base 'Wx::App'; -use Wx qw(:everything); -use LWP::UserAgent; -use JSON::XS::VersionOneAndTwo; - -use Slim::Utils::ServiceManager; - -my $args; - -my $credentials = {}; -my $needAuthentication; - -sub new { - my $self = shift; - $args = shift; - - $self = $self->SUPER::new(); - - return $self; -} - -sub OnInit { - my $self = shift; - my $frame; - - $frame = Slim::GUI::ControlPanel::MainFrame->new($args); - - $frame->Show( 1 ); -} - -# the following subs are static methods to deliver some commonly used services -my $baseUrl; -sub getBaseUrl { - my $self = shift; - my $update = shift; - - if ($update || !$baseUrl || time() > $baseUrl->{ttl}) { - $baseUrl = { - url => 'http://' . ( - $credentials && $credentials->{username} && $credentials->{password} - ? $credentials->{username} . ':' . $credentials->{password} . '@' - : '' - ) . '127.0.0.1:' . (Slim::Utils::Light::getPref('httpport') || 9000), - ttl => time() + 15, - }; - } - - return $baseUrl->{url}; -} - -sub setPref { - my ($self, $pref, $value) = @_; - - $self->serverRequest('pref', $pref, $value); -} - -sub getPref { - my ($self, $pref, $file) = @_; - $file ||= ''; - - my $value; - - # if SC is running, use the CLI, otherwise read the prefs file from disk - if ($svcMgr->isRunning()) { - - if ($file) { - $file =~ s/\.prefs$//; - $file = "plugin.$file:"; - } - - $value = $self->serverRequest('pref', $file . $pref, '?'); - - if (ref $value eq 'HASH' && $value->{msg} && $value->{msg} =~ /^500/i) { - $value = Slim::Utils::Light::getPref($pref, $file); - } - elsif (ref $value eq 'HASH') { - $value = $value->{'_p2'}; - } - } - - else { - $value = Slim::Utils::Light::getPref($pref, $file); - } - - return $value; -} - -sub string { - my ($self, $stringToken) = @_; - - my $string = Slim::Utils::Light::string($stringToken); - - # if SC is running, use the CLI, otherwise read the prefs file from disk - if ($string eq $stringToken && $svcMgr->isRunning()) { - - my $response = $self->serverRequest('getstring', $stringToken); - - if (ref $response eq 'HASH' && $response->{$stringToken} && $response->{$stringToken} ne $stringToken) { - $string = $response->{$stringToken}; - Slim::Utils::Light::setString($stringToken, $string); - } - } - - return $string; -} - -sub serverRequest { - my $self = shift; - my $postdata; - - return unless $svcMgr->isRunning(); - - eval { $postdata = '{"id":1,"method":"slim.request","params":["",' . to_json(\@_) . ']}' }; - - return if $@ || !$postdata; - - my $baseUrl = $self->getBaseUrl(); - $baseUrl =~ s|^http://||; - - my $req = HTTP::Request->new( - 'POST' => "http://$baseUrl/jsonrpc.js", - ); - $req->header('Content-Type' => 'text/plain'); - - $req->content($postdata); - - my $ua = LWP::UserAgent->new(); - $ua->timeout(2); - - if ($credentials && $credentials->{username} && $credentials->{password}) { - $ua->credentials($baseUrl, Slim::Utils::Light::string('SQUEEZEBOX_SERVER'), $credentials->{username}, $credentials->{password}); - } - - return if $needAuthentication; - - my $response = $ua->request($req); - - # check whether authentication is needed - while ($response->code == 401) { - - $needAuthentication = 1; - - my $loginDialog = Slim::GUI::ControlPanel::LoginDialog->new(); - - if ($loginDialog->ShowModal() == wxID_OK) { - - $credentials = { - username => $loginDialog->username, - password => $loginDialog->password, - }; - - $ua->credentials($baseUrl, Slim::Utils::Light::string('SQUEEZEBOX_SERVER'), $credentials->{username}, $credentials->{password}); - - $response = $ua->request($req); - } - - else { - exit; - } - - $loginDialog->Destroy(); - } - - $needAuthentication = 0; - - my $content; - $content = $response->decoded_content if ($response); - - if ($content) { - eval { - $content = from_json($content); - $content = $content->{result}; - } - } - - return ref $content eq 'HASH' ? $content : { msg => $content }; -} - -1; - - -# Ok button will apply our changes -package Slim::GUI::ControlPanel::LoginDialog; - -use base 'Wx::Dialog'; -use Wx qw(:everything); -use Slim::Utils::Light; - -my ($username, $password); - -sub new { - my $self = shift; - - $self = $self->SUPER::new(undef, -1, string('LOGIN'), [-1, -1], [350, 220], wxDEFAULT_DIALOG_STYLE); - - my $mainSizer = Wx::BoxSizer->new(wxVERTICAL); - - $mainSizer->Add(Wx::StaticText->new($self, -1, string('CONTROLPANEL_AUTHENTICATION_REQUIRED')), 0, wxALL, 10); - - $mainSizer->Add(Wx::StaticText->new($self, -1, string('SETUP_USERNAME') . string('COLON')), 0, wxLEFT | wxRIGHT, 10); - $username = Wx::TextCtrl->new($self, -1, '', [-1, -1], [320, -1]); - $mainSizer->Add($username, 0, wxALL, 10); - - $mainSizer->Add(Wx::StaticText->new($self, -1, string('SETUP_PASSWORD') . string('COLON')), 0, wxLEFT | wxRIGHT, 10); - $password = Wx::TextCtrl->new($self, -1, '', [-1, -1], [320, -1], wxTE_PASSWORD); - $mainSizer->Add($password, 0, wxALL, 10); - - $mainSizer->AddStretchSpacer(); - - my $btnsizer = Wx::StdDialogButtonSizer->new(); - $btnsizer->AddButton(Wx::Button->new($self, wxID_OK, string('OK'))); - $btnsizer->AddButton(Wx::Button->new($self, wxID_CANCEL, string('CANCEL'))); - $btnsizer->Realize(); - $mainSizer->Add($btnsizer, 0, wxALL | wxGROW, 10); - - $self->SetSizer($mainSizer); - - $self->Centre(); - - return $self; -} - -sub username { - return $username->GetValue(); -} - - -sub password { - return $password->GetValue(); -} - -1; - - -package Slim::GUI::WebButton; - -use base 'Wx::Button'; - -use Wx qw(:everything); -use Wx::Event qw(EVT_BUTTON); - -use Slim::GUI::ControlPanel; -use Slim::Utils::Light; - -sub new { - my ($self, $page, $parent, $url, $label, $width) = @_; - - $self = $self->SUPER::new($page, -1, string($label), [-1, -1], [$width || -1, -1]); - - $parent->addStatusListener($self); - - $url = Slim::GUI::ControlPanel->getBaseUrl() . $url; - - EVT_BUTTON( $page, $self, sub { - Wx::LaunchDefaultBrowser($url); - }); - - return $self; -} - -1; diff --git a/Slim/GUI/ControlPanel/Advanced.pm b/Slim/GUI/ControlPanel/Advanced.pm deleted file mode 100644 index c55057968bd..00000000000 --- a/Slim/GUI/ControlPanel/Advanced.pm +++ /dev/null @@ -1,290 +0,0 @@ -package Slim::GUI::ControlPanel::Advanced; - -# Logitech Media Server Copyright 2001-2024 Logitech. -# Lyrion Music Server Copyright 2024 Lyrion Community. -# This program is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License, -# version 2. - -use strict; -use base 'Wx::Panel'; - -use Wx qw(:everything); -use Wx::Event qw(EVT_BUTTON EVT_TIMER); -use File::Spec::Functions qw(catfile); - -use Slim::Utils::Light; -use Slim::Utils::ServiceManager; -use Slim::Utils::OSDetect; - -my $os = Slim::Utils::OSDetect::getOS(); - -if (main::ISWINDOWS) { - require Win32::Process; - - if (0) { - require 'auto/Win32/Process/List/autosplit.ix'; - } -} - -my %checkboxes; - -sub new { - my ($self, $nb, $parent, $args) = @_; - - $self = $self->SUPER::new($nb); - $self->{args} = $args; - - my $mainSizer = Wx::BoxSizer->new(wxVERTICAL); - - if (main::ISWINDOWS) { - - # check for SC updates - my $updateSizer = Wx::StaticBoxSizer->new( - Wx::StaticBox->new($self, -1, string('SETUP_CHECKVERSION')), - wxVERTICAL - ); - - my $updateLabel = Wx::StaticText->new($self, -1, ''); - $updateSizer->Add($updateLabel, 0, wxLEFT | wxRIGHT | wxTOP | wxGROW, 10); - - # update button - my $btnUpdate = Wx::Button->new($self, -1, string('CONTROLPANEL_INSTALL_UPDATE')); - - EVT_BUTTON( $self, $btnUpdate, sub { - - if (my $installer = Slim::Utils::Light->checkForUpdate()) { - - Slim::Utils::Light->resetUpdateCheck(); - - my $processObj; - Win32::Process::Create( - $processObj, - $installer, - '', - 0, - Win32::Process::DETACHED_PROCESS() | Win32::Process::CREATE_NO_WINDOW() | Win32::Process::NORMAL_PRIORITY_CLASS(), - '.' - ) && exit; - - } - - }); - - $updateSizer->Add($btnUpdate, 0, wxALL, 10); - - $mainSizer->Add($updateSizer, 0, wxALL | wxGROW, 10); - - my $updateChecker = Wx::Timer->new($self, 1); - EVT_TIMER( $self, 1, sub { - my $ready = Slim::Utils::Light->checkForUpdate(); - $updateLabel->SetLabel( string($ready ? 'CONTROLPANEL_UPDATE_AVAILABLE' : 'CONTROLPANEL_NO_UPDATE_AVAILABLE') ); - $btnUpdate->Enable($ready); - - # check every five minutes - $updateChecker->Start(0.5 * 60 * 1000); - }); - $updateChecker->Start(500); - } - - - my $webSizer = Wx::StaticBoxSizer->new( - Wx::StaticBox->new($self, -1, string('CONTROLPANEL_WEB_UI')), - wxVERTICAL - ); - - $webSizer->Add( Slim::GUI::WebButton->new($self, $parent, '/', 'CONTROLPANEL_WEB_CONTROL_DESC', 250) , 0, wxLEFT | wxTOP, 10 ); - $webSizer->Add( Slim::GUI::WebButton->new($self, $parent, '/settings/index.html', 'CONTROLPANEL_ADVANCED_SETTINGS_DESC', 250) , 0, wxALL, 10 ); - - $mainSizer->Add($webSizer, 0, wxALL | wxGROW, 10); - - - my $logSizer = Wx::StaticBoxSizer->new( - Wx::StaticBox->new($self, -1, string('CONTROLPANEL_LOGFILES')), - wxVERTICAL - ); - - my $logBtnSizer = Wx::BoxSizer->new(wxHORIZONTAL); - - $logBtnSizer->Add(Slim::GUI::ControlPanel::LogLink->new($self, $parent, 'server.log', 'CONTROLPANEL_SHOW_SERVER_LOG')); - $logBtnSizer->Add(Slim::GUI::ControlPanel::LogLink->new($self, $parent, 'scanner.log', 'CONTROLPANEL_SHOW_SCANNER_LOG'), 0, wxLEFT, 10); - - $logSizer->Add($logBtnSizer, 0, wxALL, 10); - - $logSizer->Add(Slim::GUI::ControlPanel::LogOptions->new($self, $parent), 0, wxLEFT | wxBOTTOM, 10); - - $mainSizer->Add($logSizer, 0, wxALL | wxGROW, 10); - - - my $cleanupSizer = Wx::StaticBoxSizer->new( - Wx::StaticBox->new($self, -1, string('CLEANUP')), - wxVERTICAL - ); - - $cleanupSizer->AddSpacer(5); - - foreach (@{ $args->{options} }) { - - # support only wants these three options - next unless $_->{name} =~ /^(?:prefs|cache)$/; - - $checkboxes{$_->{name}} = Wx::CheckBox->new( $self, -1, $_->{title}, $_->{position}); - $cleanupSizer->AddSpacer(5); - $cleanupSizer->Add($checkboxes{$_->{name}}, 0, wxLEFT, 10); - } - - my $btnCleanup = Wx::Button->new( $self, -1, string('CLEANUP_DO') ); - EVT_BUTTON( $self, $btnCleanup, \&doCleanup ); - - $cleanupSizer->Add($btnCleanup, 0, wxALL , 10); - - $mainSizer->Add($cleanupSizer, 0, wxALL | wxGROW, 10); - - $self->SetSizer($mainSizer); - - return $self; -} - -sub doCleanup { - my( $self, $event ) = @_; - - # return if no option was selected - return unless grep { $checkboxes{$_}->GetValue() } keys %checkboxes; - - my $svcMgr = Slim::Utils::ServiceManager->new(); - - if ($svcMgr->checkServiceState() == SC_STATE_RUNNING) { - - my $msg = Wx::MessageDialog->new($self, string('CLEANUP_WANT_TO_STOP_SC'), string('CLEANUP_DO'), wxYES_NO | wxNO_DEFAULT | wxICON_QUESTION); - - if ($msg->ShowModal() == wxID_YES) { - # stop SC before continuing - Slim::GUI::ControlPanel->serverRequest('stopserver'); - - # wait while SC is being shut down - my $wait = 59; - while ($svcMgr->checkServiceState != SC_STATE_STOPPED && $wait > 0) { - sleep 5; - $wait -= 5; - } - } - else { - # don't do anything - return; - } - } - - my $params = {}; - my $selected = 0; - - foreach (@{ $self->{args}->{options} }) { - - next unless $checkboxes{$_->{name}}; - - $params->{$_->{name}} = $checkboxes{$_->{name}}->GetValue(); - $selected ||= $checkboxes{$_->{name}}->GetValue(); - } - - if ($selected) { - Wx::BusyCursor->new(); - - my $folders = $self->{args}->{folderCB}($params); - - $self->{args}->{cleanCB}($folders) if $folders; - } -} - -1; - - -package Slim::GUI::ControlPanel::LogLink; - -use base 'Wx::Button'; - -use Wx qw(:everything); -use Wx::Event qw(EVT_BUTTON); -use File::Spec::Functions qw(catfile); - -use Slim::GUI::ControlPanel; -use Slim::Utils::Light; - -sub new { - my ($self, $page, $parent, $file, $label, $width) = @_; - - $self = $self->SUPER::new($page, -1, string($label), [-1, -1], [$width || -1, -1]); - - EVT_BUTTON( $page, $self, sub { - Wx::LaunchDefaultBrowser('file://' . $os->dirsFor('log') . "/$file"); - }); - - return $self; -} - -1; - - -package Slim::GUI::ControlPanel::LogOptions; - -use base 'Wx::Choice'; - -use Wx qw(:everything); -use File::Spec::Functions qw(catfile); - -use Slim::GUI::ControlPanel; -use Slim::Utils::Light; -use Slim::Utils::Log; -use Slim::Utils::ServiceManager; - -my $logGroups; - -sub new { - my ($self, $page, $parent) = @_; - - $logGroups = Slim::Utils::Log->logGroups(); - - my @logOptions = (string('DEBUG_DEFAULT')); - - my $x = 1; - foreach my $group (keys %$logGroups) { - - $logGroups->{$group}->{index} = $x; - push @logOptions, string($logGroups->{$group}->{label}); - - $x++; - } - - $parent->addApplyHandler($self, sub { - $self->save(@_); - }); - - $self = $self->SUPER::new($page, -1, [-1, -1], [-1, -1], \@logOptions); - - return $self; -} - - -sub save { - my $self = shift; - my $state = shift; - - my $selected = $self->GetSelection(); - my ($group) = grep { $logGroups->{$_}->{index} == $selected } keys %$logGroups; - - $group ||= 'default'; - - if ($state == SC_STATE_RUNNING) { - Slim::GUI::ControlPanel->serverRequest('logging', "group:$group"); - } - else { - Slim::Utils::Log->init({ - 'logconf' => catfile(scalar Slim::Utils::OSDetect::dirsFor('prefs'), 'log.conf'), - 'logtype' => 'server', - }) unless Slim::Utils::Log->isInitialized(); - - Slim::Utils::Log->setLogGroup($group, 1); - - Slim::Utils::Log->writeConfig(); - } -} - -1; \ No newline at end of file diff --git a/Slim/GUI/ControlPanel/Diagnostics.pm b/Slim/GUI/ControlPanel/Diagnostics.pm deleted file mode 100644 index d61daa9d524..00000000000 --- a/Slim/GUI/ControlPanel/Diagnostics.pm +++ /dev/null @@ -1,318 +0,0 @@ -package Slim::GUI::ControlPanel::Diagnostics; - -# Logitech Media Server Copyright 2001-2024 Logitech. -# Lyrion Music Server Copyright 2024 Lyrion Community. -# This program is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License, -# version 2. - -use strict; -use base 'Wx::Panel'; - -use Wx qw(:everything); -use Wx::Event qw(EVT_BUTTON); - -use Net::Ping; -use Socket; -use Symbol; - -use Slim::Utils::Light; -use Slim::Utils::ServiceManager; - -my $svcMgr = Slim::Utils::ServiceManager->new(); - -my @checks; -my $cache; -my $alertBox; - -sub new { - my ($self, $nb) = @_; - - $self = $self->SUPER::new($nb); - - my $mainSizer = Wx::BoxSizer->new(wxVERTICAL); - - $alertBox = Wx::TextCtrl->new($self, -1, '', [-1, -1], [-1, 90], wxTE_MULTILINE | wxTE_READONLY | wxTE_RICH | wxTE_RICH2 | wxTE_AUTO_URL); - - my $scBoxSizer = Wx::StaticBoxSizer->new( - Wx::StaticBox->new($self, -1, string('SQUEEZEBOX_SERVER')), - wxVERTICAL - ); - my $scSizer = Wx::FlexGridSizer->new(0, 2, 5, 10); - $scSizer->AddGrowableCol(0, 2); - $scSizer->AddGrowableCol(1, 1); - $scSizer->SetFlexibleDirection(wxHORIZONTAL); - - $self->_addItem($scSizer, string('SQUEEZEBOX_SERVER') . string('COLON'), sub { - $_[0] ? string('RUNNING') : string('STOPPED'); - }); - $self->_addItem($scSizer, string('INFORMATION_SERVER_IP') . string('COLON'), \&getHostIP); - $self->_addItem($scSizer, string('CONTROLPANEL_PORTNO', '', '3483', 'slimproto'), sub { - checkPort(getHostIP(), '3483', $_[0]); - }); - - my $httpPort = Slim::GUI::ControlPanel->getPref('httpport') || 9000; - $self->_addItem($scSizer, string('CONTROLPANEL_PORTNO', '', $httpPort, 'HTTP'), sub { - my $isRunning = shift; - my ($state, $stateString) = checkPort(getHostIP(), $httpPort, 1); - - # check failed - let's try to figure out why - if ($isRunning && !$state) { - $alertBox->AppendText(string('CONTROLPANEL_PORTBLOCKED', '', $httpPort)); - - # server running, but not accessible -> firewall? - if (main::ISWINDOWS && (my $conflicts = $self->getConflictingApp('Firewall'))) { - $alertBox->AppendText(string('CONTROLPANEL_PORTBLOCKED_APPS')); - - foreach (keys %$conflicts) { - my $conflict = $conflicts->{$_}; - - $alertBox->AppendText("\n* " . ($conflict->{ProgramName} || $conflict->{ProgramName})); - $alertBox->AppendText(string('COLON') . ' ' . string('CONTROLPANEL_CONFLICT_' . uc($conflict->{Help}))) if $conflict->{Help}; - } - - $alertBox->AppendText("\n\n"); - } - } - - elsif (!$isRunning && $state) { - $alertBox->AppendText(string('CONTROLPANEL_PORTCONFLICT', '', $httpPort)); - - # server not running, but port open -> other application using it? - if (main::ISWINDOWS && (my $conflicts = $self->getConflictingApp('PortConflict'))) { - - foreach (keys %$conflicts) { - my $conflict = $conflicts->{$_}; - - if ($conflict->{Port} == $httpPort || $conflict->{ServiceName} eq 'Perl') { - $alertBox->AppendText("\n* " . ($conflict->{ProgramName} || $conflict->{ProgramName})); - $alertBox->AppendText(string('COLON') . ' ' . string('CONTROLPANEL_CONFLICT_' . uc($conflict->{Help}))) if $conflict->{Help}; - } - } - - $alertBox->AppendText("\n\n"); - } - - } - - # on Windows we want to look out for other potential offenders... - elsif (main::ISWINDOWS && !$isRunning && (my $conflicts = $self->getConflictingApp('Other'))) { - $alertBox->AppendText(string('CONTROLPANEL_OTHER_ISSUE')); - - foreach (keys %$conflicts) { - my $conflict = $conflicts->{$_}; - - $alertBox->AppendText("\n* " . ($conflict->{ProgramName} || $conflict->{ProgramName})); - $alertBox->AppendText(string('COLON') . ' ' . string('CONTROLPANEL_OTHER_ISSUE_' . uc($conflict->{Help}))) if $conflict->{Help}; - } - - $alertBox->AppendText("\n\n"); - - } - - return $stateString; - }); - - my $cliPort = Slim::GUI::ControlPanel->getPref('cliport', 'cli.prefs') || 9090; - $self->_addItem($scSizer, string('CONTROLPANEL_PORTNO', '', $cliPort, 'CLI'), sub { - checkPort(getHostIP(), $cliPort, $_[0]); - }); - - $scBoxSizer->Add($scSizer, 0, wxALL | wxGROW, 10); - $mainSizer->Add($scBoxSizer, 0, wxALL | wxGROW, 10); - - - my $alertBoxSizer = Wx::StaticBoxSizer->new( - Wx::StaticBox->new($self, -1, string('CONTROLPANEL_ALERTS')), - wxVERTICAL - ); - - $alertBoxSizer->Add($alertBox, 0, wxALL | wxGROW, 10); - - $mainSizer->Add($alertBoxSizer, 0, wxALL | wxEXPAND, 10); - - - my $btnRefresh = Wx::Button->new( $self, -1, string('CONTROLPANEL_REFRESH') ); - EVT_BUTTON( $self, $btnRefresh, sub { - $self->_update(); - } ); - - $mainSizer->Add($btnRefresh, 0, wxALL, 10); - - $self->SetSizer($mainSizer); - - return $self; -} - -sub _addItem { - my ($self, $sizer, $label, $checkCB) = @_; - - $sizer->Add(Wx::StaticText->new($self, -1, string($label))); - - my $labelText = Wx::StaticText->new($self, -1, '', [-1, -1], [-1, -1], wxALIGN_RIGHT); - push @checks, { - label => $labelText, - cb => ref $checkCB eq 'CODE' ? $checkCB : sub { $checkCB }, - }; - - $sizer->Add($labelText); -} - -sub _update { - my ($self, $event) = @_; - - $alertBox->SetValue(''); - foreach my $check (@checks) { - - if ($check->{label}) { - $check->{label}->SetLabel(''); - $self->Layout(); - } - } - - $self->Update; - - my $isRunning = $svcMgr->checkServiceState() == SC_STATE_RUNNING; - - foreach my $check (@checks) { - - if (defined $check->{cb} && $check->{cb}) { - eval { - my $val = &{$check->{cb}}($isRunning); - $check->{label}->SetLabel($val || 'n/a') if $check->{label}; - - $self->Layout(); - }; - - print "$@" if $@; - } - } - - $alertBox->ShowPosition(0); - $self->Layout(); -} - -sub getConflictingApp { - my ($self, $type) = @_; - - return unless main::ISWINDOWS; - - require XML::Simple; - require Win32::Service; - require Win32::Process::List; - - my $file = "../platforms/win32/installer/ApplicationData.xml"; - - if (!-f $file && defined $PerlApp::VERSION) { - $file = PerlApp::extract_bound_file('ApplicationData.xml'); - } - - else { - $file = "ApplicationData.xml"; - } - - return if !-f $file; - - my $ref = XML::Simple::XMLin($file); - - return unless $ref->{'d:Culture'}->{'d:process'}; - - # create list of apps of the wanted type - my (%apps, $conflicingApps); - map { $apps{$_->{ServiceName}} = $_ } - grep { $_->{type} eq $type } - @{ $ref->{'d:Culture'}->{'d:process'} }; - - foreach (keys %apps) { - my %status; - if (Win32::Service::GetStatus('.', $_, \%status)) { - $conflicingApps->{$_} = $apps{$_}; - } - } - - my $p = Win32::Process::List->new; - if ($p->IsError != 1) { - my %processes = $p->GetProcesses(); - - foreach my $process ( grep { !$conflicingApps->{$_} } keys %apps ) { - if (grep { $processes{$_} =~ /^$process\b/i } keys %processes) { - $conflicingApps->{$process} = $apps{$process}; - } - } - } - - return $conflicingApps; -} - -sub getHostIP { - return $cache->{SC}->{IP} if $cache->{SC} && $cache->{SC}->{ttl} < time; - - # Thanks to trick from Bill Fenner, trying to use a UDP socket won't - # send any packets out over the network, but will cause the routing - # table to do a lookup, so we can find our address. Don't use a high - # level abstraction like IO::Socket, as it dies when connect() fails. - # - # time.nist.gov - though it doesn't really matter. - my $raddr = '192.43.244.18'; - my $rport = 123; - - my $proto = (getprotobyname('udp'))[2]; - my $pname = (getprotobynumber($proto))[0]; - my $sock = Symbol::gensym(); - - my $iaddr = inet_aton($raddr) || return; - my $paddr = sockaddr_in($rport, $iaddr); - socket($sock, PF_INET, SOCK_DGRAM, $proto) || return; - connect($sock, $paddr) || return; - - # Find my half of the connection - my ($port, $address) = sockaddr_in( (getsockname($sock))[0] ); - - my $scAddress; - $scAddress = inet_ntoa($address) if $address; - - $cache->{SC} = { - ttl => time() + 60, - IP => $scAddress, - } ; - - return $scAddress; -} - -sub checkPort { - my ($raddr, $rport, $serviceState) = @_; - - return (wantarray ? (0, string('CONTROLPANEL_FAILED')) : string('CONTROLPANEL_FAILED')) unless $raddr && $rport && $serviceState; - - my $iaddr = inet_aton($raddr); - my $paddr = sockaddr_in($rport, $iaddr); - - socket(SSERVER, PF_INET, SOCK_STREAM, getprotobyname('tcp')); - - if (connect(SSERVER, $paddr)) { - - close(SSERVER); - return wantarray ? (1, string('CONTROLPANEL_OK')) : string('CONTROLPANEL_OK'); - } - - return wantarray ? (0, string('CONTROLPANEL_FAILED')) : string('CONTROLPANEL_FAILED'); -} - -sub checkPing { - my ($host, $port, $serviceState) = @_; - - return (wantarray ? (0, string('CONTROLPANEL_FAILED')) : string('CONTROLPANEL_FAILED')) unless $host && $serviceState; - - my $p = Net::Ping->new('tcp', 2); - - $p->{port_num} = $port if $port; - - my @result = ($p->ping($host) ? 1 : 0); - push @result, string($p->ping($host) ? 'CONTROLPANEL_OK' : 'CONTROLPANEL_FAILED'); - $p->close(); - - return wantarray ? @result : $result[1]; -} - - -1; \ No newline at end of file diff --git a/Slim/GUI/ControlPanel/Music.pm b/Slim/GUI/ControlPanel/Music.pm deleted file mode 100644 index 8a0a842b082..00000000000 --- a/Slim/GUI/ControlPanel/Music.pm +++ /dev/null @@ -1,183 +0,0 @@ -package Slim::GUI::ControlPanel::Music; - -# Logitech Media Server Copyright 2001-2024 Logitech. -# Lyrion Music Server Copyright 2024 Lyrion Community. -# This program is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License, -# version 2. - -use strict; -use base 'Wx::Panel'; - -use Wx qw(:everything); -use Wx::Event qw(EVT_BUTTON EVT_CHOICE); - -use Slim::Utils::Light; -use Slim::Utils::ServiceManager; - -sub new { - my ($self, $nb, $parent) = @_; - - $self = $self->SUPER::new($nb); - - my $svcMgr = Slim::Utils::ServiceManager->new(); - - my $mainSizer = Wx::BoxSizer->new(wxVERTICAL); - - $mainSizer->Add($self->getLibraryName($parent), 0, wxALL | wxGROW, 10); - - my $settingsSizer = Wx::StaticBoxSizer->new( - Wx::StaticBox->new($self, -1, string('MEDIASOURCE')), - wxVERTICAL - ); - - # folder selectors - $settingsSizer->Add(Wx::StaticText->new($self, -1, string('SETUP_MEDIADIRS')), 0, wxLEFT | wxTOP, 10); - - my $mediaDirsSizer = Wx::BoxSizer->new(wxVERTICAL); - my $dirsBtnSizer = Wx::BoxSizer->new(wxHORIZONTAL); - - my $dirsList = Wx::ListBox->new($self, -1, wxDefaultPosition, wxDefaultSize, [], wxLB_EXTENDED); - my $mediadirs = Slim::GUI::ControlPanel->getPref('mediadirs'); - if ($mediadirs && ref $mediadirs eq 'ARRAY') { - $dirsList->InsertItems($mediadirs, 0); - } - $mediaDirsSizer->Add($dirsList, 0, wxGROW, 10); - - my $btnAdd = Wx::Button->new($self, -1, string('ADD')); - $parent->addStatusListener($btnAdd); - $dirsBtnSizer->Add($btnAdd, 0); - $dirsBtnSizer->AddSpacer(5); - - my $btnRemove = Wx::Button->new($self, -1, string('DELETE')); - $parent->addStatusListener($btnRemove); - $dirsBtnSizer->Add($btnRemove, 0); - - $mediaDirsSizer->Add($dirsBtnSizer, 0, wxTOP, 5); - $settingsSizer->AddSpacer(5); - $settingsSizer->Add($mediaDirsSizer, 0, wxGROW | wxLEFT | wxRIGHT, 10); - - EVT_BUTTON($self, $btnAdd, sub { - my $dirsSelector = Wx::DirDialog->new($self); - if ($dirsSelector->ShowModal() == wxID_OK) { - if (my $path = $dirsSelector->GetPath()) { - $dirsList->Append($path); - } - } - }); - - EVT_BUTTON($self, $btnRemove, sub { - my @selected = $dirsList->GetSelections(); - foreach (reverse sort @selected) { - $dirsList->Delete($_); - } - }); - - $parent->addApplyHandler($self, sub { - my $running = (shift == SC_STATE_RUNNING); - - my @mediaDirs = $dirsList->GetStrings(); - - if ($running && scalar @mediaDirs) { - Slim::GUI::ControlPanel->setPref('mediadirs', \@mediaDirs); - } - }); - - - $settingsSizer->Add(Wx::StaticText->new($self, -1, string('SETUP_PLAYLISTDIR')), 0, wxLEFT | wxTOP, 10); - $settingsSizer->AddSpacer(5); - $settingsSizer->Add( - Slim::GUI::ControlPanel::DirPicker->new($self, $parent, 'playlistdir', 'SETUP_PLAYLISTDIR'), - 0, wxEXPAND | wxLEFT | wxBOTTOM | wxRIGHT, 10 - ); - - my $iTunes = getPref('iTunes', 'state.prefs'); - my $useItunesStr = ($svcMgr->checkServiceState() == SC_STATE_RUNNING) - ? Slim::GUI::ControlPanel->serverRequest('getstring', 'USE_ITUNES') - : {}; - - if ($useItunesStr && $useItunesStr->{USE_ITUNES} && (!$iTunes || $iTunes !~ /disabled/i)) { - - my $useItunes = Wx::CheckBox->new($self, -1, $useItunesStr->{USE_ITUNES}); - - $settingsSizer->Add($useItunes, 0, wxEXPAND | wxALL, 10); - $parent->addStatusListener($useItunes); - $useItunes->SetValue(Slim::GUI::ControlPanel->getPref('itunes', 'itunes.prefs')); - - $parent->addApplyHandler($useItunes, sub { - if (shift == SC_STATE_RUNNING) { - Slim::GUI::ControlPanel->setPref('plugin.itunes:itunes', $useItunes->IsChecked() ? 1 : 0); - } - }); - } - - $mainSizer->Add($settingsSizer, 0, wxALL | wxEXPAND, 10); - - $self->SetSizer($mainSizer); - - return $self; -} - - -sub getLibraryName { - my ($self, $parent) = @_; - - my $musicLibrarySizer = Wx::StaticBoxSizer->new( - Wx::StaticBox->new($self, -1, string('SETUP_LIBRARY_NAME')), - wxVERTICAL - ); - - $musicLibrarySizer->Add(Wx::StaticText->new($self, -1, string('SETUP_LIBRARY_NAME_DESC')), 0, wxLEFT | wxTOP, 10); - $musicLibrarySizer->AddSpacer(5); - my $libraryname = Wx::TextCtrl->new($self, -1, Slim::GUI::ControlPanel->getPref('libraryname') || '', [-1, -1], [300, -1]); - $musicLibrarySizer->Add($libraryname, 0, wxLEFT | wxBOTTOM | wxRIGHT | wxGROW, 10); - - $parent->addStatusListener($libraryname); - $parent->addApplyHandler($libraryname, sub { - if (shift == SC_STATE_RUNNING) { - Slim::GUI::ControlPanel->setPref('libraryname', $libraryname->GetValue()); - } - }); - - return $musicLibrarySizer; -} - -1; - - -package Slim::GUI::ControlPanel::DirPicker; - -use base 'Wx::DirPickerCtrl'; - -use Wx qw(:everything); - -use Slim::Utils::Light; -use Slim::Utils::OSDetect; -use Slim::Utils::ServiceManager; - -sub new { - my ($self, $page, $parent, $pref, $title) = @_; - - $self = $self->SUPER::new( - $page, - -1, - Slim::GUI::ControlPanel->getPref($pref) || '', - string($title), - wxDefaultPosition, wxDefaultSize, wxPB_USE_TEXTCTRL | wxDIRP_DIR_MUST_EXIST - ); - - $parent->addApplyHandler($self, sub { - my $running = (shift == SC_STATE_RUNNING); - - my $path = $self->GetPath; - if ($running && $path ne Slim::GUI::ControlPanel->getPref($pref)) { - Slim::GUI::ControlPanel->setPref($pref, $path); - } - }); - - $parent->addStatusListener($self); - - return $self; -} - -1; diff --git a/Slim/GUI/ControlPanel/Settings.pm b/Slim/GUI/ControlPanel/Settings.pm deleted file mode 100644 index 1be042d14f4..00000000000 --- a/Slim/GUI/ControlPanel/Settings.pm +++ /dev/null @@ -1,432 +0,0 @@ -package Slim::GUI::ControlPanel::Settings; - -# Logitech Media Server Copyright 2001-2024 Logitech. -# Lyrion Music Server Copyright 2024 Lyrion Community. -# This program is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License, -# version 2. - -use strict; -use base 'Wx::Panel'; - -use Encode; -use Wx qw(:everything); -use Wx::Event qw(EVT_BUTTON EVT_CHOICE EVT_TEXT); - -use Slim::GUI::ControlPanel; -use Slim::Utils::Light; -use Slim::Utils::ServiceManager; - -my ($progressPoll, $btnRescan, $setStartupMode, $setStartupModeHandler); - -sub new { - my ($self, $nb, $parent) = @_; - - $self = $self->SUPER::new($nb); - - my $svcMgr = Slim::Utils::ServiceManager->new(); - - my $mainSizer = Wx::BoxSizer->new(wxVERTICAL); - - my ($noAdminWarning, @startupOptions) = $svcMgr->getStartupOptions(); - - if ($noAdminWarning) { - my $string = string($noAdminWarning); - $string =~ s/\\n/\n/g; - - my $warning = Wx::StaticText->new($self, -1, $string); - $warning->SetForegroundColour(wxRED); - my ($width) = $parent->GetSizeWH(); - $warning->Wrap($width - 70) if $width && $width > 200; - $mainSizer->Add($warning, 0, wxALL, 10); - } - - - my $statusSizer = Wx::StaticBoxSizer->new( - Wx::StaticBox->new($self, -1, string('CONTROLPANEL_SERVERSTATUS')), - wxVERTICAL - ); - - my $statusLabel = Wx::StaticText->new($self, -1, ''); - $statusSizer->Add($statusLabel, 0, wxALL, 10); - - $parent->addStatusListener($statusLabel, sub { - my $state = shift; - - if ($state == SC_STATE_STOPPED) { - $statusLabel->SetLabel(string('CONTROLPANEL_STATUS_STOPPED')); - } - elsif ($state == SC_STATE_RUNNING) { - $statusLabel->SetLabel(string('CONTROLPANEL_STATUS_RUNNING')); - } - elsif ($state == SC_STATE_STARTING) { - $statusLabel->SetLabel(string('CONTROLPANEL_STATUS_STARTING')); - } - - }); - - # Start/Stop button - my $btnStartStop = Wx::Button->new($self, -1, string('STOP_SQUEEZEBOX_SERVER')); - - $parent->addStatusListener($btnStartStop, sub { - $btnStartStop->SetLabel($_[0] == SC_STATE_RUNNING ? string('STOP_SQUEEZEBOX_SERVER') : string('START_SQUEEZEBOX_SERVER')); - $btnStartStop->Enable( ($_[0] == SC_STATE_RUNNING || $_[0] == SC_STATE_STOPPED || $_[0] == SC_STATE_UNKNOWN) && ($_[0] == SC_STATE_STOPPED ? $svcMgr->canStart : 1) ); - $btnStartStop->SetSize( $btnStartStop->GetBestSize() ); - }); - $statusSizer->Add($btnStartStop, 0, wxLEFT, 10); - - my $cbStartSafeMode = Wx::CheckBox->new($self, -1, string('RUN_FAILSAFE')); - $parent->addStatusListener($cbStartSafeMode, sub { - $cbStartSafeMode->Enable( $_[0] == SC_STATE_STOPPED ); - }); - $statusSizer->Add($cbStartSafeMode, 0, wxLEFT | wxTOP | wxBOTTOM, 10); - - # check box if server is running in failsafe mode - $cbStartSafeMode->SetValue( $svcMgr->checkServiceState() == SC_STATE_RUNNING && Slim::GUI::ControlPanel->getPref('failsafe') ); - - @startupOptions = map { string($_) } @startupOptions; - my $lbStartupMode = Wx::Choice->new($self, -1, [-1, -1], [-1, -1], \@startupOptions); - - EVT_CHOICE($self, $lbStartupMode, sub { - $setStartupMode = 1; - }); - - EVT_BUTTON( $self, $btnStartStop, sub { - if ($svcMgr->checkServiceState() == SC_STATE_RUNNING) { - Slim::GUI::ControlPanel->serverRequest('stopserver'); - } - - # starting SC is heavily platform dependant - else { - &$setStartupModeHandler() if $setStartupModeHandler; - $svcMgr->start($cbStartSafeMode->IsChecked() ? '--failsafe --debug server=debug,server.plugins=debug --d_startup' : undef); - $parent->checkServiceStatus(); - } - }); - - $mainSizer->Add($statusSizer, 0, wxALL | wxGROW, 10); - - - my $startupSizer = Wx::StaticBoxSizer->new( - Wx::StaticBox->new($self, -1, string('CONTROLPANEL_STARTUP_OPTIONS')), - wxVERTICAL - ); - - $lbStartupMode->SetSelection($svcMgr->getStartupType() || 0); - $lbStartupMode->Enable($svcMgr->canSetStartupType()); - - $setStartupModeHandler = sub { - $svcMgr->setStartupType($lbStartupMode->GetSelection()) if $setStartupMode; - $setStartupMode = 0; - }; - - # use dummy listener to allow setting startup mode whether server is running or not - $parent->addStatusListener($lbStartupMode, sub {}); - - $startupSizer->Add($lbStartupMode, 0, wxLEFT | wxRIGHT | wxTOP, 10); - - if (main::ISWINDOWS) { - require Win32::TieRegistry; - $Win32::TieRegistry::Registry->Delimiter('/'); - my $serviceUser = $Win32::TieRegistry::Registry->{'LMachine/SYSTEM/CurrentControlSet/Services/squeezesvc/ObjectName'} || ''; - $serviceUser = '' if $serviceUser =~ /^(?:LocalSystem)$/i; - - my $credentialsSizer = Wx::FlexGridSizer->new(2, 2, 5, 10); - $credentialsSizer->AddGrowableCol(1, 1); - $credentialsSizer->SetFlexibleDirection(wxHORIZONTAL); - - $credentialsSizer->Add(Wx::StaticText->new($self, -1, string('SETUP_USERNAME') . string('COLON'))); - my $username = Wx::TextCtrl->new($self, -1, $serviceUser, [-1, -1], [150, -1]); - $credentialsSizer->Add($username); - EVT_TEXT($self, $username, sub { - $setStartupMode = 1; - }); - - $credentialsSizer->Add(Wx::StaticText->new($self, -1, string('SETUP_PASSWORD') . string('COLON'))); - my $password = Wx::TextCtrl->new($self, -1, '', [-1, -1], [150, -1], wxTE_PASSWORD); - $credentialsSizer->Add($password); - EVT_TEXT($self, $password, sub { - $setStartupMode = 1; - }); - - $startupSizer->Add($credentialsSizer, 0, wxALL, 10); - - my $handler = sub { - $username->Enable($lbStartupMode->GetSelection() == 2); - $password->Enable($lbStartupMode->GetSelection() == 2); - }; - - &$handler(); - EVT_CHOICE($self, $lbStartupMode, sub { - $setStartupMode = 1; - &$handler(); - }); - - # overwrite action handler for startup mode - $setStartupModeHandler = sub { - - if ($setStartupMode) { - - $svcMgr->setStartupType( - $lbStartupMode->GetSelection(), - $username->GetValue(), - $password->GetValue(), - ); - } - - $setStartupMode = 0; - }; - - # doubleclick action for tray icon - my $lbDoubleClickHandler = Wx::Choice->new($self, -1, [-1, -1], [-1, -1], [ string('CONTROLPANEL_TRAY_DOUBLECLICK_CONTROLPANEL'), string('CONTROLPANEL_TRAY_DOUBLECLICK_WEB') ]); - $lbDoubleClickHandler->SetSelection($Win32::TieRegistry::Registry->{'CUser/Software/Logitech/Squeezebox/DefaultToWebUI'} || 0); - - $parent->addApplyHandler($lbDoubleClickHandler, sub { - $Win32::TieRegistry::Registry->{'CUser/Software/Logitech/Squeezebox/DefaultToWebUI'} = $lbDoubleClickHandler->GetSelection() ? '1' : '0'; - }); - $startupSizer->Add($lbDoubleClickHandler, 0, wxLEFT | wxRIGHT | wxBOTTOM, 10); - } - - $parent->addApplyHandler($lbStartupMode, $setStartupModeHandler); - - $mainSizer->Add($startupSizer, 0, wxALL | wxGROW, 10); - - - my $rescanSizer = Wx::StaticBoxSizer->new( - Wx::StaticBox->new($self, -1, string('INFORMATION_MENU_SCAN')), - wxVERTICAL - ); - - my $rescanBtnSizer = Wx::BoxSizer->new(wxHORIZONTAL); - - my $rescanMode = Wx::Choice->new($self, -1, [-1, -1], [-1, -1], [ - string('SETUP_STANDARDRESCAN'), - string('SETUP_WIPEDB'), - string('SETUP_PLAYLISTRESCAN'), - ]); - $rescanMode->SetSelection(0); - $rescanBtnSizer->Add($rescanMode); - $parent->addStatusListener($rescanMode); - - $btnRescan = Wx::Button->new($self, -1, string('SETUP_RESCAN_BUTTON')); - $rescanBtnSizer->Add($btnRescan, 0, wxLEFT, 5); - $parent->addStatusListener($btnRescan); - - EVT_BUTTON($self, $btnRescan, sub { - if ($btnRescan->GetLabel() eq string('ABORT_SCAN')) { - Slim::GUI::ControlPanel->serverRequest('abortscan'); - } - - elsif ($rescanMode->GetSelection == 0) { - Slim::GUI::ControlPanel->serverRequest('rescan'); - } - - elsif ($rescanMode->GetSelection == 1) { - Slim::GUI::ControlPanel->serverRequest('wipecache'); - } - - elsif ($rescanMode->GetSelection == 2) { - Slim::GUI::ControlPanel->serverRequest('rescan', 'playlists'); - } - - $progressPoll->Start(100, wxTIMER_CONTINUOUS, 10) if $progressPoll && $btnRescan->GetLabel() ne string('ABORT_SCAN'); - }); - - $rescanSizer->Add($rescanBtnSizer, 0, wxALL | wxGROW, 10); - - my $progressPanel = Wx::Panel->new($self); - $progressPoll = Slim::GUI::ControlPanel::ScanPoll->new($progressPanel); - $parent->addStatusListener($progressPanel); - - $rescanSizer->Add($progressPanel, 1, wxLEFT | wxRIGHT | wxGROW, 10); - - $mainSizer->Add($rescanSizer, 0, wxALL | wxGROW, 10); - - - $self->SetSizer($mainSizer); - - return $self; -} - -1; - - -package Slim::GUI::ControlPanel::ScanPoll; - -use base 'Wx::Timer'; - -use Wx qw(:everything); - -use Slim::Utils::Light; -use Slim::Utils::ServiceManager; - -my $svcMgr = Slim::Utils::ServiceManager->new(); -my $isScanning = 0; - -my ($parent, $progressBar, $progressTime, $progressLabel, $progressInfo); - -sub new { - my $self = shift; - $parent = shift; - - $self = $self->SUPER::new(); - $self->Start(250); - - my $sizer = Wx::BoxSizer->new(wxVERTICAL); - - $progressLabel = Wx::StaticText->new($parent, -1, ''); - $sizer->Add($progressLabel, 0, wxEXPAND | wxTOP | wxBOTTOM, 5); - - my $progressSizer = Wx::BoxSizer->new(wxHORIZONTAL); - - $progressBar = Wx::Gauge->new($parent, -1, 100, [-1, -1], [-1, main::ISWINDOWS ? 20 : -1]); - $progressSizer->Add($progressBar, 1, wxGROW); - - $progressTime = Wx::StaticText->new($parent, -1, '00:00:00'); - $progressSizer->AddSpacer(10); - $progressSizer->Add($progressTime, 0, wxTOP, 3); - - $sizer->Add($progressSizer, 0, wxEXPAND); - -# re-enable ellipsizing once we're running Wx 2.9.x -# $progressInfo = Wx::StaticText->new($parent, -1, '', [-1, -1], [-1, -1], wxST_ELLIPSIZE_MIDDLE); - $progressInfo = Wx::StaticText->new($parent, -1, ''); - $sizer->Add($progressInfo, 0, wxEXPAND | wxTOP | wxBOTTOM, 5); - - $sizer->AddSpacer(15); - - $parent->SetSizer($sizer); - - return $self; -} - -sub Start { - my ($self, $milliseconds, $oneShot, $scanInit) = @_; - - $isScanning = $scanInit if $scanInit; - - $self->SUPER::Start($milliseconds, $oneShot); -} - -sub Notify { - my $self = shift; - - $progressInfo->SetLabel(''); - - if ($svcMgr->isRunning()) { - - my $progress = Slim::GUI::ControlPanel->serverRequest('rescanprogress'); - - if ($progress && $progress->{rescan}) { - $self->showProgress($progress); - return; - } - - elsif ($progress && $progress->{lastscanfailed}) { - $progressLabel->SetLabel($progress->{lastscanfailed}); - } - - elsif (!$isScanning) { - $self->showStats(); - } - - elsif ($isScanning) { - $progressLabel->SetLabel(''); - } - } - - # don't poll that often when no scan is running - $self->Start(10000, wxTIMER_CONTINUOUS); - - if ($isScanning) { - $progressBar->SetValue(100); - $self->Start(1000, wxTIMER_CONTINUOUS); - - $isScanning--; - } - - $btnRescan->SetLabel(string($isScanning ? 'ABORT_SCAN' : 'SETUP_RESCAN_BUTTON')); - $btnRescan->SetSize( $btnRescan->GetBestSize() ); -} - -sub showProgress { - my $self = shift; - my $progress = shift; - - $isScanning = 1; - - $progressBar->Show(); - $progressLabel->SetLabel(''); - - my @steps = split(/,/, $progress->{steps} || 'directory'); - - if (@steps) { - - my $step = $steps[-1]; - $progressBar->SetValue($progress->{$step}) if $progress->{$steps[-1]}; - $progressLabel->SetLabel( @steps . '. ' . Slim::GUI::ControlPanel->string(uc($step) . '_PROGRESS') ); - $progressTime->SetLabel($progress->{totaltime}); - - } - - if (defined $progress->{info}) { - $progressInfo->SetLabel($progress->{info}); - } - - $btnRescan->SetLabel(string('ABORT_SCAN')); - $btnRescan->SetSize( $btnRescan->GetBestSize() ); - $self->Start(2100, wxTIMER_CONTINUOUS); - $self->Layout(); -} - -sub showStats { - my $self = shift; - - my $libraryStats = Slim::GUI::ControlPanel->serverRequest('systeminfo', 'items', 0, 999); - - if ($libraryStats && $libraryStats->{loop_loop}) { - my $libraryName = string('INFORMATION_MENU_LIBRARY'); - my $x = 0; - - foreach my $item (@{$libraryStats->{loop_loop}}) { - - last if ($item->{name} && $item->{name} eq $libraryName); - - $x++; - - } - - if ($x < scalar @{$libraryStats->{loop_loop}}) { - $libraryStats = Slim::GUI::ControlPanel->serverRequest('systeminfo', 'items', 0, 999, "item_id:$x"); - - if ($libraryStats && $libraryStats->{loop_loop}) { - my $newLabel = ''; - - foreach my $item (@{$libraryStats->{loop_loop}}) { - - if ($item->{name}) { - $newLabel .= $item->{name} . "\n"; - } - - } - - if ($newLabel) { - $progressBar->Hide(); - $progressTime->SetLabel(''); - $progressLabel->SetLabel($newLabel); - } - } - } - } -} - -sub Layout { - my $self = shift; - - my ($width) = $parent->GetSizeWH(); - $progressLabel->Wrap($width); - $parent->Layout(); -} - -1; - diff --git a/Slim/GUI/ControlPanel/Status.pm b/Slim/GUI/ControlPanel/Status.pm deleted file mode 100644 index 090726df16a..00000000000 --- a/Slim/GUI/ControlPanel/Status.pm +++ /dev/null @@ -1,98 +0,0 @@ -package Slim::GUI::ControlPanel::Status; - -# Logitech Media Server Copyright 2001-2024 Logitech. -# Lyrion Music Server Copyright 2024 Lyrion Community. -# This program is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License, -# version 2. - -use strict; -use base 'Wx::Panel'; - -use Encode; -use Wx qw(:everything); -use Wx::Event qw(EVT_CHILD_FOCUS); -use Wx::Html; -use LWP::Simple qw($ua get); - -$ua->timeout(10); - -use Slim::Utils::Light; -use Slim::Utils::ServiceManager; - -sub new { - my ($self, $nb, $parent) = @_; - - $self = $self->SUPER::new($nb); - - $self->{loaded} = 0; - $self->{serviceState} = 0; - - $self->SetAutoLayout(1); - - my $mainSizer = Wx::BoxSizer->new(wxVERTICAL); - - $mainSizer->Add(Wx::HtmlWindow->new( - $self, - -1, - [-1, -1], - [-1, -1], - wxSUNKEN_BORDER - ), 1, wxALL | wxGROW, 10); - - $self->SetSizer($mainSizer); - - - EVT_CHILD_FOCUS($self, sub { - my ($self, $event) = @_; - $self->_update($event); - }); - - - $parent->addStatusListener('statusUpdater', sub { - my $state = shift; - - if ($state != $self->{serviceState}) { - $self->_update(); - } - }); - - - return $self; -} - -sub _update { - my ($self, $event) = @_; - - my $child = $self->GetChildren(); - - if ( $child && $child->isa('Wx::HtmlWindow') && !$self->{loaded} ) { - - my $svcMgr = Slim::Utils::ServiceManager->new(); - - if ($svcMgr->isRunning()) { - - my $status = get(Slim::GUI::ControlPanel->getBaseUrl(1) . '/EN/settings/server/status.html?simple=1'); - $status = decode("utf8", $status) if $status; - - $child->SetPage($status || string('CONTROLPANEL_NO_STATUS')); - $self->{loaded} = 1; - - } - else { - - $child->SetPage(string('CONTROLPANEL_NO_STATUS')); - $self->{loaded} = 1; - - } - - $self->{serviceState} = $svcMgr->getServiceState(); - } - else { - $self->{loaded} = 0; - } - - $event->Skip() if $event; -} - -1; diff --git a/Slim/Menu/BrowseLibrary.pm b/Slim/Menu/BrowseLibrary.pm index 49ae0ab7a9b..645737c8e22 100644 --- a/Slim/Menu/BrowseLibrary.pm +++ b/Slim/Menu/BrowseLibrary.pm @@ -1,5 +1,11 @@ package Slim::Menu::BrowseLibrary; +# Logitech Media Server Copyright 2001-2024 Logitech. +# Lyrion Music Server Copyright 2025 Lyrion Community. +# This program is free software; you can redistribute it and/or +# modify it under the terms of the GNU General Public License, +# version 2. + =head1 NAME Slim::Menu::BrowseLibrary @@ -1119,6 +1125,8 @@ sub _artists { push @searchTags, 'include_online_only_artists:1' } + $queryTags .= '4' unless $prefs->get('noContributorPictures'); + #For use down the line in _releases push @ptSearchTags, 'menu_mode:' . $mode if $mode; push @ptSearchTags, 'menu_roles:' . $roleIdParam if $roleIdParam; @@ -1130,18 +1138,32 @@ sub _artists { my $items = $results->{'artists_loop'}; $remote_library ||= $args->{'remote_library'}; + my $noContributorPictures = $prefs->get('noContributorPictures'); + foreach (@$items) { $_->{'name'} = $_->{'artist'}; $_->{'type'} = 'playlist'; $_->{'playlist'} = \&_tracks; $_->{'url'} = \&_albumsOrReleases; $_->{'passthrough'} = [ { searchTags => [@ptSearchTags, "artist_id:" . $_->{'id'}], remote_library => $remote_library } ]; + + if ( $noContributorPictures) { + # no pictures wanted + } + elsif ( $_->{'portraitid'} ) { + $_->{'image'} = 'contributor/' . $_->{'portraitid'} . '/image'; + } + else { + $_->{'icon'} = 'html/images/artists.png'; + } } + my $extra; if (scalar grep { $_ !~ /role_id|remote_library/ } @searchTags) { my $params = _tagsToParams(\@searchTags); $extra = [ { name => cstring($client, 'ALL_ALBUMS'), + icon => $noContributorPictures ? undef : 'html/images/albums.png', type => $remote_library ? 'link' : 'playlist', playlist => $remote_library ? undef : \&_tracks, url => \&_albums, diff --git a/Slim/Menu/TrackInfo.pm b/Slim/Menu/TrackInfo.pm index c7b9bad7dd9..14dfee06c2c 100644 --- a/Slim/Menu/TrackInfo.pm +++ b/Slim/Menu/TrackInfo.pm @@ -547,7 +547,9 @@ sub addTrack { if ( $cmd eq 'delete' ) { # Do not add this item if only one item in playlist - return $emptyItemList if Slim::Player::Playlist::count($client) < 2; + # BUG: 17980 (2012-06-14) - Allow item removal even if playlist has only 1 item + # Just comment out for now in case impact on UI should turn out to be sub-optimal + #return $emptyItemList if Slim::Player::Playlist::count($client) < 2; $actions = { go => { diff --git a/Slim/Music/Artwork.pm b/Slim/Music/Artwork.pm index 42535c095b7..228fdf7f9f0 100644 --- a/Slim/Music/Artwork.pm +++ b/Slim/Music/Artwork.pm @@ -2,7 +2,7 @@ package Slim::Music::Artwork; # Logitech Media Server Copyright 2001-2024 Logitech. -# Lyrion Music Server Copyright 2024 Lyrion Community. +# Lyrion Music Server Copyright 2025 Lyrion Community. # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License, # version 2. @@ -19,6 +19,7 @@ L use strict; +use Digest::MD5 qw(md5_hex); use File::Basename qw(basename dirname); use File::Slurp; use File::Path qw(mkpath rmtree); @@ -403,6 +404,36 @@ sub readCoverArt { return ($body, $contentType, $path); } + +sub generateImageId { + my ( $class, $args ) = @_; + + my $image = $args->{image} || ''; + my $imageId; + my $mtime; + my $size; + + if ( $image =~ /^https?/ ) { + $mtime = $size = 1; + } + elsif ( $image =~ /^\d+$/ ) { + # Cache is based on mtime/size of the file containing embedded art + $mtime = $args->{mtime}; + $size = $args->{size}; + } + elsif ( -e $image ) { + # Cache is based on mtime/size of artwork file + ($size, $mtime) = (stat _)[7, 9]; + } + + if ( $mtime && $size ) { + $imageId = substr( md5_hex( $args->{url} . $mtime . $size ), 0, 8 ); + } + + return $imageId; +} + + # Private class methods sub _imageContentType { my $class = shift; diff --git a/Slim/Music/ContributorPictureScan.pm b/Slim/Music/ContributorPictureScan.pm new file mode 100644 index 00000000000..062bfbee946 --- /dev/null +++ b/Slim/Music/ContributorPictureScan.pm @@ -0,0 +1,281 @@ +package Slim::Music::ContributorPictureScan; + +# Logitech Media Server Copyright 2001-2024 Logitech. +# Lyrion Music Server Copyright 2025 Lyrion Community. +# This program is free software; you can redistribute it and/or +# modify it under the terms of the GNU General Public License, +# version 2. + +=head1 NAME + +Slim::Music::ContributorPictureScan + +=head1 DESCRIPTION + +L + +=cut + +use strict; + +use File::Basename qw(dirname basename); +use File::Spec::Functions qw(catdir catfile); +use Path::Class; + +use Slim::Music::Import; +use Slim::Utils::Log; +use Slim::Utils::Prefs; +use Slim::Utils::Scanner::Local; + +my $log = logger('scan.import'); +my $prefs = preferences('server'); + +my ($dbh, $sth_album_folders, $sth_contributor_picture, $sth_update_contributor_picture, @artworkFolders, $specs, $i); + +# when walking up the folder hierarchy, don't go above these folders +my $audioDirs = { map { $_ => 1 } @{Slim::Utils::Misc::getAudioDirs()} }; + +sub init { + my $class = shift; + + Slim::Music::Import->addImporter( $class, { + type => 'artwork', + weight => 5, + } ); + + Slim::Music::Import->useImporter($class, !$prefs->get('noContributorPictures')); +} + +sub startArtworkScan { + my $class = shift; + + if ($prefs->get('precacheArtwork')) { + require Slim::Utils::ImageResizer; + $specs = join(',', Slim::Music::Artwork::getResizeSpecs()); + } + + $dbh = Slim::Schema->dbh; + + main::INFOLOG && $log->info("Starting contributor portrait scan"); + + my $imageFolder = $prefs->get('artfolder'); + if ( $imageFolder && -d $imageFolder ) { + $class->addArtworkFolder($imageFolder); + } + + $sth_album_folders = $dbh->prepare_cached(qq{ + SELECT url + FROM tracks + JOIN contributor_track ON contributor_track.track = tracks.id + WHERE contributor_track.contributor = ? AND tracks.url LIKE 'file://%' + GROUP BY album + }); + + $sth_contributor_picture = $dbh->prepare_cached(qq{ + SELECT portrait, portraitid + FROM contributors + WHERE id = ? + }); + + $sth_update_contributor_picture = $dbh->prepare_cached(qq{ + UPDATE contributors + SET portrait = ?, portraitid = ? + WHERE id = ? + }); + + my ($count) = $dbh->selectrow_array( qq{ + SELECT COUNT(*) FROM contributors + }) || (0); + + my $sth = $dbh->prepare($main::wipe + ? 'SELECT id, name FROM contributors' + : 'SELECT id, name, portrait, portraitid FROM contributors' + ); + $sth->execute(); + + my $progress = undef; + + if ($count) { + $progress = Slim::Utils::Progress->new({ + 'type' => 'importer', + 'name' => 'contributor_picture', + 'total' => $count, + 'bar' => 1 + }); + } + + while ( _getArtistPhotoURL({ + sth => $sth, + count => $count, + progress => $progress, + }) ) {} + + main::INFOLOG && $log->info("Finished scan for contributor pictures."); + + Slim::Music::Import->endImporter($class); +} + +sub _getArtistPhotoURL { + my $params = shift; + + my $progress = $params->{progress}; + + # get next artist from db + if ( my $artist = ($params->{sth}->fetchrow_hashref) ) { + my ($img, $candidates); + + $artist->{name} = Slim::Utils::Unicode::utf8decode($artist->{name}); + $progress->update( $artist->{name} ) if $progress; + time() > $i && ($i = time + 5) && Slim::Schema->forceCommit; + + # don't re-evaluate if we already have a portrait + if (main::SCANNER && !$main::wipe && $artist->{portrait} && $artist->{portraitid}) { + my $pictureId = Slim::Music::Artwork->generateImageId({ + image => Slim::Utils::Misc::pathFromFileURL($artist->{portrait}), + url => $artist->{portrait}, + }) || ''; + + # return early if existing image hasn't changed + if ($pictureId eq $artist->{portraitid}) { + return 1; + } + elsif ($pictureId) { + $img = Slim::Utils::Misc::pathFromFileURL($artist->{portrait}); + } + } + + # check if we have a portrait in the artwork folder(s) + if (!$img) { + $candidates = sanitizedNameVariants($artist->{name}); + + main::INFOLOG && $log->is_info && $log->info("Looking for pictures of " . $artist->{name}); + + foreach my $folder (@artworkFolders) { + $img = imageInFolder($folder, @$candidates); + last if $img; + } + } + + # check if we have a portrait in the album folders (and up) + if (!$img) { + $sth_album_folders->execute($artist->{id}); + + my %seen; + ALBUMFOLDER: while (my $track = $sth_album_folders->fetchrow_hashref) { + my $path = Slim::Utils::Misc::pathFromFileURL($track->{url}); + $path = dirname($path) if !-d $path; + + if (-d $path) { + my $dir = Path::Class::dir($path); + + # check parent/grandparent folder, assuming many have a music/artist/album/(CDx) hierarchy + my $parent = $dir->parent->stringify if !$audioDirs->{$path}; + my $grandparent = $dir->parent->parent->stringify if $parent && !$audioDirs->{$parent}; + + foreach ($parent, $path, $grandparent) { + next if !$_ || $seen{$_}++ || $audioDirs->{$_}; + $img = imageInFolder($_, @$candidates, 'artist', 'contributor'); + last ALBUMFOLDER if $img; + } + } + } + + $sth_album_folders->finish; + } + + if ($img) { + $img = Slim::Utils::Unicode::utf8encode($img); + my $url = Slim::Utils::Misc::fileURLFromPath($img); + my $imgId = Slim::Music::Artwork->generateImageId({ + image => $img, + url => $url, + }); + + my $contributorPicture = $dbh->selectrow_arrayref($sth_contributor_picture, undef, $artist->{id}); + + if ( $imgId && !($contributorPicture && $contributorPicture->[1] eq $imgId) ) { + # updated or new portrait + $sth_update_contributor_picture->execute($url, $imgId, $artist->{id}); + + Slim::Utils::ImageResizer->resize($img, "contributor/$imgId/image_", $specs) if $specs; + } + } + else { + $log->warn("No portrait found for " . $artist->{name}); + } + + return 1; + } + + if ( $progress ) { + $progress->final($params->{count}); + } + + return 0; +} + +sub addArtworkFolder { + my ($class, $folder) = @_; + + if (!($folder && -d $folder)) { + $log->warn("Invalid folder: $folder"); + return; + } + + @artworkFolders = Slim::Utils::Misc::uniq(@artworkFolders, $folder); +} + +sub sanitizedNameVariants { + my ($name) = @_; + + # Remove wildcards and other stuff potentially conflicting with file system limitations + # For whatever reason those aren't removed by S::U::Misc::cleanupFilename() + $name =~ s/[:?*]//g; + + my @candidates = map { + ( + $_, + Slim::Utils::Unicode::utf8encode($_), + Slim::Utils::Text::ignorePunct($_) + ); + } (Slim::Utils::Misc::cleanupFilename($name), $name); + + push @candidates, Slim::Utils::Unicode::utf8toLatin1Transliterate($candidates[-1]); + + return [ Slim::Utils::Misc::uniq(@candidates) ]; +} + +sub imageInFolder { + my ($folder, @names) = @_; + + return unless $folder && @names; + + main::INFOLOG && $log->info("Trying to find artwork in $folder for pictures called " . join(', ', map { "'$_'" } @names)); + + my $file; + + LOOKUP: foreach my $name (@names) { + foreach my $ext ('jpg', 'png', 'jpeg', 'JPG', 'PNG', 'JPEG') { + my $candidate = catdir($folder, $name . ".$ext"); + + if (-f $candidate) { + $file = $candidate; + last LOOKUP; + } + } + } + + return $file; +} + + + +=head1 SEE ALSO + +L + +=cut + +1; + +__END__ diff --git a/Slim/Music/Import.pm b/Slim/Music/Import.pm index 47651691a64..1ae3e8c14e6 100644 --- a/Slim/Music/Import.pm +++ b/Slim/Music/Import.pm @@ -1,7 +1,7 @@ package Slim::Music::Import; # Logitech Media Server Copyright 2001-2024 Logitech. -# Lyrion Music Server Copyright 2024 Lyrion Community. +# Lyrion Music Server Copyright 2025 Lyrion Community. # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License, # version 2. @@ -436,11 +436,11 @@ sub runScanPostProcessing { return 1 if !Slim::Schema::hasLibrary(); if (main::STATISTICS) { - # Look for and import persistent data migrated from MySQL + # Look for and import persistent data my ($dir) = Slim::Utils::OSDetect::dirsFor('prefs'); my $json = catfile( $dir, 'tracks_persistent.json' ); if ( -e $json ) { - $log->error('Migrating persistent track information from MySQL'); + $log->error('Migrating persistent track information from tracks_persistent.json'); if ( Slim::Schema::TrackPersistent->import_json($json) ) { unlink $json; @@ -468,9 +468,6 @@ sub runScanPostProcessing { $class->runArtworkImporter($importer); } - # If we ever find an artwork provider... - #Slim::Music::Artwork->downloadArtwork(); - # update standalone artwork if it's been changed without the music file being changed (don't run on a wipe & rescan) $importsRunning{'updateStandaloneArtwork'} = Time::HiRes::time(); Slim::Music::Artwork->updateStandaloneArtwork() unless $class->stillScanning =~ /wipe/i; diff --git a/Slim/Music/TitleFormatter.pm b/Slim/Music/TitleFormatter.pm index 383da2f95a9..e00fae7c4df 100644 --- a/Slim/Music/TitleFormatter.pm +++ b/Slim/Music/TitleFormatter.pm @@ -660,7 +660,7 @@ sub infoFormat { # use a safe format string if none specified # Bug: 1146 - Users can input strings in any locale - we need to convert that to # UTF-8 first, otherwise perl will segfault in the nasty regex below. - if ($str && $] > 5.007) { + if ($str) { my $old = $str; if ( !($str = $formatCache{$old}) ) { diff --git a/Slim/Networking/SimpleWS.pm b/Slim/Networking/SimpleWS.pm new file mode 100644 index 00000000000..3d8af301c4a --- /dev/null +++ b/Slim/Networking/SimpleWS.pm @@ -0,0 +1,385 @@ +package Slim::Networking::SimpleWS; + +# Lyrion Music Server Copyright 2024 Lyrion Community. +# This program is free software; you can redistribute it and/or +# modify it under the terms of the GNU General Public License, +# version 2. + +# This class provides a non-blocking WebSockets client connection from Lyrion Music Server. + +# This class is intended for plugins and other code needing simply to +# handle a persistent websockets connection. If you have more complex +# needs consider writing a fuller implementation. + +# more documentation at end of file. + +use strict; + +use IO::Socket; +use IO::Socket::SSL; +use IO::Select; +use Protocol::WebSocket::Client; +use URI; + +use Slim::Utils::Log; +use Slim::Utils::Prefs; + +my $log = logger('network.ws'); + +sub new { + my ( $class, $url, $cbConnected, $cbConnectFailed) = @_; + + my $self = { + client => 0, + tcp_socket => 0, + socket_open => 0, + continue_listening => 0, + cb_Read => 0, + cb_Read_Failed => 0, + }; + + bless $self, $class; + + $self->_connect( $url, $cbConnected, $cbConnectFailed ); + + return $self; +} + + +sub close { + my ($self) = @_; + + main::INFOLOG && $log->is_info && $log->info("Close web socket connect with status: " . $self->{tcp_socket}->connected() ); + + $self->{continue_listening} = 0; + $self->{client}->disconnect; + $self->{tcp_socket}->close if $self->{socket_open}; + $self->{socket_open} = 0; + + return; +} + + +sub _connect { + my ( $self, $url, $cbConnected, $cbConnectFailed ) = @_; + + main::DEBUGLOG && $log->is_debug && $log->debug("Connecting to webSocket $url"); + + my $uri = URI->new($url); + my $proto = $uri->scheme; + my $host = $uri->host; + my $path = $uri->path; + my $port = $uri->port; + + if (! (($proto =~ /ws|wss/) && $host) ) { + $log->warn("Failed to parse $url"); + $cbConnectFailed->("Failed to parse Host/Port for ws URL from $url"); + return; + } elsif ($port == 433 ) { + $proto = 'wss'; + } + + main::INFOLOG && $log->is_info && $log->info("Attempting to open socket to $proto://$host:$port..."); + + if ($proto eq 'wss') { + IO::Socket::SSL::set_defaults(SSL_verify_mode => Net::SSLeay::VERIFY_NONE()) + if preferences('server')->get('insecureHTTPS'); + + $self->{tcp_socket} = IO::Socket::SSL->new( + PeerAddr => $host, + PeerPort => "$proto($port)", + Proto => 'tcp', + Blocking => 1, + SSL_startHandshake => 1, + ) or $cbConnectFailed->("Failed to connect to socket: $!,$SSL_ERROR"); + } else { + $self->{tcp_socket} = IO::Socket::INET->new( + PeerAddr => $host, + PeerPort => "$proto($port)", + Proto => 'tcp', + Blocking => 1, + ) or $cbConnectFailed->("Failed to connect to socket: $!"); + } + + + main::INFOLOG && $log->is_info && $log->info("Trying to create Protocol::WebSocket::Client handler for $url..."); + $self->{client} = Protocol::WebSocket::Client->new(url => $url); + $self->{socket_open} = 1; + + # Set up the various methods for the WS Protocol handler + # On Write: take the buffer (WebSocket packet) and send it on the socket. + $self->{client}->on( + write => sub { + my $client = shift; + my ($buf) = @_; + + main::DEBUGLOG && $log->is_debug && $log->debug("Sending $buf ..."); + + syswrite $self->{tcp_socket}, $buf if $self->{socket_open}; + } + ); + + # On Connect: this is what happens after the handshake succeeds, and we + # are "connected" to the service. + $self->{client}->on( + connect => sub { + my $client = shift; + main::INFOLOG && $log->is_info && $log->info("Successfully Connected to $url..."); + $cbConnected->(); + + } + ); + + $self->{client}->on( + error => sub { + my $client = shift; + my ($buf) = @_; + + $log->warn("ERROR ON WEBSOCKET: $buf"); + $self->{tcp_socket}->close; + exit; + } + ); + + $self->{client}->on( + read => sub { + my $client = shift; + my ($buf) = @_; + main::INFOLOG && $log->is_info && $log->info("Message Recieved : $buf"); + $self->_read($buf); + } + ); + + + $self->{client}->on( + ping => sub { + my $client = shift; + my ($buf) = @_; + main::DEBUGLOG && $log->is_debug && $log->debug("Ping sent, sending pong : " . sprintf("%v02X", $buf)); + $client->pong($buf); + } + ); + + main::INFOLOG && $log->is_info && $log->info("connecting to client"); + $self->{client}->connect; + + # read until handshake is complete. This is blocking but should be over quickly. + while (!$self->{client}->{hs}->is_done){ + my $recv_data; + + my $bytes_read = sysread $self->{tcp_socket}, $recv_data, 16384; + + if (!defined $bytes_read) { + $log->error("sysread on tcp_socket failed: $!"); + $cbConnectFailed->("WS Handshake failed"); + return; + }elsif ($bytes_read == 0) { + $log->error("Connection terminated."); + $cbConnectFailed->("WS Handshake failed"); + return; + } + + $self->{client}->read($recv_data); + } + + return; +} + + +sub _read { + my ($self, $buf) = @_; + + $self->{cb_Read}->($buf); + + return; +} + + +sub listenAsync { + my ($self, $cbRead, $cbReadFailed ) = @_; + + main::INFOLOG && $log->is_info && $log->info("Starting To Listen Async"); + + $self->{cb_Read} = $cbRead; + $self->{cb_Read_Failed} = $cbReadFailed; + + $self->{continue_listening} = 1; + + $self->_receiveAsync(); + + return; +} + + +sub endListenAsync { + my ($self) = @_; + + main::INFOLOG && $log->is_info && $log->info("Ending Listen Async"); + + $self->{continue_listening} = 0; + + return; +} + + +sub _receiveAsync { + my ($self) = @_; + + $self->_receive(1); + + return; +} + + +sub receiveSync { + my ($self, $timeout, $cbRead, $cbReadFailed ) = @_; + + main::INFOLOG && $log->is_info && $log->info("Single Receive sync timeout : $timeout"); + + #Set callack on object + $self->{cb_Read} = $cbRead; + $self->{cb_Read_Failed} = $cbReadFailed; + $self->{continue_listening} = 0; + + $self->_receive(0, $timeout); + + return; +} + + +sub _receive { + my ($self, $isAsync, $timeout) = @_; + main::DEBUGLOG && $log->is_debug && $log->debug("Starting Listening"); + + #Operation to check on the socket reading + #if isAsync is true it will check in a non-blocking way and initiate a future check asynchronously for continuose listening. + #if isAync is false it will wait for something to arrive for $timeout length. This is blocking so suggest this is < 1 second. This is a single read. + + if ( !$isAsync || ($isAsync && $self->{continue_listening}) ) { + + my $s = IO::Select->new(); + $s->add($self->{tcp_socket}); + $! = 0; + + main::DEBUGLOG && $log->is_debug && $log->debug("Checking the socket for something to read"); + my @ready = $isAsync ? $s->can_read(0) : $s->can_read($timeout); + + if (@ready) { + my $recv_data; + my $bytes_read = sysread $ready[0], $recv_data, 16384; + if (!defined $bytes_read) { + + $log->error("Error reading from socket : $!"); + $self->{cb_Read_Failed}->(); + + # poll again in 1 second + $self->_continueListen(1) if $isAsync; + + } elsif ($bytes_read == 0) { + + # Remote socket closed + $log->error("Connection terminated by remote. $!"); + + $self->{cb_Read_Failed}->(); + + # We will not continue (if ASync) + $self->{continue_listening} = 0; + + } else { + + main::DEBUGLOG && $log->is_debug && $log->debug("Received data : $recv_data "); + $self->{client}->read($recv_data); + + # if Async, poll immediately so that we pull everything off the socket if something is there. + $self->_continueListen(0) if $isAsync; + + } + + } else { + + main::DEBUGLOG && $log->is_debug && $log->debug("No Data Present, continue listening"); + + # poll again in 1 second + $self->_continueListen(1) if $isAsync; + + } + } + + return; +} + + +sub _continueListen { + my ($self, $pollTimeSeconds) = @_; + + Slim::Utils::Timers::setTimer($self, time() + $pollTimeSeconds, \&_receiveAsync); + + return; +} + + +sub send { + my ($self, $buf) = @_; + + main::INFOLOG && $log->is_info && $log->info("Sending on web socket : $buf "); + $self->{client}->write($buf); + + return; +} + +1; + +__END__ + +=head1 NAME + +Slim::Networking::SimpleWS - Simple WS Client with asynchronous non-blocking socket listening + +=head1 SYNOPSIS + +use Slim::Networking::SimpleWS + +sub exampleErrorCallback { + + print("Oh no! An error!\n"); +} + +sub exampleWeAreConnected { + + print("We are connected"); +} + +sub exampleCallback { + my $buf = shift; + + print("Got the message.\n"); + print($buf); +} + +my $ws = Slim::Networking::SimpleWS->new( + 'wss://ws.sample.com/whats-occurring', + \&exampleWeAreConnected, + \&exampleErrorCallback +); + +# we can continually listen in a non-blocking way to this websocket +# Every time something arrives on the socket the callback will be called +$ws->listenAsync( + \&exampleCallback, + \&exampleErrorCallback +); + +#We can send something to the server +$ws->send("[subscribe]"); + +#......Some time later close the web socket when you have finished listening +$ws->close(); + + +=head1 DESCRIPTION + +This class provides a way within the Lyrion Music Server to listen on a web socket +in an asynchronous, non-blocking way. + +=cut + diff --git a/Slim/Player/Client.pm b/Slim/Player/Client.pm index a43d752ec94..b908091d9b0 100644 --- a/Slim/Player/Client.pm +++ b/Slim/Player/Client.pm @@ -562,7 +562,9 @@ sub forgetClient { delete $Slim::Networking::Slimproto::heartbeat{ $client->id }; # Bug 15860: Force the connection shut if it is not already - Slim::Networking::Slimproto::slimproto_close($client->tcpsock()) if defined $client->tcpsock(); + if (defined $client->tcpsock && ref $client->tcpsock eq "IO::Socket::INET") { + Slim::Networking::Slimproto::slimproto_close($client->tcpsock); + } } } diff --git a/Slim/Player/Squeezebox.pm b/Slim/Player/Squeezebox.pm index 80345d0265c..7c66047199c 100644 --- a/Slim/Player/Squeezebox.pm +++ b/Slim/Player/Squeezebox.pm @@ -792,7 +792,7 @@ sub stream_s { main::INFOLOG && logger('player.streaming.direct')->info("SqueezePlay direct stream: $url"); my $methodHandler = $currentTrackHandler->can('requestString') ? $currentTrackHandler : $handler; - $request_string = $methodHandler->getRequestString($client, $url, undef, $params->{'seekdata'} || $controller->song->seekdata); + $request_string = $methodHandler->requestString($client, $url, undef, $params->{'seekdata'} || $controller->song->seekdata); $autostart += 2; # will be 2 for direct streaming with no autostart, or 3 for direct with autostart } elsif (my $proxy = $params->{'proxyStream'}) { diff --git a/Slim/Player/Squeezebox2.pm b/Slim/Player/Squeezebox2.pm index 3e90a0dcdff..51cdaf2a51c 100644 --- a/Slim/Player/Squeezebox2.pm +++ b/Slim/Player/Squeezebox2.pm @@ -48,9 +48,6 @@ our $defaultPrefs = { 'remoteReplayGain' => -5, 'disableDac' => 0, 'minSyncAdjust' => 10, # ms - 'snLastSyncUp' => -1, - 'snLastSyncDown' => -1, - 'snSyncInterval' => 30, 'outputChannels' => 0, 'balance' => 0, }; diff --git a/Slim/Plugin/Analytics/Plugin.pm b/Slim/Plugin/Analytics/Plugin.pm index 914cb44f649..165e049b40d 100644 --- a/Slim/Plugin/Analytics/Plugin.pm +++ b/Slim/Plugin/Analytics/Plugin.pm @@ -19,13 +19,13 @@ use constant REPORT_PLAYER_UNSEEN_DAYS => 7; my $serverPrefs = preferences('server'); my $log; -my $id; +my $serverId; # delay init, as we want to be sure we're enabled before trying to read the display name sub postinitPlugin { - $id ||= sha1_base64(preferences('server')->get('server_uuid')); + $serverId ||= sha1_base64(preferences('server')->get('server_uuid')); # replace / with +, as / would be interpreted as a path part - $id =~ s/\//+/g; + $serverId =~ s/\//+/g; $log = Slim::Utils::Log->addLogCategory({ 'category' => 'plugin.analytics', @@ -33,11 +33,11 @@ sub postinitPlugin { 'description' => __PACKAGE__->getDisplayName(), }); - Slim::Utils::Timers::setTimer($id, time() + REPORT_DELAY, \&_report); + Slim::Utils::Timers::setTimer($serverId, time() + REPORT_DELAY, \&_report); } sub _report { - Slim::Utils::Timers::killTimers($id, \&_report); + Slim::Utils::Timers::killTimers($serverId, \&_report); my $osDetails = Slim::Utils::OSDetect::details(); my $plugins = [ sort map { @@ -87,7 +87,7 @@ sub _report { main::INFOLOG && $log->is_info && $log->info("Reporting system analytics"); # we MUST clone the data, as Data::Dump::dump would convert numbers to strings... - main::DEBUGLOG && $log->is_debug && $log->debug("$id: ", Data::Dump::dump(Storable::dclone($data))); + main::DEBUGLOG && $log->is_debug && $log->debug("$serverId: ", Data::Dump::dump(Storable::dclone($data))); Slim::Networking::SimpleAsyncHTTP->new( sub { @@ -103,44 +103,41 @@ sub _report { timeout => 5, }, )->post( - sprintf(REPORT_URL, $id), - 'x-lms-id' => $id, + sprintf(REPORT_URL, $serverId), + 'x-lms-id' => $serverId, 'Content-Type' => 'application/json', to_json($data), ); } sub _scheduleReport { - Slim::Utils::Timers::setTimer($id, time() + REPORT_INTERVAL, \&_report); + Slim::Utils::Timers::setTimer($serverId, time() + REPORT_INTERVAL, \&_report); } sub _getClients { my ($seen) = @_; my @clients; - foreach my $key (keys %{$serverPrefs->{prefs}}) { - if ($key =~ /^$Slim::Utils::Prefs::Client::clientPreferenceTag:(.*)/) { - my $id = $1; + foreach my $clientPrefs ($serverPrefs->allClients) { + my $name = $clientPrefs->get('playername'); - my $clientPrefs = Slim::Utils::Prefs::Client->new($serverPrefs, $id, 'nomigrate'); - my $name = $clientPrefs->get('playername'); - - my $ts = 0; - foreach (keys %{ $clientPrefs->{prefs} }) { - next unless /^_ts_(?:currentSong|power|playingAtPowerOff|mute|volume|repeat|shuffle|positionAtDisconnect|maxBitrate)/; - $ts = max($ts, $clientPrefs->{prefs}->{$_}); - } + my $ts = 0; + # can't use $clientPrefs->all(), as we want to have the timestamps + foreach (keys %{ $clientPrefs->{prefs} }) { + next unless /^_ts_(?:currentSong|power|playingAtPowerOff|mute|volume|repeat|shuffle|positionAtDisconnect|maxBitrate)/; + $ts = max($ts, $clientPrefs->{prefs}->{$_}); + } - my $clientData = { - mac => $id, - model => $clientPrefs->get('model') || _guessPlayerType($id, $name), - lastSeen => $ts, - }; + my $mac = $clientPrefs->{clientid} || next; + my $clientData = { + mac => $mac, + model => $clientPrefs->get('model') || _guessPlayerType($mac, $name), + lastSeen => $ts, + }; - $clientData->{modelName} = $clientPrefs->get('modelName') || ucfirst($clientData->{model}); + $clientData->{modelName} = $clientPrefs->get('modelName') || ucfirst($clientData->{model}); - push @clients, $clientData; - } + push @clients, $clientData; } return @clients; diff --git a/Slim/Plugin/InternetRadio/Plugin.pm b/Slim/Plugin/InternetRadio/Plugin.pm index 65b1cd7b05e..847ff111e8f 100644 --- a/Slim/Plugin/InternetRadio/Plugin.pm +++ b/Slim/Plugin/InternetRadio/Plugin.pm @@ -28,12 +28,6 @@ sub initPlugin { \&_initRadio, ); - # Setup cant_open handler for TuneIn reporting - Slim::Control::Request::subscribe( - \&cantOpen, - [['playlist'],['cant_open']], - ); - Slim::Plugin::InternetRadio::TuneIn->init(); } @@ -225,18 +219,4 @@ sub _pluginDataFor { return $class->SUPER::_pluginDataFor($key); } -sub cantOpen { - my $request = shift; - - my $url = $request->getParam('_url'); - my $error = $request->getParam('_error'); - - # Do not report if the user has turned off stats reporting - return if $prefs->get('sn_disable_stats'); - - if ( $error && $url =~ /(?:radiotime|tunein)\.com/ ) { - Slim::Plugin::InternetRadio::TuneIn->reportError($url, $error); - } -} - 1; diff --git a/Slim/Plugin/InternetRadio/TuneIn.pm b/Slim/Plugin/InternetRadio/TuneIn.pm index 4a15d99b36d..01ac60d6c3f 100644 --- a/Slim/Plugin/InternetRadio/TuneIn.pm +++ b/Slim/Plugin/InternetRadio/TuneIn.pm @@ -277,34 +277,4 @@ sub setUsername { $prefs->set('username', $username); } -sub reportError { - my ($class, $url, $error) = @_; - - return unless $error && $url =~ m{^https?://[^/](?:radiotime|tunein)\.com}; - - my ($id) = $url =~ /\bid\b=([a-z0-9]+)/; - if ( $id ) { - my $reportUrl = ERROR_URL - . '&id=' . uri_escape_utf8($id) - . '&message=' . uri_escape_utf8($error); - - main::INFOLOG && $log->is_info && $log->info("Reporting stream failure to TuneIn: $reportUrl"); - - my $http = Slim::Networking::SimpleAsyncHTTP->new( - sub { - main::INFOLOG && $log->is_info && $log->info("TuneIn failure report OK"); - }, - sub { - my $http = shift; - main::INFOLOG && $log->is_info && $log->info( "TuneIn failure report failed: " . $http->error ); - }, - { - timeout => 30, - }, - ); - - $http->get($reportUrl); - } -} - 1; diff --git a/Slim/Plugin/OPMLBased.pm b/Slim/Plugin/OPMLBased.pm index 64fc00fe4d7..318574f11bd 100644 --- a/Slim/Plugin/OPMLBased.pm +++ b/Slim/Plugin/OPMLBased.pm @@ -20,12 +20,12 @@ my %cli_next = (); sub initPlugin { my ( $class, %args ) = @_; - + if ( $args{is_app} ) { # Put all apps in the apps menu $args{menu} = 'apps'; } - + { no strict 'refs'; *{$class.'::'.'feed'} = sub { $args{feed} } if $args{feed}; @@ -38,9 +38,9 @@ sub initPlugin { if (!$class->_pluginDataFor('icon')) { Slim::Web::Pages->addPageLinks("icons", { $class->getDisplayName => 'html/images/radio.png' }); } - + $class->initCLI( %args ); - + if ( my $menu = $class->initJive( %args ) ) { if ( $args{is_app} ) { Slim::Control::Jive::registerAppMenu($menu); @@ -54,21 +54,14 @@ sub initPlugin { } # add "hidden" items to Jive home menu for individual OPMLbased items -# this allows individual items to be optionally added to the +# this allows individual items to be optionally added to the # top-level menu through the CustomizeHomeMenu applet sub initJive { my ( $class, %args ) = @_; - - # Exclude disabled plugins - if ( my $disabled = $prefs->get('sn_disabled_plugins') ) { - for my $plugin ( @{$disabled} ) { - return if $class =~ /^Slim::Plugin::${plugin}::/; - } - } my $icon = $class->_pluginDataFor('icon') ? proxiedImage($class->_pluginDataFor('icon')) : 'html/images/radio.png'; my $name = $class->getDisplayName(); - + my @jiveMenu = ( { stringToken => (uc($name) eq $name) ? $name : undef, # Only use string() if it is uppercase text => $name, @@ -77,7 +70,7 @@ sub initJive { node => $args{node} || $args{menu} || 'plugins', weight => $class->weight, displayWhenOff => 0, - window => { + window => { 'icon-id' => $icon, titleStyle => 'album', }, @@ -91,7 +84,7 @@ sub initJive { }, }, } ); - + # Bug 12336, additional items for type=search if ( $args{type} && $args{type} eq 'search' ) { $jiveMenu[0]->{actions}->{go}->{params}->{search} = '__TAGGEDINPUT__'; @@ -114,18 +107,18 @@ sub initJive { sub initCLI { my ( $class, %args ) = @_; - + my $cliQuery = sub { my $request = shift; Slim::Control::XMLBrowser::cliQuery( $args{tag}, $class->feed( $request->client ), $request ); }; - + # CLI support Slim::Control::Request::addDispatch( [ $args{tag}, 'items', '_index', '_quantity' ], [ 1, 1, 1, $cliQuery ] ); - + Slim::Control::Request::addDispatch( [ $args{tag}, 'playlist', '_method' ], [ 1, 1, 1, $cliQuery ] @@ -149,11 +142,11 @@ sub setMode { } my $name = $class->getDisplayName(); - + my $type = $class->type; - + my $title = (uc($name) eq $name) ? $client->string( $name ) : $name; - + if ( $type eq 'link' ) { my %params = ( header => $name, @@ -164,7 +157,7 @@ sub setMode { ); Slim::Buttons::Common::pushMode( $client, 'xmlbrowser', \%params ); - + # we'll handle the push in a callback $client->modeParam( handledTransition => 1 ); } @@ -180,7 +173,7 @@ sub setMode { timeout => 35, }, ); - + Slim::Buttons::Common::pushModeLeft( $client, 'INPUT.Text', \%params ); } } @@ -206,7 +199,7 @@ sub cliRadiosQuery { # what we want the query to report about ourself if (defined $menu) { my $type = $class->type; - + if ( $type eq 'link' ) { $data = { text => $title, @@ -261,7 +254,7 @@ sub cliRadiosQuery { elsif ( $type eq 'search' ) { $type = 'xmlbrowser_search'; } - + $data = { cmd => $tag, name => $title, @@ -270,26 +263,14 @@ sub cliRadiosQuery { weight => $weight, }; } - - # Exclude disabled plugins - my $disabled = $prefs->get('sn_disabled_plugins'); - - if ( $disabled ) { - for my $plugin ( @{$disabled} ) { - if ( $class =~ /^Slim::Plugin::${plugin}::/ ) { - $data = {}; - last; - } - } - } - + # Filter out items which don't match condition if ( $class->can('condition') && $request->client ) { if ( !$class->condition( $request->client ) ) { $data = {}; } } - + # let our super duper function do all the hard work Slim::Control::Queries::dynamicAutoQuery( $request, $cli_menu, $cli_next{ $class }->{ $cli_menu }, $data ); }; @@ -297,26 +278,26 @@ sub cliRadiosQuery { sub webPages { my $class = shift; - + # Only setup webpages here if a menu is defined by the plugin return unless $class->menu; my $title = $class->getDisplayName(); my $url = 'plugins/' . $class->tag() . '/index.html'; - + # default location for plugins is 'plugins' in the web UI, but 'extras' in SP... my $menu = $class->menu(); $menu = 'plugins' if $menu eq 'extras'; - + Slim::Web::Pages->addPageLinks( $menu, { $title => $url } ); - + if ( $class->can('condition') ) { Slim::Web::Pages->addPageCondition( $title, sub { $class->condition(shift); } ); } Slim::Web::Pages->addPageFunction( $url, sub { my $client = $_[0]; - + Slim::Web::XMLBrowser->handleWebIndex( { client => $client, feed => $class->feed( $client ), diff --git a/Slim/Plugin/RemoteLibrary/HTML/EN/plugins/RemoteLibrary/html/lms.png b/Slim/Plugin/RemoteLibrary/HTML/EN/plugins/RemoteLibrary/html/lms.png index ecec6906cb4..8ce590320ea 100644 Binary files a/Slim/Plugin/RemoteLibrary/HTML/EN/plugins/RemoteLibrary/html/lms.png and b/Slim/Plugin/RemoteLibrary/HTML/EN/plugins/RemoteLibrary/html/lms.png differ diff --git a/Slim/Plugin/UPnP/MediaRenderer/AVTransport.pm b/Slim/Plugin/UPnP/MediaRenderer/AVTransport.pm index 4d52c13ee7a..64beb2251d5 100644 --- a/Slim/Plugin/UPnP/MediaRenderer/AVTransport.pm +++ b/Slim/Plugin/UPnP/MediaRenderer/AVTransport.pm @@ -45,6 +45,11 @@ sub newClient { # Initialize all state variables $client->pluginData( AVT => _initialState() ); + + # Subscribe to LMS events for this client + Slim::Control::Request::subscribe( + \&clientEvent, [['playlist']], $client, + ); } sub disconnectClient { } @@ -126,11 +131,6 @@ sub clientEvent { sub subscribe { my ( $class, $client, $uuid ) = @_; - # Subscribe to events for this client - Slim::Control::Request::subscribe( - \&clientEvent, [['playlist']], $client, - ); - # Bump the number of subscribers for this client my $pd = $client->pluginData(); my $subs = $pd->{AVT_Subscribers} || 0; @@ -873,4 +873,4 @@ sub _currentTransportActions { } =cut -1; \ No newline at end of file +1; diff --git a/Slim/Plugin/UPnP/MediaRenderer/ConnectionManager.pm b/Slim/Plugin/UPnP/MediaRenderer/ConnectionManager.pm index 2e437e5288f..7504673d77d 100644 --- a/Slim/Plugin/UPnP/MediaRenderer/ConnectionManager.pm +++ b/Slim/Plugin/UPnP/MediaRenderer/ConnectionManager.pm @@ -153,6 +153,8 @@ sub _sinkProtocols { my $hasWMAP = grep { /wmap/ } @cf; my $hasOgg = grep { /ogg/ } @cf; my $hasFLAC = grep { /flc/ } @cf; + my $hasWav = grep { /wav/ } @cf; + my $hasOpus = grep { /ops/ } @cf; # Transcoder-supported formats my $canTranscode = sub { @@ -228,7 +230,19 @@ sub _sinkProtocols { if ( $hasFLAC || $canTranscode->('flc') ) { # Seeking not supported for remote FLAC content (OP=00) push @formats, ( - "http-get:*:audio/x-flac:DLNA.ORG_OP=00;DLNA.ORG_FLAGS=$flags", + "http-get:*:audio/flac:DLNA.ORG_OP=00;DLNA.ORG_FLAGS=$flags", + ); + } + + if ( $hasWav || $canTranscode->('wav') ) { + push @formats, ( + "http-get:*:audio/wav:DLNA.ORG_PN=WAV;DLNA.ORG_OP=01;DLNA.ORG_FLAGS=$flags", + ); + } + if ( $hasOpus || $canTranscode->('ops') ) { + # Seeking not supported for remote Opus content (OP=00) + push @formats, ( + "http-get:*:audio/opus:DLNA.ORG_OP=00;DLNA.ORG_FLAGS=$flags", ); } @@ -243,4 +257,4 @@ sub _sinkProtocols { return $sink; } -1; \ No newline at end of file +1; diff --git a/Slim/Plugin/UPnP/MediaServer/ConnectionManager.pm b/Slim/Plugin/UPnP/MediaServer/ConnectionManager.pm index 7cb7d9cb123..07d26261885 100644 --- a/Slim/Plugin/UPnP/MediaServer/ConnectionManager.pm +++ b/Slim/Plugin/UPnP/MediaServer/ConnectionManager.pm @@ -179,16 +179,6 @@ sub _sourceProtocols { WHERE audio = 1 }, { Slice => {} } ); - my $images = $dbh->selectall_arrayref( qq{ - SELECT DISTINCT(dlna_profile), mime_type - FROM images - }, { Slice => {} } ); - - my $videos = $dbh->selectall_arrayref( qq{ - SELECT DISTINCT(dlna_profile), mime_type - FROM videos - }, { Slice => {} } ); - # Audio profiles, will have duplicates... my %seen = (); for my $row ( @{$audio} ) { @@ -220,28 +210,6 @@ sub _sourceProtocols { push @formats, "http-get:*:audio/L16;rate=44100;channels=2:DLNA.ORG_PN=LPCM"; } - # Image profiles - for my $row ( @{$images} ) { - if ( $row->{dlna_profile} ) { - push @formats, "http-get:*:" . $row->{mime_type} . ":DLNA.ORG_PN=" . $row->{dlna_profile} . ";DLNA.ORG_OP=01;DLNA.ORG_FLAGS=00f00000000000000000000000000000"; - } - else { - push @formats, "http-get:*:" . $row->{mime_type} . ":*"; - } - } - push @formats, "http-get:*:image/jpeg:DLNA.ORG_PN=JPEG_TN;DLNA.ORG_OP=01;DLNA.ORG_FLAGS=00f00000000000000000000000000000"; - push @formats, "http-get:*:image/png:DLNA.ORG_PN=PNG_TN;DLNA.ORG_OP=01;DLNA.ORG_FLAGS=00f00000000000000000000000000000"; - - # Video profiles - for my $row ( @{$videos} ) { - if ( $row->{dlna_profile} ) { - push @formats, "http-get:*:" . $row->{mime_type} . ":DLNA.ORG_PN=" . $row->{dlna_profile} . ';DLNA.ORG_OP=01;DLNA.ORG_FLAGS=01700000000000000000000000000000'; - } - else { - push @formats, "http-get:*:" . $row->{mime_type} . ":*"; - } - } - # Bug 17885, sort all wildcard formats to the end of the list # Based on example at http://perldoc.perl.org/functions/sort.html my @sortedFormats = sort { diff --git a/Slim/Plugin/UPnP/MediaServer/ContentDirectory.pm b/Slim/Plugin/UPnP/MediaServer/ContentDirectory.pm index d8efc8f9d4c..77c52946481 100644 --- a/Slim/Plugin/UPnP/MediaServer/ContentDirectory.pm +++ b/Slim/Plugin/UPnP/MediaServer/ContentDirectory.pm @@ -202,10 +202,6 @@ sub Browse { # Home Menu # --------- - # Music - # Video - # Pictures - # Music (/music) # ----- # Artists (/a) artists @@ -237,7 +233,7 @@ sub Browse { # Tracks (/t) (cannot be browsed) # Track 1 (/t/) - if ( $id eq '0' || ($flag eq 'BrowseMetadata' && $id =~ m{^/(?:music|video|images)$}) ) { # top-level menu + if ( $id eq '0' || ($flag eq 'BrowseMetadata' && $id eq '/music') ) { # top-level menu my $type = 'object.container'; my $menu = [ { id => '/music', parentID => 0, type => $type, title => $string->('MUSIC') }, @@ -512,115 +508,6 @@ sub Browse { $cmd = "titles 0 1 track_id:$1 tags:AGldyorfTIctnDUFH"; } - ### Video - elsif ( $id =~ m{^/va} ) { # All Videos - if ( $id =~ m{/([0-9a-f]{8})$} ) { - $cmd = $flag eq 'BrowseDirectChildren' - ? "video_titles $start $limit video_id:$1 tags:dorfcwhtnDUlF" - : "video_titles 0 1 video_id:$1 tags:dorfcwhtnDUlF"; - } - else { - $cmd = "video_titles $start $limit tags:dorfcwhtnDUlF"; - } - } - - elsif ( $id =~ m{^/vf} ) { # folders - my ($folderId) = $id =~ m{^/vf/(.+)}; - - if ( $folderId ) { - $cmd = $flag eq 'BrowseDirectChildren' - ? "mediafolder $start $limit type:video folder_id:$folderId tags:dorfcwhtnDUlJF" - : "mediafolder 0 1 type:video folder_id:$folderId return_top:1 tags:dorfcwhtnDUlJF"; - } - - elsif ( $id eq '/vf' ) { - $cmd = "mediafolder $start $limit type:video tags:dorfcwhtnDUlJF"; - } - } - - ### Images - elsif ( $id =~ m{^/ia} ) { # All Images - if ( $id =~ m{/([0-9a-f]{8})$} ) { - $cmd = $flag eq 'BrowseDirectChildren' - ? "image_titles $start $limit image_id:$1 tags:ofwhtnDUlOF" - : "image_titles 0 1 image_id:$1 tags:ofwhtnDUlOF"; - } - else { - $cmd = "image_titles $start $limit tags:ofwhtnDUlOF"; - } - } - - elsif ( $id =~ m{^/if} ) { # folders - my ($folderId) = $id =~ m{^/if/(.+)}; - - if ( $folderId ) { - $cmd = $flag eq 'BrowseDirectChildren' - ? "mediafolder $start $limit type:image folder_id:$folderId tags:ofwhtnDUlOJF" - : "mediafolder 0 1 type:image folder_id:$folderId return_top:1 tags:ofwhtnDUlOJF"; - } - - elsif ( $id eq '/if' ) { - $cmd = "mediafolder $start $limit type:image tags:ofwhtnDUlOJF"; - } - } - - elsif ( $id =~ m{^/il} ) { # albums - my ($albumId) = $id =~ m{^/il/(.+)}; - - if ( $albumId ) { - $albumId = main::ISWINDOWS ? uri_escape($albumId) : uri_escape_utf8($albumId); - - $cmd = $flag eq 'BrowseDirectChildren' - ? "image_titles $start $limit albums:1 search:$albumId tags:ofwhtnDUlOF" - : "image_titles 0 1 albums:1"; - } - - elsif ( $id eq '/il' ) { - $cmd = "image_titles $start $limit albums:1"; - } - } - - elsif ( $id =~ m{^/(?:it|id)} ) { # timeline hierarchy - - my ($tlId) = $id =~ m{^/(?:it|id)/(.+)}; - my ($year, $month, $day, $pic) = $tlId ? split('/', $tlId) : (); - - if ( $pic ) { - $cmd = $flag eq 'BrowseDirectChildren' - ? "image_titles 0 1 image_id:$pic tags:ofwhtnDUlOF" - : "image_titles 0 1 timeline:day search:$year-$month-$day tags:ofwhtnDUlOF"; - } - - # if we've got a full date, show pictures - elsif ( $year && $month && $day ) { - $cmd = $flag eq 'BrowseDirectChildren' - ? "image_titles $start $limit timeline:day search:$year-$month-$day tags:ofwhtnDUlOF" - : "image_titles 0 1 timeline:days search:$year-$month"; # XXX should this have tags? - } - - # show days for a given month/year - elsif ( $year && $month ) { - $cmd = $flag eq 'BrowseDirectChildren' - ? "image_titles $start $limit timeline:days search:$year-$month" - : "image_titles 0 1 timeline:months search:$year"; - } - - # show months for a given year - elsif ( $year ) { - $cmd = $flag eq 'BrowseDirectChildren' - ? "image_titles $start $limit timeline:months search:$year" - : "image_titles 0 1 timeline:years"; - } - - elsif ( $id eq '/it' ) { - $cmd = "image_titles $start $limit timeline:years"; - } - - elsif ( $id eq '/id' ) { - $cmd = "image_titles $start $limit timeline:dates"; - } - } - if ( !$cmd ) { return [ 701 => 'No such object' ]; } @@ -699,16 +586,8 @@ sub Search { my ($sortsql, $stags) = _decodeSortCriteria($sort, $table); $tags .= $stags; - if ($cmd eq 'image_titles') { - $tags .= 'ofwhtnDUlOF'; - } - elsif ($cmd eq 'video_titles') { - $tags .= 'dorfcwhtnDUlF'; - } - else { - # Avoid 'A' and 'G' tags because they will run extra queries - $tags .= 'agldyorfTIctnDUFH'; - } + # Avoid 'A' and 'G' tags because they will run extra queries + $tags .= 'agldyorfTIctnDUFH'; if ( $sort && !$sortsql ) { return [ 709 => 'Unsupported or invalid sort criteria' ]; @@ -741,7 +620,7 @@ sub Search { cmd => $cmd, results => $results, flag => '', - id => $table eq 'tracks' ? '/t' : $table eq 'videos' ? '/v' : '/i', + id => '/t', filter => $filter, request_addr => $request_addr, @@ -1036,9 +915,7 @@ sub _arrayToDIDLLite { # DLNA 7.3.67.4, add searchClass info if ($id == 0 && ($filterall || $filter =~ /upnp:searchClass/) ) { - $xml .= qq{object.item.audioItem} - . qq{object.item.imageItem} - . qq{object.item.videoItem}; + $xml .= qq{object.item.audioItem}; } $xml .= ''; @@ -1067,21 +944,6 @@ sub _decodeSearchCriteria { $search =~ s/"/"/g; $search =~ s/'/'/g; - # Handle derivedfrom - if ( $search =~ s/upnp:class derivedfrom "([^"]+)"/1=1/ig ) { - my $sclass = $1; - if ( $sclass =~ /object\.item\.videoItem/i ) { - $cmd = 'video_titles'; - $table = 'videos'; - $idcol = 'hash'; - } - elsif ( $sclass =~ /object\.item\.imageItem/i ) { - $cmd = 'image_titles'; - $table = 'images'; - $idcol = 'hash'; - } - } - # Tweak all title/namesearch columns to use the normalized version if ( $search =~ /(dc:title|dc:creator|upnp:artist|upnp:album|upnp:genre)\s+contains\s+"([^"]+)"/ ) { my $field = $1; diff --git a/Slim/Plugin/UPnP/t/MediaServer.t b/Slim/Plugin/UPnP/t/MediaServer.t index 53e64300a71..5cd07ee21e0 100644 --- a/Slim/Plugin/UPnP/t/MediaServer.t +++ b/Slim/Plugin/UPnP/t/MediaServer.t @@ -258,76 +258,6 @@ ok( !$cm_events->renew, 'CM renew after unsubscribe failed ok' ); is( $container->{'-searchable'}, 0, 'CD: BrowseMetadata ObjectID /music, searchable ok' ); is( $container->{'dc:title'}, 'Music', 'CD: BrowseMetadata ObjectID /music, dc:title ok' ); } - -# Browse video menu -{ - # Fetch first menu item only - my $res = _action( $cd, 'Browse', { - BrowseFlag => 'BrowseDirectChildren', - ObjectID => '/video', - Filter => '*', - StartingIndex => 0, - RequestedCount => 1, - SortCriteria => '', - } ); - - is( $res->{NumberReturned}->{t}, 1, 'CD: Browse ObjectID /video RequestedCount 1, NumberReturned ok' ); - is( $res->{TotalMatches}->{t}, 2, 'CD: Browse ObjectID /video RequestedCount 1, TotalMatches ok' ); - - my $menu = xml2hash( $res->{Result}->{t}, text => 't', array => [ 'container' ] ); - my $container = $menu->{'DIDL-Lite'}->{container}; - is( scalar @{$container}, 1, 'CD: Browse ObjectID /video RequestedCount 1, container count ok' ); - - my $item1 = $container->[0]; - is( $item1->{'-id'}, '/v', 'CD: Browse ObjectID /video RequestedCount 1, container 1 id ok' ); - is( $item1->{'-parentID'}, '/video', 'CD: Browse ObjectID /video RequestedCount 1, container 1 parentID ok' ); - is( $item1->{'-restricted'}, 1, 'CD: Browse ObjectID /video RequestedCount 1, container 1 restricted ok' ); - is( $item1->{'-searchable'}, 0, 'CD: Browse ObjectID /video RequestedCount 1, container 1 searchable ok' ); - is( $item1->{'dc:title'}, 'Video Folder', 'CD: Browse ObjectID /video RequestedCount 1, container 1 dc:title ok' ); - is( $item1->{'upnp:class'}, 'object.container', 'CD: Browse ObjectID /video RequestedCount 1, container 1 upnp:class ok' ); - - # Fetch rest of menu, with sorting - $res = _action( $cd, 'Browse', { - BrowseFlag => 'BrowseDirectChildren', - ObjectID => '/video', - Filter => '*', - StartingIndex => 0, - RequestedCount => 2, - SortCriteria => '+dc:title', - } ); - - is( $res->{NumberReturned}->{t}, 2, 'CD: Browse ObjectID /video RequestedCount 2, NumberReturned ok' ); - is( $res->{TotalMatches}->{t}, 2, 'CD: Browse ObjectID /video RequestedCount 2, TotalMatches ok' ); - - my $menu = xml2hash( $res->{Result}->{t}, text => 't', array => [ 'container' ] ); - $container = $menu->{'DIDL-Lite'}->{container}; - is( scalar @{$container}, 2, 'CD: Browse ObjectID /video RequestedCount 2, container count ok' ); - - # Check sorting is correct - is( $container->[0]->{'-id'}, '/va', 'CD: Browse ObjectID /video RequestedCount 2, sorted container 1 id ok' ); - is( $container->[-1]->{'-id'}, '/v', 'CD: Browse ObjectID /video RequestedCount 2, sorted container 2 id ok' ); - - # Test video menu metadata - $res = _action( $cd, 'Browse', { - BrowseFlag => 'BrowseMetadata', - ObjectID => '/video', - Filter => '*', - StartingIndex => 0, - RequestedCount => 0, - SortCriteria => '', - } ); - - is( $res->{TotalMatches}->{t}, 1, 'BrowseMetadata ObjectID /video TotalMatches is 1' ); - is( $res->{NumberReturned}->{t}, 1, 'BrowseMetadata ObjectID /video NumberReturned is 1' ); - - $menu = xml2hash( $res->{Result}->{t}, text => 't' ); - $container = $menu->{'DIDL-Lite'}->{container}; - - is( $container->{'-id'}, '/video', 'CD: BrowseMetadata ObjectID /video, id ok' ); - is( $container->{'-parentID'}, 0, 'CD: BrowseMetadata ObjectID /video, parentID ok' ); - is( $container->{'-searchable'}, 0, 'CD: BrowseMetadata ObjectID /video, searchable ok' ); - is( $container->{'dc:title'}, 'Video', 'CD: BrowseMetadata ObjectID /video, dc:title ok' ); -} exit; # Test localized dc:title values @@ -1351,76 +1281,6 @@ my $playlist; is_deeply( $item, $track, "$tid BrowseMetadata ok" ); } -### All Videos (/va) - -# Test browsing All Videos menu -my $video; -{ - my $res = _action( $cd, 'Browse', { - BrowseFlag => 'BrowseDirectChildren', - ObjectID => '/va', - Filter => '*', - StartingIndex => 0, - RequestedCount => 100, - SortCriteria => '', - } ); - - my $menu = xml2hash( $res->{Result}->{t}, text => 't', array => [ 'container' ] ); - my $container = $menu->{'DIDL-Lite'}->{container}; - - # Skip Various Artists artist if it's there - $video = $container->[0]; - - like( $video->{'-id'}, qr{^/va/\d+/v$}, 'Video container id ok' ); - is( $video->{'-parentID'}, '/a', 'Video container parentID ok' ); - ok( $video->{'dc:title'}, 'Video container dc:title ok' ); - ok( $video->{'upnp:album'}, 'Video container upnp:album ok' ); - is( $video->{'upnp:class'}, 'object.container.person.musicArtist', 'Video container upnp:class ok' ); - - # Test BrowseMetadata on videos item - $res = _action( $cd, 'Browse', { - BrowseFlag => 'BrowseMetadata', - ObjectID => '/va', - Filter => '*', - StartingIndex => 0, - RequestedCount => 0, - SortCriteria => '', - } ); - - is( $res->{TotalMatches}->{t}, 1, '/va BrowseMetadata TotalMatches is 1' ); - is( $res->{NumberReturned}->{t}, 1, '/va BrowseMetadata NumberReturned is 1' ); - - $menu = xml2hash( $res->{Result}->{t}, text => 't' ); - $container = $menu->{'DIDL-Lite'}->{container}; - - is( $container->{'-id'}, '/va', '/va BrowseMetadata id ok' ); - is( $container->{'-parentID'}, '/video', '/va BrowseMetadata parentID ok' ); - is( $container->{'dc:title'}, 'All Videos', '/va BrowseMetadata dc:title ok' ); - is( $container->{'upnp:class'}, 'object.container', '/va BrowseMetadata upnp:class ok' ); - - # Test BrowseMetadata on a video - $res = _action( $cd, 'Browse', { - BrowseFlag => 'BrowseMetadata', - ObjectID => $video->{'-id'}, - Filter => '*', - StartingIndex => 0, - RequestedCount => 0, - SortCriteria => '', - } ); - - is( $res->{TotalMatches}->{t}, 1, 'Video BrowseMetadata TotalMatches is 1' ); - is( $res->{NumberReturned}->{t}, 1, 'Video BrowseMetadata NumberReturned is 1' ); - - $menu = xml2hash( $res->{Result}->{t}, text => 't' ); - $container = $menu->{'DIDL-Lite'}->{container}; - - is( $container->{'-id'}, $video->{'-id'}, 'Video BrowseMetadata id ok' ); - is( $container->{'-parentID'}, $video->{'-parentID'}, 'Video BrowseMetadata parentID ok' ); - is( $container->{'dc:title'}, $video->{'dc:title'}, 'Video BrowseMetadata dc:title ok' ); - is( $container->{'upnp:album'}, $video->{'upnp:album'}, 'Video BrowseMetadata upnp:album ok' ); - is( $container->{'upnp:class'}, $video->{'upnp:class'}, 'Video BrowseMetadata upnp:class ok' ); -} - ### Search # Windows 7 WMP uses this query to build a complete index of all audio tracks on the server @@ -1468,52 +1328,6 @@ my $video; like( $track->{'-id'}, qr{^/t/\d+$}, 'Revue Search result id ok' ); is( $track->{'-parentID'}, '/t', 'Revue Search result parentID ok' ); } - -# Test searching for new videos only -{ - my $res = _action( $cd, 'Search', { - ContainerID => 0, - SearchCriteria => 'pv:lastUpdated > 0 and upnp:class derivedfrom "object.item.videoItem"', - Filter => '*', - StartingIndex => 0, - RequestedCount => 10, - SortCriteria => '-pv:lastUpdated', - } ); - - cmp_ok( $res->{TotalMatches}->{t}, '>', 0, "Video Search TotalMatches is >0" ); - cmp_ok( $res->{NumberReturned}->{t}, '>', 0, "Video Search NumberReturned is >0" ); - - my $menu = xml2hash( $res->{Result}->{t}, text => 't' ); - my $items = $menu->{'DIDL-Lite'}->{item}; - - my $video = $items->[0]; - - like( $video->{'-id'}, qr{^/v/[0-9a-f]{8}$}, 'Video Search result id ok' ); - is( $video->{'-parentID'}, '/v', 'Video Search result parentID ok' ); -} - -# Test searching for images -{ - my $res = _action( $cd, 'Search', { - ContainerID => 0, - SearchCriteria => 'pv:lastUpdated > 0 and upnp:class derivedfrom "object.item.imageItem"', - Filter => '*', - StartingIndex => 0, - RequestedCount => 10, - SortCriteria => '-pv:lastUpdated', - } ); - - cmp_ok( $res->{TotalMatches}->{t}, '>', 0, "Image Search TotalMatches is >0" ); - cmp_ok( $res->{NumberReturned}->{t}, '>', 0, "Image Search NumberReturned is >0" ); - - my $menu = xml2hash( $res->{Result}->{t}, text => 't' ); - my $items = $menu->{'DIDL-Lite'}->{item}; - - my $image = $items->[0]; - - like( $image->{'-id'}, qr{^/i/[0-9a-f]{8}$}, 'Image Search result id ok' ); - is( $image->{'-parentID'}, '/i', 'Image Search result parentID ok' ); -} exit; sub _action { diff --git a/Slim/Plugin/iTunes/Importer.pm b/Slim/Plugin/iTunes/Importer.pm index 4a18b72677b..399f7263e9f 100644 --- a/Slim/Plugin/iTunes/Importer.pm +++ b/Slim/Plugin/iTunes/Importer.pm @@ -16,9 +16,7 @@ use File::Path qw(rmtree); use XML::Parser; INIT: { - if ($] > 5.007) { - require Encode; - } + require Encode; } use Slim::Player::ProtocolHandlers; @@ -269,7 +267,7 @@ sub handleTrack { $file = Slim::Utils::Misc::pathFromFileURL($url); - if ($] > 5.007 && $file && Slim::Utils::Unicode::currentLocale() ne 'utf8') { + if ($file && Slim::Utils::Unicode::currentLocale() ne 'utf8') { my $file2 = $file; @@ -578,11 +576,7 @@ sub handleCharElement { if ($inTracks && $inValue) { - if ($] > 5.007) { - $item{$currentKey} .= $value; - } else { - $item{$currentKey} .= Slim::Utils::Unicode::utf8toLatin1($value); - } + $item{$currentKey} .= $value; return; } diff --git a/Slim/Schema.pm b/Slim/Schema.pm index 39c0e7adac9..bcd261c2932 100644 --- a/Slim/Schema.pm +++ b/Slim/Schema.pm @@ -2,7 +2,7 @@ package Slim::Schema; # Logitech Media Server Copyright 2001-2024 Logitech. -# Lyrion Music Server Copyright 2024 Lyrion Community. +# Lyrion Music Server Copyright 2025 Lyrion Community. # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License, # version 2. @@ -143,24 +143,19 @@ sub init { } # Bug: 4076 - # If a user was using MySQL with 6.3.x (unsupported), their # metainformation table won't be dropped with the schema_1_up.sql # file, since the metainformation table doesn't get dropped to # maintain state. We need to wipe the DB and start over. eval { local $dbh->{HandleError} = sub {}; $dbh->do('SELECT name FROM metainformation') || die $dbh->errstr; - - # when upgrading from SBS to LMS let's check the additional tables, - # as the schema numbers might be overlapping, not causing a re-build - $dbh->do('SELECT id FROM images LIMIT 1') || die $dbh->errstr; }; # If we couldn't select our new 'name' column, then drop the # metainformation (and possibly dbix_migration, if the db is in a # wierd state), so that the migrateDB call below will update the schema. if ( $@ ) { - main::INFOLOG && $log->is_info && $log->info("Creating new database - empty, outdated or invalid database found"); + main::INFOLOG && $log->is_info && $log->info("Creating new database - empty, outdated or invalid database found: $@"); eval { $dbh->do('DROP TABLE IF EXISTS metainformation'); @@ -1307,7 +1302,7 @@ sub _createOrUpdateAlbum { } } - # Check that these are the correct types. Otherwise MySQL will not accept the values. + # Check that these are the correct types. if ( defined $disc && $disc =~ /^\d+$/ ) { $albumHash->{disc} = $disc; } diff --git a/Slim/Schema/Album.pm b/Slim/Schema/Album.pm index 732ee944866..2ee7f52ba53 100644 --- a/Slim/Schema/Album.pm +++ b/Slim/Schema/Album.pm @@ -49,9 +49,7 @@ my $log = logger('database.info'); $class->has_many('track' => 'Slim::Schema::Track' => 'album'); $class->has_many('contributorAlbums' => 'Slim::Schema::ContributorAlbum' => 'album'); - if ($] > 5.007) { - $class->utf8_columns(qw/title titlesort/); - } + $class->utf8_columns(qw/title titlesort/); $class->resultset_class('Slim::Schema::ResultSet::Album'); diff --git a/Slim/Schema/Comment.pm b/Slim/Schema/Comment.pm index a92798d6143..36567e8012a 100644 --- a/Slim/Schema/Comment.pm +++ b/Slim/Schema/Comment.pm @@ -15,9 +15,7 @@ use base 'Slim::Schema::DBI'; $class->belongs_to(track => 'Slim::Schema::Track'); - if ($] > 5.007) { - $class->utf8_columns(qw/value/); - } + $class->utf8_columns(qw/value/); } 1; diff --git a/Slim/Schema/Contributor.pm b/Slim/Schema/Contributor.pm index 778b2603dab..6e2b00f45fe 100644 --- a/Slim/Schema/Contributor.pm +++ b/Slim/Schema/Contributor.pm @@ -1,5 +1,10 @@ package Slim::Schema::Contributor; +# Logitech Media Server Copyright 2001-2024 Logitech. +# Lyrion Music Server Copyright 2025 Lyrion Community. +# This program is free software; you can redistribute it and/or +# modify it under the terms of the GNU General Public License, +# version 2. use strict; use base 'Slim::Schema::DBI'; @@ -44,6 +49,8 @@ initializeRoles(); namesearch musicbrainz_id extid + portraitid + portrait )); $class->set_primary_key('id'); @@ -61,9 +68,7 @@ initializeRoles(); $class->many_to_many('albums', 'contributorAlbums' => 'album', undef, { 'distinct' => 1 }); - if ($] > 5.007) { - $class->utf8_columns(qw/name namesort/); - } + $class->utf8_columns(qw/name namesort/); $class->resultset_class('Slim::Schema::ResultSet::Contributor'); } diff --git a/Slim/Schema/DBI.pm b/Slim/Schema/DBI.pm index feb0f0425df..e1a10868d88 100644 --- a/Slim/Schema/DBI.pm +++ b/Slim/Schema/DBI.pm @@ -17,11 +17,7 @@ my $dirtyCount = 0; { my $class = __PACKAGE__; - my @components = qw(PK::Auto Core); - - if ($] > 5.007) { - unshift @components, 'UTF8Columns'; - } + my @components = qw(UTF8Columns PK::Auto Core); $class->load_components(@components); } diff --git a/Slim/Schema/Genre.pm b/Slim/Schema/Genre.pm index 2174e4eb232..829b1a8a919 100644 --- a/Slim/Schema/Genre.pm +++ b/Slim/Schema/Genre.pm @@ -32,9 +32,7 @@ my $myClassicalGenreIds; $class->has_many('genreTracks' => 'Slim::Schema::GenreTrack' => 'genre'); - if ($] > 5.007) { - $class->utf8_columns(qw/name namesort/); - } + $class->utf8_columns(qw/name namesort/); $class->resultset_class('Slim::Schema::ResultSet::Genre'); } diff --git a/Slim/Schema/Image.pm b/Slim/Schema/Image.pm deleted file mode 100644 index e8e2eb411ac..00000000000 --- a/Slim/Schema/Image.pm +++ /dev/null @@ -1,111 +0,0 @@ -package Slim::Schema::Image; - -use strict; - -use File::Basename; -use Date::Parse qw(str2time); -use Slim::Schema; -use Slim::Formats::XML; -use Slim::Utils::Misc; - -# XXX DBIx::Class stuff needed? - -my %orientation = ( - 'top-left' => 0, - 'top-right' => 1, - 'bottom-right' => 2, - 'bottom-left' => 3, - 'left-top' => 4, - 'right-top' => 5, - 'right-bottom' => 6, - 'left-bottom' => 7, -); - -sub updateOrCreateFromResult { - my ( $class, $result ) = @_; - - my $url = Slim::Utils::Misc::fileURLFromPath($result->path); - - my $exifData = $result->tags; - - # Create title and album from path (if not in EXIF data) - my $title = Slim::Formats::XML::trim($exifData->{XPTitle}); - # XXX - ImageDescription was abused by older digicams to store their name - # using this would result in endless lists of images called "MEDION DIGITAL CAMERA" etc. - #|| Slim::Formats::XML::trim($exifData->{ImageDescription}); - - my ($filename, $dirs, undef) = fileparse($result->path); - $title ||= $filename; - - # Album is parent directory - $dirs =~ s{\\}{/}g; - my ($album) = $dirs =~ m{([^/]+)/$}; - - my $sort = Slim::Utils::Text::ignoreCaseArticles($title); - my $search = Slim::Utils::Text::ignoreCase($title, 1); - my $now = time(); - my $creationDate = str2time($exifData->{DateTimeOriginal}) || str2time($exifData->{DateTime}) || $result->mtime || 0; - - my $hash = { - hash => $result->hash, - url => $url, - title => $title, - titlesearch => $search, - titlesort => $sort, - album => $album, - image_codec => $result->codec, - mime_type => $result->mime_type, - dlna_profile => $result->dlna_profile, - width => $result->width, - height => $result->height, - mtime => $result->mtime, - added_time => $now, - updated_time => $now, - original_time=> $creationDate, - filesize => $result->size, - orientation => $orientation{ lc($exifData->{Orientation} || '') } || 0, - }; - - return $class->updateOrCreateFromHash($hash); -} - -sub updateOrCreateFromHash { - my ( $class, $hash ) = @_; - - my $sth = Slim::Schema->dbh->prepare_cached('SELECT id FROM images WHERE url = ?'); - $sth->execute( $hash->{url} ); - my ($id) = $sth->fetchrow_array; - $sth->finish; - - if ( !$id ) { - $id = Slim::Schema->_insertHash( images => $hash ); - $hash->{id} = $id; - } - else { - $hash->{id} = $id; - - # Don't overwrite the original add time - delete $hash->{added_time}; - - Slim::Schema->_updateHash( images => $hash, 'id' ); - } - - return $hash; -} - -sub findhash { - my ( $class, $id ) = @_; - - my $sth = Slim::Schema->dbh->prepare_cached( qq{ - SELECT * FROM images WHERE hash = ? - } ); - - $sth->execute($id); - my $hash = $sth->fetchrow_hashref; - $sth->finish; - - return $hash || {}; -} - -1; - diff --git a/Slim/Schema/Progress.pm b/Slim/Schema/Progress.pm index 48244c446ef..7518815226b 100644 --- a/Slim/Schema/Progress.pm +++ b/Slim/Schema/Progress.pm @@ -12,9 +12,7 @@ use base 'Slim::Schema::DBI'; $class->add_columns(qw/id type name active total done start finish info/); $class->set_primary_key('id'); - if ($] > 5.007) { - $class->utf8_columns(qw/name info/); - } + $class->utf8_columns(qw/name info/); } 1; diff --git a/Slim/Schema/RemoteTrack.pm b/Slim/Schema/RemoteTrack.pm index ff5f3897986..d3cb989f5f6 100644 --- a/Slim/Schema/RemoteTrack.pm +++ b/Slim/Schema/RemoteTrack.pm @@ -62,6 +62,7 @@ my @allAttributes = (qw( subtitle performance discsubtitle + added_from_work )); { diff --git a/Slim/Schema/Storage.pm b/Slim/Schema/Storage.pm index 4cbf0038e4c..e61971b1c7b 100644 --- a/Slim/Schema/Storage.pm +++ b/Slim/Schema/Storage.pm @@ -53,36 +53,7 @@ sub dbh { sub throw_exception { my ($self, $msg) = @_; - # Try and bring up the database if we can't connect. - if ($msg =~ /Connection failed/ && $sqlHelperClass =~ /MySQL/i) { - - my $lockFile = File::Spec->catdir(preferences('server')->get('librarycachedir'), 'mysql.startup'); - - if (!-f $lockFile) { - - write_file($lockFile, 'starting'); - - logWarning("Unable to connect to the database - trying to bring it up!"); - - $@ = ''; - - if ( $sqlHelperClass && $sqlHelperClass->init( $self->_dbh ) ) { - - eval { $self->ensure_connected }; - - if ($@) { - logError("Unable to connect to the database - even tried restarting it twice!"); - logError("Check the event log for errors on Windows. Fatal. Exiting."); - exit; - } - } - - unlink($lockFile); - - return; - } - - } elsif ($msg =~ /SQLite.*(?:database disk image is malformed|is not a database)/i) { + if ($msg =~ /SQLite.*(?:database disk image is malformed|is not a database)/i) { $msg =~ m{/((?:library|persist)\.db)}i; diff --git a/Slim/Schema/Track.pm b/Slim/Schema/Track.pm index a21afb47ee3..57dc4802ed9 100644 --- a/Slim/Schema/Track.pm +++ b/Slim/Schema/Track.pm @@ -1,5 +1,10 @@ package Slim::Schema::Track; +# Logitech Media Server Copyright 2001-2024 Logitech. +# Lyrion Music Server Copyright 2025 Lyrion Community. +# This program is free software; you can redistribute it and/or +# modify it under the terms of the GNU General Public License, +# version 2. use strict; use base 'Slim::Schema::DBI'; @@ -56,9 +61,7 @@ our @allColumns = (qw( $class->has_many('contributorTracks' => 'Slim::Schema::ContributorTrack'); $class->has_many('libraryTracks' => 'Slim::Schema::LibraryTrack'); - if ($] > 5.007) { - $class->utf8_columns(qw/title titlesort lyrics/); - } + $class->utf8_columns(qw/title titlesort lyrics/); $class->resultset_class('Slim::Schema::ResultSet::Track'); @@ -72,6 +75,9 @@ our @allColumns = (qw( # Simple caching as artistsWithAttributes is expensive. $class->mk_group_accessors('simple' => 'cachedArtistsWithAttributes'); + + # For the playlist queue entry context when Track is used to store/retrieve play queue entries. + $class->mk_group_accessors('simple' => 'added_from_work'); } # Wrappers - to make sure that the UTF-8 code is called. I really just want to @@ -748,28 +754,12 @@ sub coverurl { sub generateCoverId { my ( $classOrSelf, $args ) = @_; - my $coverid; - my $mtime; - my $size; - - if ( $args->{cover} =~ /^https?/ ) { - $mtime = $size = 1; - } - elsif ( $args->{cover} =~ /^\d+$/ ) { - # Cache is based on mtime/size of the file containing embedded art - $mtime = $args->{mtime}; - $size = $args->{size}; - } - elsif ( -e $args->{cover} ) { - # Cache is based on mtime/size of artwork file - ($size, $mtime) = (stat _)[7, 9]; - } - - if ( $mtime && $size ) { - $coverid = substr( md5_hex( $args->{url} . $mtime . $size ), 0, 8 ); - } - - return $coverid; + return Slim::Music::Artwork->generateImageId({ + image => $args->{cover}, + url => $args->{url}, + mtime => $args->{mtime}, + size => $args->{size}, + }); } 1; diff --git a/Slim/Utils/ArtworkCache.pm b/Slim/Utils/ArtworkCache.pm index 87dd1c49714..dd182297699 100644 --- a/Slim/Utils/ArtworkCache.pm +++ b/Slim/Utils/ArtworkCache.pm @@ -1,5 +1,11 @@ package Slim::Utils::ArtworkCache; +# Logitech Media Server Copyright 2001-2024 Logitech. +# Lyrion Music Server Copyright 2025 Lyrion Community. +# This program is free software; you can redistribute it and/or +# modify it under the terms of the GNU General Public License, +# version 2. + # Lightweight, efficient, and fast file cache for artwork. # # This class is roughly 9x faster for get, and 12x faster for set than using Cache::FileCache @@ -13,11 +19,11 @@ my $singleton; sub new { my $class = shift; my $root = shift; - + if ( !$singleton ) { $singleton = Slim::Utils::DbArtworkCache->new($root, 'artwork'); } - + return $singleton; } @@ -28,6 +34,8 @@ package Slim::Utils::DbArtworkCache; use base 'Slim::Utils::DbCache'; use File::Spec::Functions qw(catfile); +use Slim::Utils::Unicode; + sub new { my ($self, $root, $namespace, $expires) = @_; @@ -35,7 +43,7 @@ sub new { require Slim::Utils::Prefs; # the artwork cache needs to be in the same place as the library data for TinyLMS $root = Slim::Utils::Prefs::preferences('server')->get('librarycachedir'); - + # Update root value if librarycachedir changes Slim::Utils::Prefs::preferences('server')->setChange( sub { $self->wipe; @@ -43,7 +51,7 @@ sub new { $self->_init_db; }, 'librarycachedir' ); } - + return $self->SUPER::new({ root => $root, namespace => $namespace || 'artwork', @@ -54,47 +62,49 @@ sub new { sub set { my ( $self, $key, $data ) = @_; - + # packed data is stored as follows: # 3 bytes type (jpg/png/gif) # 32-bit mtime # 16-bit length of original file path # original file path # data - + # To save memory and avoid copying the data, we add the header to the original data reference # After writing the file, we remove the header so callers don't have to worry about their # data being modified - + my $ref = $data->{data_ref}; - + $data->{content_type} ||= ''; $data->{mtime} ||= 0; $data->{original_path} ||= ''; - - my $packed = pack( 'A3LS', $data->{content_type}, $data->{mtime}, length( $data->{original_path} ) ) - . $data->{original_path}; - + + # Check if the original_path contains wide characters + my $encoded_path = Slim::Utils::Unicode::utf8off($data->{original_path}); + my $packed = pack( 'A3LS', $data->{content_type}, $data->{mtime}, length( $encoded_path ) ) + . $encoded_path; + # Prepend the packed header to the original data substr $$ref, 0, 0, $packed; - + $self->SUPER::set($key, $$ref); - + # Remove the packed header substr $$ref, 0, length($packed), ''; } sub get { my ( $self, $key ) = @_; - + my $buf = $self->SUPER::get($key); - + return unless defined $buf; - + # unpack data and strip header from data as we go my ($content_type, $mtime, $pathlen) = unpack( 'A3LS', substr( $buf, 0, 9, '' ) ); my $original_path = substr $buf, 0, $pathlen, ''; - + return { content_type => $content_type, mtime => $mtime, @@ -108,18 +118,18 @@ sub _init_db { my $retry = shift; return $self->{dbh} if $self->{dbh}; - + my $dbfile = $self->_get_dbfile; my $oldDBfile = catfile( $self->{root}, 'ArtworkCache.db' ); - + if ($self->{namespace} eq 'artwork' && !-f $dbfile && -r $oldDBfile) { require File::Copy; - + if ( !File::Copy::move( $oldDBfile, $dbfile ) ) { warn "Unable to rename $oldDBfile to $dbfile: $!. Please do so manually!"; } } - + return $self->SUPER::_init_db($retry); } diff --git a/Slim/Utils/Errno.pm b/Slim/Utils/Errno.pm index 9edfcc948aa..fd183fb77e9 100644 --- a/Slim/Utils/Errno.pm +++ b/Slim/Utils/Errno.pm @@ -40,19 +40,11 @@ our @EXPORT = qw(EWOULDBLOCK EINPROGRESS EINTR ECHILD EBADF); BEGIN { if (main::ISWINDOWS) { - if (main::ISACTIVEPERL) { - *EINTR = sub () { 10004 }; - *EBADF = sub () { 10009 }; - *ECHILD = sub () { 10010 }; - *EWOULDBLOCK = sub () { 10035 }; - *EINPROGRESS = sub () { 10036 }; - } else { - *EINTR = sub () { 4 }; - *EBADF = sub () { 9 }; - *ECHILD = sub () { 10 }; - *EWOULDBLOCK = sub () { 140 }; - *EINPROGRESS = sub () { 112 }; - } + *EINTR = sub () { 4 }; + *EBADF = sub () { 9 }; + *ECHILD = sub () { 10 }; + *EWOULDBLOCK = sub () { 140 }; + *EINPROGRESS = sub () { 112 }; } else { require Errno; import Errno qw(EWOULDBLOCK EINPROGRESS EINTR ECHILD EBADF); diff --git a/Slim/Utils/ImageResizer.pm b/Slim/Utils/ImageResizer.pm index 62123d97fcc..a44fa314623 100644 --- a/Slim/Utils/ImageResizer.pm +++ b/Slim/Utils/ImageResizer.pm @@ -1,5 +1,11 @@ package Slim::Utils::ImageResizer; +# Logitech Media Server Copyright 2001-2024 Logitech. +# Lyrion Music Server Copyright 2025 Lyrion Community. +# This program is free software; you can redistribute it and/or +# modify it under the terms of the GNU General Public License, +# version 2. + use strict; use Config; @@ -49,7 +55,8 @@ sub resize { my $isDebug = main::DEBUGLOG && $log->is_debug; # Check for callback, and that the gdresized daemon running and read/writable - if (!main::ISWINDOWS && hasDaemon() && $callback) { + # unfortunately AnyEvent seems to struggle with wide characters... + if (!main::ISWINDOWS && hasDaemon() && $callback && !utf8::is_utf8($file)) { require AnyEvent::Socket; require AnyEvent::Handle; @@ -64,7 +71,7 @@ sub resize { # Daemon available, do an async resize AnyEvent::Socket::tcp_connect( 'unix/', SOCKET_PATH, sub { my $fh = shift || do { - $log->error("daemon failed to connect: $!"); + $log->warn("daemon failed to connect: $!"); $hasDaemon = undef; if ( --$pending_requests == 0 ) { diff --git a/Slim/Utils/Light.pm b/Slim/Utils/Light.pm index baae1ede5ed..9723e48dc5b 100644 --- a/Slim/Utils/Light.pm +++ b/Slim/Utils/Light.pm @@ -110,22 +110,9 @@ sub loadStrings { my $language = ''; my $stringname = ''; - # server string file - my $file; - - # let's see whether this is a PerlApp/Tray compiled executable - if (defined $PerlApp::VERSION) { - $file = PerlApp::extract_bound_file('strings.txt'); - } - elsif (defined $PerlTray::VERSION) { - $file = PerlTray::extract_bound_file('strings.txt'); - } - # try to find the strings.txt file from our installation - unless ($file && -f $file) { - my $path = $os->dirsFor('strings'); - $file = catdir($path, 'strings.txt'); - } + my $path = $os->dirsFor('strings'); + my $file = catdir($path, 'strings.txt'); open(STRINGS, "<:utf8", $file) || do { warn "Couldn't open file [$file]!"; diff --git a/Slim/Utils/Log.pm b/Slim/Utils/Log.pm index eb33af775d7..7868762de91 100644 --- a/Slim/Utils/Log.pm +++ b/Slim/Utils/Log.pm @@ -893,6 +893,7 @@ sub logLevels { 'network.asyncdns' => 'ERROR', 'network.asynchttp' => 'ERROR', + 'network.ws' => 'ERROR', 'network.http' => 'ERROR', 'network.protocol' => 'ERROR', 'network.protocol.slimproto' => 'ERROR', @@ -907,7 +908,6 @@ sub logLevels { 'formats.metadata' => 'ERROR', 'database.info' => 'ERROR', - 'database.mysql' => 'ERROR', 'database.sql' => 'ERROR', 'database.virtuallibraries' => 'ERROR', diff --git a/Slim/Utils/Misc.pm b/Slim/Utils/Misc.pm index 1533f029e27..d4d4a191f64 100644 --- a/Slim/Utils/Misc.pm +++ b/Slim/Utils/Misc.pm @@ -235,22 +235,6 @@ sub pathFromFileURL { return $url; } - # Bug: 1786 - # - # Work around a perl bug that exists in 5.8.0, 5.8.1 & 5.8.2? - where - # a join() can return garbage because it's internal scratch space - # wasn't properly cleared with a UTF8 string that previously went - # through it. The call to $uri->file() below contains such a join, and - # was causing bogus data to be returned on OSX 10.3.x systems. - # - # See - # http://lists.bestpractical.com/pipermail/rt-devel/2004-January/005283.html - # for some more information. - if ($] > 5.007 && $] <= 5.008002) { - - $url = Slim::Utils::Unicode::utf8off($url); - } - # Bug 3589, support win32 backslashes in URLs, file://C:\foo\bar $url =~ s/\\/\//g; @@ -1436,21 +1420,6 @@ sub shouldCacheURL { return 1; } -=head2 runningAsService ( ) - -Returns true if running as a Windows service. - -=cut - -sub runningAsService { if (main::ISACTIVEPERL) { - - if (defined(&PerlSvc::RunningAsService) && PerlSvc::RunningAsService()) { - return 1; - } - - return 0; -} } - =head2 validMacAddress ( ) Returns true if string is in correct form of a mac address diff --git a/Slim/Utils/MySQLHelper.pm b/Slim/Utils/MySQLHelper.pm index 93833fe40fe..4e6165926a7 100644 --- a/Slim/Utils/MySQLHelper.pm +++ b/Slim/Utils/MySQLHelper.pm @@ -65,6 +65,8 @@ Initializes the entire MySQL subsystem - creates the config file, and starts the sub init { my $class = shift; + $log->error("MySQL is no longer supported! Use at your own risk - and don't complain if it doesn't work. Remove the 'dbsource' from your configuration."); + # Reset dbsource pref if it's not for MySQL if ( $prefs->get('dbsource') !~ /^dbi:mysql/ ) { $prefs->set( dbsource => default_dbsource() ); @@ -74,10 +76,6 @@ sub init { # Check to see if our private port is being used. If not, we'll assume # the user has setup their own copy of MySQL. if ($prefs->get('dbsource') !~ /port=9092/) { - - main::INFOLOG && $log->info("Not starting MySQL - looks to be user/system configured."); - Slim::Utils::OSDetect::getOS->initMySQL($class); - return 1; } diff --git a/Slim/Utils/Network.pm b/Slim/Utils/Network.pm index 55fabf68d8c..486646a9874 100644 --- a/Slim/Utils/Network.pm +++ b/Slim/Utils/Network.pm @@ -50,7 +50,7 @@ sub blocking { my $nonblocking = $_[0] ? "0" : "1"; my $retval = ioctl($sock, 0x8004667e, \$nonblocking); - if (!defined($retval) && $] >= 5.008) { + if (!defined($retval)) { $retval = "0 but true"; } diff --git a/Slim/Utils/OS.pm b/Slim/Utils/OS.pm index e8bee5ffd39..1fa9a11a586 100644 --- a/Slim/Utils/OS.pm +++ b/Slim/Utils/OS.pm @@ -131,36 +131,6 @@ sub initSearchPath { } } -=head2 initMySQL( ) - -Provide a hook to do system specific MySQL initialization. This allows to eg. use a locally installed -MySQL server instead of the instance installed with SC - -=cut - -sub initMySQL { - my ($class, $dbclass) = @_; - - require File::Which; - - # try to figure out whether we have a locally running MySQL - # which we can connect to using a socket file - my $mysql_config = File::Which::which('mysql_config'); - - # The user might have a socket file in a non-standard - # location. See bug 3443 - if ($mysql_config && -x $mysql_config) { - - my $socket = `$mysql_config --socket`; - chomp($socket); - - if ($socket && -S $socket) { - $dbclass->socketFile($socket); - } - - } -} - =head2 dirsFor( $dir ) Return OS Specific directories. @@ -264,10 +234,6 @@ sub scanner { return "$Bin/scanner.pl"; } -sub gdresize { - return "$Bin/gdresize.pl"; -} - sub gdresized { return "$Bin/gdresized.pl"; } diff --git a/Slim/Utils/OS/Debian.pm b/Slim/Utils/OS/Debian.pm index a247103f952..5ee0224d70c 100644 --- a/Slim/Utils/OS/Debian.pm +++ b/Slim/Utils/OS/Debian.pm @@ -47,7 +47,7 @@ sub dirsFor { push @dirs, $class->SUPER::dirsFor($dir); - } elsif ($dir =~ /^(?:Firmware|Graphics|HTML|IR|MySQL|SQL|lib|Bin)$/) { + } elsif ($dir =~ /^(?:Firmware|Graphics|HTML|IR|SQL|lib|Bin)$/) { push @dirs, "/usr/share/squeezeboxserver/$dir"; @@ -64,12 +64,6 @@ sub dirsFor { push @dirs, "/usr/share/squeezeboxserver"; - # Because we use the system MySQL, we need to point to the right - # directory for the errmsg. files. Default to english. - } elsif ($dir eq 'mysql-language') { - - push @dirs, "/usr/share/mysql/english"; - } elsif ($dir =~ /^(?:types|convert)$/) { push @dirs, "/etc/squeezeboxserver"; diff --git a/Slim/Utils/OS/Docker.pm b/Slim/Utils/OS/Docker.pm new file mode 100644 index 00000000000..f029c9a4b1c --- /dev/null +++ b/Slim/Utils/OS/Docker.pm @@ -0,0 +1,148 @@ +package Slim::Utils::OS::Docker; + +use strict; +use File::Spec::Functions qw(catdir); + +use base qw(Slim::Utils::OS::Linux); + +# the following folders are defined in Dockerfile +use constant MUSIC_DIR => '/music'; +use constant PLAYLIST_DIR => '/playlist'; + +sub initDetails { + my $class = shift; + + $class->{osDetails} = $class->SUPER::initDetails(); + $class->{osDetails}->{osName} .= " (Docker)"; + + return $class->{osDetails}; +} + +sub initPrefs { + my ($class, $prefs) = @_; + + if (-d MUSIC_DIR) { + $prefs->{mediadirs} = $prefs->{ignoreInImageScan} = $prefs->{ignoreInVideoScan} = [ MUSIC_DIR ]; + } + + # we're read-only in the scanner - don't initialize the libraryname here + return if main::SCANNER || main::RESIZER; + + my $hostname = Slim::Utils::Network::hostName() || ''; + + # if the hostname is a 12 character hex string, it's probably a Docker container ID + if (!$hostname || $hostname =~ /^[a-f0-9]{12}$/) { + $prefs->{libraryname} = 'Lyrion Music Server (Docker)'; + } + else { + $prefs->{libraryname} = $hostname; + } +} + +sub dirsFor { + my ($class, $dir) = @_; + + my @dirs = $class->SUPER::dirsFor($dir); + + if ($dir eq 'music' && -d MUSIC_DIR) { + push @dirs, MUSIC_DIR; + } + if ($dir eq 'playlists' && -d PLAYLIST_DIR) { + push @dirs, PLAYLIST_DIR; + } + elsif ($dir eq 'Plugins') { + push @dirs, catdir($::cachedir, 'Plugins'); + push @INC, $::cachedir; + } + + return wantarray() ? @dirs : $dirs[0]; +} + +sub ignoredItems { + return ( + # system paths in the fs root which will not contain any music + 'bin' => '/', + 'boot' => '/', + 'config' => '/', + 'dev' => '/', + 'etc' => '/', + 'lib' => '/', + 'lib64' => '/', + 'opt' => '/', + 'proc' => '/', + 'run' => '/', + 'sbin' => '/', + 'srv' => '/', + 'sys' => '/', + 'tmp' => '/', + 'usr' => '/', + 'var' => '/', + # Docker has become popular on Synology... add some of the Synology specific exceptions: + '@AntiVirus' => 1, + '@appstore' => 1, # Synology package manager + '@autoupdate' => 1, + '@clamav' => 1, + '@cloudsync' => 1, + '@database' => 1, # databases store + '@download' => 1, + '@eaDir' => 1, # media indexer meta data + '@img_bkp_cache' => 1, + '@maillog' => 1, + '@MailScanner' => 1, + '@optware' => 1, # NSLU2-Linux Optware system + '@postfix' => 1, + '@quarantine' => 1, + '@S2S' => 1, + '@sharesnap' => 1, + '@spool' => 1, # mail/print/.. spool + '@SynoFinder-log' => 1, + '@synodlvolumeche.core' => 1, + '@SynologyApplicationService' => 1, + '@synologydrive' => 1, + '@SynologyDriveShareSync' => 1, + '@synopkg' => 1, + '@synovideostation' => 1, + '@tmp' => 1, # system temporary files + 'upd@te' => 1, # firmware update temporary directory + '#recycle' => 1, + '#snapshot' => 1, + ); +} + +sub aclFiletest { + return sub { + my $path = shift || return; + + { + use filetest 'access'; + return (! -r $path) ? 0 : 1; + } + }; +} + +sub installerOS { 'src' }; + +# we don't really support auto-update, but we need to make the update checker believe so, or it wouldn't check for us +sub canAutoUpdate { + # make sure auto download is always enabled - we don't rally auto-update, but this way we're called when we have update info + Slim::Utils::Prefs::preferences('server')->set('autoDownloadUpdate', 1); + + # dirty hack to only return true when called from the update checker... + my ($subr) = (caller(1))[3]; + return $subr eq 'Slim::Utils::Update::checkVersion' ? 1 : 0; +} + +sub runningFromSource { + # dirty hack to only return true when called from the settings handler... + my ($subr) = (caller(1))[3]; + return $subr eq 'Slim::Web::Settings::Server::Software::handler' ? 1 : 0; +} + +# set global variable to be shown in the web UI, but don't return anything to not trigger any download +sub getUpdateParams { + $::newVersion = Slim::Utils::Strings::string('SERVER_UPDATE_AVAILABLE_SHORT'); + return; +} + + +1; \ No newline at end of file diff --git a/Slim/Utils/OS/OSX.pm b/Slim/Utils/OS/OSX.pm index da84073eab7..a755b8dce4f 100644 --- a/Slim/Utils/OS/OSX.pm +++ b/Slim/Utils/OS/OSX.pm @@ -20,6 +20,9 @@ use POSIX qw(LC_CTYPE LC_TIME); use constant IS_MENUBAR_ITEM => $Bin =~ m|app/Contents/| ? 1 : 0; use constant CHECK_MENUBAR_ITEM_DURATION => 30; +# Enable this for update checker testing/development +use constant UPGRADE_TESTING => 0; + my $canFollowAlias; sub name { @@ -160,7 +163,7 @@ sub dirsFor { push @dirs, $Bin; - } elsif ($dir =~ /^(?:Graphics|HTML|IR|Plugins|MySQL)$/) { + } elsif ($dir =~ /^(?:Graphics|HTML|IR|Plugins)$/) { push @dirs, "$ENV{'HOME'}/Library/Application Support/Squeezebox/$dir"; push @dirs, catdir($Bin, $dir); @@ -210,7 +213,7 @@ sub dirsFor { push @dirs, "$Bin/../.."; # we don't want these values to return a value - } elsif ($dir =~ /^(?:libpath|mysql-language)$/) { + } elsif ($dir =~ /^(?:libpath)$/) { } else { @@ -525,4 +528,29 @@ sub handleMenuBarItemActivity { } } +# if update checker testing is enabled, return false, even if we're running from source +# this really should only be used when I'm testing locally - mh +my $updateCheckInitialized; +sub runningFromSource { + my $isRunningFromSource = shelf->SUPER::runningFromSource(@_); + + if (UPGRADE_TESTING && $isRunningFromSource) { + return if $updateCheckInitialized++; + + require Slim::Utils::Update; + Slim::Utils::Timers::setTimer( + undef, + time() + 3, + \&Slim::Utils::Update::checkVersion, + ); + + # reset the last time we checked for updates so we check immediately + Slim::Utils::Prefs::preferences('server')->set('checkVersionLastTime', 0); + + return 1; + } + + return $isRunningFromSource; +} + 1; diff --git a/Slim/Utils/OS/RedHat.pm b/Slim/Utils/OS/RedHat.pm index 41f52bc3db0..621598bff12 100644 --- a/Slim/Utils/OS/RedHat.pm +++ b/Slim/Utils/OS/RedHat.pm @@ -39,7 +39,7 @@ sub dirsFor { push @dirs, $class->SUPER::dirsFor($dir); - } elsif ($dir =~ /^(?:Firmware|Graphics|HTML|IR|MySQL|SQL|lib|Bin)$/) { + } elsif ($dir =~ /^(?:Firmware|Graphics|HTML|IR|SQL|lib|Bin)$/) { push @dirs, "/usr/share/lyrionmusicserver/$dir"; @@ -57,12 +57,6 @@ sub dirsFor { push @dirs, "/usr/share/lyrionmusicserver"; - # Because we use the system MySQL, we need to point to the right - # directory for the errmsg. files. Default to english. - } elsif ($dir eq 'mysql-language') { - - push @dirs, "/usr/share/mysql/english"; - } elsif ($dir =~ /^(?:types|convert)$/) { push @dirs, "/etc/lyrionmusicserver"; diff --git a/Slim/Utils/OS/Unix.pm b/Slim/Utils/OS/Unix.pm index f90a965b27a..f60186e5676 100644 --- a/Slim/Utils/OS/Unix.pm +++ b/Slim/Utils/OS/Unix.pm @@ -70,7 +70,7 @@ sub dirsFor { push @dirs, ''; # we don't want these values to return a(nother) value - } elsif ($dir =~ /^(?:libpath|mysql-language)$/) { + } elsif ($dir =~ /^(?:libpath)$/) { } elsif ($dir eq 'prefs' && $::prefsdir) { diff --git a/Slim/Utils/OS/Win32.pm b/Slim/Utils/OS/Win32.pm index c67f9c9d09e..b8f8b1c7b40 100644 --- a/Slim/Utils/OS/Win32.pm +++ b/Slim/Utils/OS/Win32.pm @@ -25,12 +25,6 @@ my $driveList = {}; my $driveState = {}; my $writablePath; -sub getFlavor { - return (!main::ISACTIVEPERL && Win32::GetOSDisplayName() =~ /64-bit/i) - ? 'Win64' - : 'Win32'; -} - sub name { return 'win'; } @@ -114,15 +108,6 @@ sub initDetails { # This covers Vista or later $class->{osDetails}->{'isWin6+'} = ($major >= 6); - # some features are Vista only, no longer supported in Windows 7 - $class->{osDetails}->{isVista} = 1 if $class->{osDetails}->{'osName'} =~ /Vista/; - - # let's clean up our temporary folders (pdk* folders) - # only run when using the compiled version - if ($PerlSvc::VERSION && !main::SCANNER) { - $class->cleanupTempDirs(); - } - return $class->{osDetails}; } @@ -137,8 +122,6 @@ sub initSearchPath { } } -sub initMySQL {} - sub canDBHighMem { 1 } sub dirsFor { @@ -223,7 +206,7 @@ sub dirsFor { push @dirs, $path; # we don't want these values to return a value - } elsif ($dir =~ /^(?:libpath|mysql-language)$/) { + } elsif ($dir =~ /^(?:libpath)$/) { } else { @@ -288,18 +271,6 @@ sub getFileName { return $path; } -sub scanner { - return -x "$Bin/scanner.exe" ? "$Bin/scanner.exe" : $_[0]->SUPER::scanner(); -} - -sub gdresize { - return -x "$Bin/gdresize.exe" ? "$Bin/gdresize.exe" : $_[0]->SUPER::gdresize(); -} - -sub gdresized { - return -x "$Bin/gdresized.exe" ? "$Bin/gdresized.exe" : $_[0]->SUPER::gdresized(); -} - sub localeDetails { eval { use POSIX qw(LC_TIME); }; require Win32::Locale; @@ -652,116 +623,5 @@ Get the current priority of the server. Disabled on Windows. sub getPriority {} -=head2 cleanupTempDirs( ) - -PDK compiled executables can leave temporary pdk-{username}-{pid} folders behind -if process is crashing. Use this method to clean them up. - -=cut - -sub cleanupTempDirs { - - my $dir = $ENV{TEMP}; - - return unless $dir && -d $dir; - - opendir(DIR, $dir) || return; - - my @folders = readdir(DIR); - close(DIR); - - my %pdkFolders; - for my $entry (@folders) { - if ($entry =~ /^pdk-.*?-(\d+)$/i) { - $pdkFolders{$1} = $entry - } - } - - return unless scalar(keys %pdkFolders); - - require File::Path; - require Win32::Process::List; - my $p = Win32::Process::List->new(); - my %processes = $p->GetProcesses(); - - foreach my $pid (keys %pdkFolders) { - - # don't remove files if process is still running... - next if $processes{$pid}; - - my $path = catdir($dir, $pdkFolders{$pid}); - next unless -d $path; - - eval { File::Path::rmtree($path) }; - } -} - - -sub getUpdateParams { - my ($class, $url) = @_; - - return { - path => $class->dirsFor('updates'), - }; -} - -sub canAutoUpdate { 1 } - -# return file extension filter for installer -sub installerExtension { '(?:exe|msi)' } - -sub installerOS { 'win' } - -sub restartServer { - my $class = shift; - - my $log = Slim::Utils::Log::logger('server.update'); - - - if (!$class->canRestartServer()) { - $log->warn("Lyrion Music Server can't be restarted automatically on Windows if run from the perl source."); - return; - } - - if ($PerlSvc::VERSION && PerlSvc::RunningAsService()) { - - my $svcHelper = Win32::GetShortPathName( catdir( $class->installPath, 'server', 'squeezesvc.exe' ) ); - my $processObj; - - Slim::bootstrap::tryModuleLoad('Win32::Process'); - - if ($@ || !Win32::Process::Create( - $processObj, - $svcHelper, - "$svcHelper --restart", - 0, - Win32::Process::DETACHED_PROCESS() | Win32::Process::CREATE_NO_WINDOW() | Win32::Process::NORMAL_PRIORITY_CLASS(), - ".") - ) { - $log->error("Couldn't restart Lyrion Music Server service (squeezesvc)"); - } - else { - return 1; - } - } - - elsif ($PerlSvc::VERSION) { - - my $restartFlag = catdir( Slim::Utils::Prefs::preferences('server')->get('cachedir') || scalar $class->dirsFor('cache'), 'restart.txt' ); - if (open(RESTART, ">$restartFlag")) { - close RESTART; - main::stopServer(); - return 1; - } - - else { - $log->error("Can't write restart flag ($restartFlag) - don't shut down"); - } - } - - return; -} - -sub canRestartServer { return $PerlSvc::VERSION ? 1 : 0; } 1; diff --git a/Slim/Utils/OS/Win64.pm b/Slim/Utils/OS/Win64.pm index 7ab49e9f7d2..487f5564d09 100644 --- a/Slim/Utils/OS/Win64.pm +++ b/Slim/Utils/OS/Win64.pm @@ -44,14 +44,6 @@ sub initSearchPath { Slim::Utils::Misc::addFindBinPaths(catdir($_[0] || $class->dirsFor('Bin'), $binArch)); } - -sub scanner { "$Bin/scanner.pl" } - -sub gdresize { "$Bin/gdresize.pl" } - -sub gdresized { "$Bin/gdresized.pl" } - - sub runService { if ($main::daemon) { my $class = shift; diff --git a/Slim/Utils/OSDetect.pm b/Slim/Utils/OSDetect.pm index dacbe64fc59..52366ec6d6d 100644 --- a/Slim/Utils/OSDetect.pm +++ b/Slim/Utils/OSDetect.pm @@ -76,14 +76,8 @@ sub init { } elsif ($^O =~ /^m?s?win/i) { - require Slim::Utils::OS::Win32; - if (Slim::Utils::OS::Win32->getFlavor() eq 'Win64') { - require Slim::Utils::OS::Win64; - $os = Slim::Utils::OS::Win64->new(); - } - else { - $os = Slim::Utils::OS::Win32->new(); - } + require Slim::Utils::OS::Win64; + $os = Slim::Utils::OS::Win64->new(); } elsif ($^O =~ /linux/i) { diff --git a/Slim/Utils/Prefs.pm b/Slim/Utils/Prefs.pm index 489e6e8db3c..ad866f3d6a2 100644 --- a/Slim/Utils/Prefs.pm +++ b/Slim/Utils/Prefs.pm @@ -1,6 +1,7 @@ package Slim::Utils::Prefs; - +# Logitech Media Server Copyright 2001-2024 Logitech. +# Lyrion Music Server Copyright 2025 Lyrion Community. # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License, # version 2. @@ -261,6 +262,7 @@ sub init { 'refreshRate' => 30, 'coverArt' => '', 'artfolder' => '', + 'noContributorPictures' => 0, 'thumbSize' => 100, 'useLocalImageproxy' => main::ISWINDOWS ? 1 : 2, # Server Settings - jive UI @@ -275,7 +277,7 @@ sub init { 'composerAlbumLink' => $prefs->get('useUnifiedArtistsList') && $prefs->get('composerInArtists'), 'conductorAlbumLink' => $prefs->get('useUnifiedArtistsList') && $prefs->get('conductorInArtists'), 'bandAlbumLink' => $prefs->get('useUnifiedArtistsList') && $prefs->get('bandInArtists'), - 'worksScan'=> $prefs->get("showComposerReleasesbyAlbum") || 2, + 'worksScan' => $prefs->get("showComposerReleasesbyAlbum") || 2, ); # we can have different defaults depending on the OS @@ -295,6 +297,9 @@ sub init { # initialise any new prefs $prefs->init(\%defaults, 'Slim::Utils::Prefs::Migration'); + # remove some SN/MySB legacy + $prefs->remove(qw(snInitErrors snLastSyncDown sn_disable_stats sn_disabled_plugins sn_email sn_protocolhandlers sn_session sn_sync)); + # perform OS-specific post-init steps $os->postInitPrefs($prefs); diff --git a/Slim/Utils/Prefs/Migration/README.md b/Slim/Utils/Prefs/Migration/README.md deleted file mode 100644 index 3f7c0618cf4..00000000000 --- a/Slim/Utils/Prefs/Migration/README.md +++ /dev/null @@ -1,6 +0,0 @@ -IMPORTANT -========= - -Whenever you add a new migration module (be it Vx.pm or ClientVx.pm), make sure you add it to -the Windows build file [squeezecenter.perlsvc](https://github.com/LMS-Community/slimserver-platforms/blob/public/8.0/win32/squeezecenter.perlsvc). -Otherwise the Windows build will not include it in the binary and fail to load. \ No newline at end of file diff --git a/Slim/Utils/SQLiteHelper.pm b/Slim/Utils/SQLiteHelper.pm index cf967ac8e22..63af90402ab 100644 --- a/Slim/Utils/SQLiteHelper.pm +++ b/Slim/Utils/SQLiteHelper.pm @@ -255,16 +255,9 @@ sub concatFunction { ' || ' } =head2 sqlVersion( $dbh ) -Returns the version of MySQL that the $dbh is connected to. - =cut -sub sqlVersion { - my $class = shift; - my $dbh = shift || return 0; - - return 'SQLite'; -} +sub sqlVersion { 'SQLite' } =head2 sqlVersionLong( $dbh ) diff --git a/Slim/Utils/Scanner/API.pm b/Slim/Utils/Scanner/API.pm index 8f70b101120..3a8f7ffe718 100644 --- a/Slim/Utils/Scanner/API.pm +++ b/Slim/Utils/Scanner/API.pm @@ -45,8 +45,6 @@ Multiple handlers may be registered, and they are called in the order they were my @onNewTrack; my @onDeletedTrack; my @onChangedTrack; -my @onNewImage; -my @onNewVideo; my @onNewPlaylist; my @onDeletedPlaylist; my @onFinished; @@ -160,13 +158,6 @@ sub _makeDispatcher { Slim::Utils::Log::logError("Error in $type plugin handler for " . $opts->{url} . " ($method): $@"); } } - else { # Images/Videos - eval { $h->{cb}->( $opts->{hashref} ) }; - if ( $@ ) { - my $method = main::DEBUGLOG ? Slim::Utils::PerlRunTime::realNameForCodeRef( $h->{cb} ) : 'unk'; - Slim::Utils::Log::logError("Error in $type plugin handler for " . $opts->{hashref}->{url} . " ($method): $@"); - } - } } }; } @@ -194,12 +185,6 @@ sub getHandlers { onNewTrackHandler => _makeDispatcher( \@onNewTrack, 'Track', 'onNewTrack' ), onDeletedTrackHandler => _makeDispatcher( \@onDeletedTrack, 'Track', 'onDeletedTrack' ), onChangedTrackHandler => _makeDispatcher( \@onChangedTrack, 'Track', 'onChangedTrack' ), - onNewImageHandler => _makeDispatcher( \@onNewImage, undef, 'onNewImage' ), - # onDeletedImageHandler - # onChangedImageHandler - onNewVideoHandler => _makeDispatcher( \@onNewVideo, undef, 'onNewVideo' ), - # onDeletedVideoHandler - # onChangedVideoHandler onNewPlaylistHandler => _makeDispatcher( \@onNewPlaylist, 'Playlist', 'onNewPlaylist' ), onDeletedPlaylistHandler => _makeDispatcher( \@onDeletedPlaylist, 'Playlist', 'onDeletedPlaylist' ), onFinishedHandler => _makeFinishedDispatcher( \@onFinished ), diff --git a/Slim/Utils/ServiceManager.pm b/Slim/Utils/ServiceManager.pm deleted file mode 100644 index 9b0bd00a424..00000000000 --- a/Slim/Utils/ServiceManager.pm +++ /dev/null @@ -1,129 +0,0 @@ -package Slim::Utils::ServiceManager; - -# Logitech Media Server Copyright 2001-2024 Logitech. -# Lyrion Music Server Copyright 2024 Lyrion Community. -# This program is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License, -# version 2. - -use Exporter::Lite; -@ISA = qw(Exporter); - -our @EXPORT = qw( - SC_STARTUP_TYPE_LOGIN SC_STARTUP_TYPE_NONE SC_STARTUP_TYPE_SERVICE - SC_STATE_STOPPED SC_STATE_RUNNING SC_STATE_STARTING SC_STATE_STOPPING SC_STATE_UNKNOWN -); - -use File::Spec::Functions qw(catdir); -use Socket; - -use Slim::Utils::OSDetect; -use Slim::Utils::Light; - -use constant SC_STARTUP_TYPE_NONE => 0; -use constant SC_STARTUP_TYPE_LOGIN => 1; -use constant SC_STARTUP_TYPE_SERVICE => 2; - -use constant SC_STATE_STOPPED => 0; -use constant SC_STATE_RUNNING => 1; -use constant SC_STATE_STARTING => -1; -use constant SC_STATE_STOPPING => -2; -use constant SC_STATE_UNKNOWN => -99; - -Slim::Utils::OSDetect::init(); - -sub new { - my $class = shift; - - my $svcMgr; - - if (Slim::Utils::OSDetect::isWindows()) { - - require Slim::Utils::ServiceManager::Win32; - $svcMgr = Slim::Utils::ServiceManager::Win32->init(); - - } - - elsif (Slim::Utils::OSDetect::isMac()) { - - require Slim::Utils::ServiceManager::OSX; - $svcMgr = Slim::Utils::ServiceManager::OSX->init(); - - } - - return $svcMgr || $class->init(); -} - -sub init { - my $class = shift; - - my $self = { - checkHTTP => 0, - status => SC_STATE_UNKNOWN, - }; - - return bless $self, $class; -} - -# Determine how the user wants to start Lyrion Music Server -sub getStartupType { - return SC_STARTUP_TYPE_NONE; -} - -sub canSetStartupType { 0 } -sub setStartupType {} -sub initStartupType {} -sub canStart {} - -sub getStartupOptions { - return ('', 'RUN_NEVER', 'RUN_AT_LOGIN', 'RUN_AT_BOOT'); -} - -sub start {} - -sub checkServiceState { - return SC_STATE_UNKNOWN; -} - -# we're called often - cache results for a second -my %isRunning; -sub isRunning { - - if (!defined $isRunning{state} || $isRunning{ttl} < time()) { - - %isRunning = ( - ttl => time() + 1, - state => $_[0]->checkServiceState() == SC_STATE_RUNNING - ); - - } - - return $isRunning{state}; -} - -sub getServiceState { - return defined $_[0]->{status} ? $_[0]->{status} : SC_STATE_UNKNOWN; -} - -sub checkForHTTP { - my $httpPort = getPref('httpport') || 9000; - - # Use low-level socket code. IO::Socket returns a 'Invalid Descriptor' - # erorr. It also sucks more memory than it should. - my $rport = $httpPort; - - my $iaddr = inet_aton('127.0.0.1'); - my $paddr = sockaddr_in($rport, $iaddr); - - socket(SSERVER, PF_INET, SOCK_STREAM, getprotobyname('tcp')); - - if (connect(SSERVER, $paddr)) { - - close(SSERVER); - return "http://127.0.0.1:$httpPort"; - } - - return 0; -} - -1; diff --git a/Slim/Utils/ServiceManager/OSX.pm b/Slim/Utils/ServiceManager/OSX.pm deleted file mode 100644 index 390a3cbdeec..00000000000 --- a/Slim/Utils/ServiceManager/OSX.pm +++ /dev/null @@ -1,56 +0,0 @@ -package Slim::Utils::ServiceManager::OSX; - -# Logitech Media Server Copyright 2001-2024 Logitech. -# Lyrion Music Server Copyright 2024 Lyrion Community. -# This program is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License, -# version 2. - -use base qw(Slim::Utils::ServiceManager); - -use FindBin qw($Bin); -use File::Spec::Functions qw(catdir); -use Slim::Utils::ServiceManager; - -# re-use the startup-script we already have in place for the PreferencePane -sub canStart { 1 } -sub start { - my ($class, $params) = @_; - - foreach my $path ( - catdir($Bin, '..', 'platforms', 'osx', 'Preference Pane'), - catdir($Bin, '..', 'Resources'), - catdir($ENV{HOME}, '/Library/PreferencePanes/SqueezeCenter.prefPane/Contents/Resources'), - '/Library/PreferencePanes/SqueezeCenter.prefPane/Contents/Resources', - ) { - my $startScript = catdir($path, 'start-server.sh'); - - if (-f $startScript) { - - $startScript =~ s/ /\\ /g; - system( $startScript . ($params ? " $params" : '') ); - - last; - } - } - -} - -sub getStartupOptions { - return ("I'm sorry, we're not quite there yet", 'Whatever is defined in the PrefPane'); -} - -# simple check so far - only check http availability (no starting/stopping states) -sub checkServiceState { - my ($class) = @_; - - $class->{status} = $class->checkForHTTP() ? SC_STATE_RUNNING : SC_STATE_STOPPED; - - return $class->{status}; -} - -# use AppleScript to run some script as admin -# ugly but effective -# system('osascript -e \'do shell script "/run/something" with administrator privileges\''); - -1; \ No newline at end of file diff --git a/Slim/Utils/ServiceManager/Win32.pm b/Slim/Utils/ServiceManager/Win32.pm deleted file mode 100644 index 4628b9f8e49..00000000000 --- a/Slim/Utils/ServiceManager/Win32.pm +++ /dev/null @@ -1,248 +0,0 @@ -package Slim::Utils::ServiceManager::Win32; - -# Logitech Media Server Copyright 2001-2024 Logitech. -# Lyrion Music Server Copyright 2024 Lyrion Community. -# This program is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License, -# version 2. - -use base qw(Slim::Utils::ServiceManager); - -use File::Spec::Functions qw(catdir); -use FindBin qw($Bin); -use Win32::Process qw(DETACHED_PROCESS CREATE_NO_WINDOW NORMAL_PRIORITY_CLASS); -use Win32::Process::List; -use Win32::Service; -use Win32::TieRegistry ('Delimiter' => '/'); - -use constant LEGACY_USER_REGISTRY_KEY => 'CUser/Software/Logitech/Squeezebox'; -use constant USER_REGISTRY_KEY => 'CUser/Software/Lyrion/server'; -use constant SC_SERVICE_NAME => 'squeezesvc'; - -use Slim::Utils::OSDetect; -use Slim::Utils::ServiceManager; - -my $os = Slim::Utils::OSDetect::getOS(); -my $svcHelper; - -sub init { - my $class = shift; - $class = $class->SUPER::init(); - $svcHelper = catdir( Win32::GetShortPathName( scalar $os->dirsFor('base') ), 'server', 'squeezesvc.exe' ); - - return $class; -} - -# Determine how the user wants to start Lyrion Music Server -sub getStartupType { - my %services; - - Win32::Service::GetServices('', \%services); - - if (grep {$services{$_} =~ /squeezesvc/} keys %services) { - return SC_STARTUP_TYPE_SERVICE; - } - - if ($Registry->{USER_REGISTRY_KEY . '/StartAtLogin'}) { - return SC_STARTUP_TYPE_LOGIN; - } - - return SC_STARTUP_TYPE_NONE; -} - -sub canSetStartupType { - - # on Vista+ we can elevate privileges - if ($os->get('isVista')) { - return 1; - } - - # on other Windows versions we have to be member of the administrators group to be able to manage the service - # only return true if SC isn't configured to be run as a background service, OR if the user is an admin - else { - - my $isService = (getStartupType() == SC_STARTUP_TYPE_SERVICE); - return ($isService && Win32::IsAdminUser()) || !$isService; - } -} - -sub getStartupOptions { - my $class = shift; - - if (!$os->get('isVista') && !Win32::IsAdminUser()) { - return ('CONTROLPANEL_NEED_ADMINISTRATOR', 'RUN_NEVER', 'RUN_AT_LOGIN'); - } - - return $class->SUPER::getStartupOptions(); -} - -sub setStartupType { - my ($class, $type, $username, $password) = @_; - $username = '' unless defined $username; - - $Registry->{USER_REGISTRY_KEY . '/StartAtLogin'} = ($type == SC_STARTUP_TYPE_LOGIN || 0); - - # enable service mode - if ($type == SC_STARTUP_TYPE_SERVICE) { - my @args; - - push @args, "--username=$username" if $username; - push @args, "--password=$password" if $password; - push @args, '--install'; - - system($svcHelper, @args); - } - else { - system($svcHelper, "--remove"); - } - - return 1; -} - -sub initStartupType { - my $class = shift; - - # preset atLogin if it isn't defined yet - my $atLogin = $Registry->{USER_REGISTRY_KEY . '/StartAtLogin'}; - - if ($atLogin !~ /[01]/) { - - # make sure our Key does exist before we can write to it - if (! (my $regKey = $Registry->{USER_REGISTRY_KEY . ''})) { - $Registry->{'CUser/Software/Lyrion/'} = { - 'server/' => {} - }; - } - - # migrate startup setting - if (defined $Registry->{LEGACY_USER_REGISTRY_KEY . '/StartAtLogin'}) { - $Registry->{USER_REGISTRY_KEY . '/StartAtLogin'} = $Registry->{LEGACY_USER_REGISTRY_KEY . '/StartAtLogin'}; - delete $Registry->{LEGACY_USER_REGISTRY_KEY . '/StartAtLogin'}; - } - - $class->setStartupType(SC_STARTUP_TYPE_LOGIN); - } -} - -sub canStart { - canSetStartupType(); -} - -sub start { - my ($class, $params) = @_; - - if (!$params && $class->getStartupType() == SC_STARTUP_TYPE_SERVICE) { - - `$svcHelper --start`; - } - - else { - - my $appExe = Win32::GetShortPathName( catdir( scalar $os->dirsFor('base'), 'server', 'SqueezeSvr.exe' ) ); - - if ($params) { - $params = "$appExe $params"; - } - else { - $params = ''; - } - - # start as background job - my $processObj; - Win32::Process::Create( - $processObj, - $appExe, - $params, - 0, - DETACHED_PROCESS | CREATE_NO_WINDOW | NORMAL_PRIORITY_CLASS, - '.' - ) if $appExe; - - } - - $class->{checkHTTP} = 1; -} - - -sub checkServiceState { - my $class = shift; - - if ($class->getStartupType() == SC_STARTUP_TYPE_SERVICE) { - - my %status = (); - - Win32::Service::GetStatus('', SC_SERVICE_NAME, \%status); - - if ($status{'CurrentState'} == 0x04) { - - $class->{status} = SC_STATE_RUNNING; - } - - elsif ($status{'CurrentState'} == 0x02) { - - $class->{status} = SC_STATE_STARTING; - } - - elsif ($status{'CurrentState'} == 0x01) { - - $class->{status} = SC_STATE_STOPPED; - - # it could happen SC has been started as an app, even though - # it's configured to be running as a service - if (getProcessID() != -1) { - - $class->{status} = SC_STATE_RUNNING; - } - } - - elsif ($status{'CurrentState'} == 0x03) { - - $class->{status} = SC_STATE_STOPPING; - } - - } else { - - if (getProcessID() != -1) { - - $class->{status} = SC_STATE_RUNNING; - } - - else { - - $class->{status} = SC_STATE_STOPPED; - } - - } - - if ($class->{status} == SC_STATE_RUNNING) { - - if ($class->{checkHTTP} && !$class->checkForHTTP()) { - - $class->{status} = SC_STATE_STARTING; - } - - else { - - $class->{checkHTTP} = 0; - } - } - - return $class->{status}; -} - -sub getProcessID { - - my $p = Win32::Process::List->new; - - if ($p->IsError == 1) { - - return $p->GetErrorText; - } - - # Windows sometimes only displays squeez~1.exe or similar - my $pid = ($p->GetProcessPid(qr/^squeez(esvr|~\d).exe$/i))[1]; - - return $pid || -1; -} - -1; diff --git a/Slim/Utils/Update.pm b/Slim/Utils/Update.pm index 7516908adc1..7a8f78f3fee 100644 --- a/Slim/Utils/Update.pm +++ b/Slim/Utils/Update.pm @@ -1,7 +1,9 @@ package Slim::Utils::Update; use strict; +use File::Slurp qw(write_file); use Time::HiRes; +use Digest::MD5; use File::Spec::Functions qw(splitpath catdir); use JSON::XS::VersionOneAndTwo; @@ -90,7 +92,7 @@ sub checkVersionCB { my $http = shift; my $cb = $http->params('cb'); - my $version; + my ($version, $md5); # store result in global variable, to be displayed by browser if ($http->code =~ /^2\d\d/) { @@ -109,6 +111,7 @@ sub checkVersionCB { if ( Slim::Utils::Versions->compareVersions($update->{version}, $::VERSION) > 0 || $update->{revision} > $::REVISION ) { if ( $osID ne 'default' && $prefs->get('autoDownloadUpdate') ) { $version = $update->{url}; + $md5 = $update->{md5}; } else { $version = Slim::Utils::Strings::string('SERVER_UPDATE_AVAILABLE', $update->{version}, $update->{url}); @@ -128,11 +131,12 @@ sub checkVersionCB { if ($version && $prefs->get('autoDownloadUpdate')) { main::INFOLOG && $log->info('Triggering automatic Lyrion Music Server update download...'); - getUpdate($version); + getUpdate($version, $md5); } # if we got an update with download URL, display it in the web UI et al. - elsif ($version && $version =~ /a href=.*\bdownloads\./i) { + elsif ($version && $version =~ /a href="(http.*\bdownloads\.[^"]+)/i) { + $prefs->set('serverUpdateAvailable', $1); $::newVersion = $version; } } @@ -159,7 +163,7 @@ sub checkVersionError { # download the installer sub getUpdate { - my $url = shift; + my ($url, $md5) = @_; my $params = $os->getUpdateParams($url); @@ -208,6 +212,7 @@ sub getUpdate { saveAs => $tmpFile, file => $file, params => $params, + md5 => $md5, }, ); @@ -224,26 +229,64 @@ sub downloadAsyncDone { my $file = $http->params('file'); my $tmpFile = $http->params('saveAs'); my $params = $http->params('params') || {}; + my $md5 = $http->params('md5'); my $path = $params->{'path'}; # make sure we got the file if (!-e $tmpFile) { - $log->warn("Lyrion Music Server installer download failed: file '$tmpFile' not stored on disk?!?"); + $log->warn("Installer download failed: file '$tmpFile' not stored on disk?!?"); return; } if (-s _ != $http->headers->content_length()) { - $log->warn( sprintf("Lyrion Music Server installer file size mismatch: expected size %s bytes, actual size %s bytes", $http->headers->content_length(), -s _) ); + $log->warn( sprintf("Installer file size mismatch: expected size %s bytes, actual size %s bytes", $http->headers->content_length(), -s _) ); unlink $tmpFile; return; } + if ($md5) { + my $digest; + eval { + # "With OO style, you can break the message arbitrarily. This means that we are no longer limited + # to have space for the whole message in memory, i.e. we can handle messages of any size." + # https://metacpan.org/pod/Digest::MD5#EXAMPLES + my $md5 = Digest::MD5->new; + open my $fh, '<:raw', $tmpFile; + while (<$fh>) { + $md5->add($_); + } + close $fh; + $digest = $md5->hexdigest; + }; + + if ($@) { + $log->error("Error calculating MD5 checksum: $@"); + } + elsif (main::DEBUGLOG && $log->is_debug) { + $log->debug("Verified expected MD5 checksum: $digest"); + } + + if ($digest ne $md5) { + $log->warn("Installer file checksum mismatch: expected $md5, got $digest"); + unlink $tmpFile; + return; + } + } + cleanup($path); - main::INFOLOG && $log->is_info && $log->info("Successfully downloaded update installer file '$tmpFile'. Saving as $file"); + if (main::INFOLOG && $log->is_info) { + $log->info("Successfully downloaded update installer file '$tmpFile'."); + $log->info("Saving as $file"); + } + unlink $file; my $success = rename $tmpFile, $file; + if ($md5) { + my ($a, $b, $filename) = splitpath($file); + write_file($file . '.md5.txt', "$md5 $filename"); + } if (-e $file) { setUpdateInstaller($file, $params->{cb}) ; @@ -314,7 +357,7 @@ sub getUpdateInstaller { chomp; - if (/LyrionMusicServer.*/) { + if (/LyrionMusicServer.*/i) { $updateInstaller = $_; last; } diff --git a/Slim/Web/Graphics.pm b/Slim/Web/Graphics.pm index bf3498f0121..f8a60170406 100644 --- a/Slim/Web/Graphics.pm +++ b/Slim/Web/Graphics.pm @@ -1,5 +1,11 @@ package Slim::Web::Graphics; +# Logitech Media Server Copyright 2001-2024 Logitech. +# Lyrion Music Server Copyright 2025 Lyrion Community. +# This program is free software; you can redistribute it and/or +# modify it under the terms of the GNU General Public License, +# version 2. + use strict; use Scalar::Util qw(blessed); @@ -56,9 +62,9 @@ sub _cached { } elsif ( my $orig = $cached->{original_path} ) { # Check mtime of original artwork has not changed, - # unless it's a /music path, where we don't care if + # unless it's a /music or /contributor path, where we don't care if # it has changed. The scanner should deal with changes there. - if ( $path !~ m{^music/} && -r $orig ) { + if ( $path !~ m{^music/|^contributor/} && -r $orig ) { my $mtime = (stat _)[9]; if ( $cached->{mtime} != $mtime ) { main::INFOLOG && $isInfo && $log->info( " current mtime $mtime != cached mtime " . $cached->{mtime} ); @@ -106,7 +112,7 @@ sub artworkRequest { $response->content_type($ct); # Cache music URLs for 1 year, others for 1 day - my $exptime = $path =~ /^music/ ? ONE_YEAR : ONE_DAY; + my $exptime = $path =~ /^music|^contributor/ ? ONE_YEAR : ONE_DAY; $response->header( 'Cache-Control' => 'max-age=' . $exptime ); $response->expires( time() + $exptime ); @@ -124,7 +130,7 @@ sub artworkRequest { # 'X' can be used instead of either W or H to determine automatically my ($spec) = File::Basename::basename($path) =~ /_?((?:[0-9X]+x[0-9X]+)?(?:_\w)?(?:_[\da-fA-F]+)?(?:\.\w+)?)$/; - main::DEBUGLOG && $isInfo && $log->info(" Resize specification: $spec"); + main::INFOLOG && $isInfo && $log->info(" Resize specification: $spec"); # /music/all_items (used in BrowseDB, just returns html/images/albums.png) if ( $path =~ m{^music/all_items} ) { @@ -310,6 +316,35 @@ sub artworkRequest { } } + elsif ( $path =~ m{^contributor/([^/]+)/} ) { + my $id = $1; + + main::INFOLOG && $log->is_info && $log->info(" Looking for contributor portrait for $id"); + + my $url; + if ($id) { + my $sth = Slim::Schema->dbh->prepare_cached( qq{ + SELECT portrait FROM contributors WHERE portraitid = ? LIMIT 1 + } ); + + $sth->execute($id); + ($url) = $sth->fetchrow_array; + $sth->finish; + } + + if ($url) { + $fullpath = Slim::Utils::Misc::pathFromFileURL($url); + $fullpath = Slim::Utils::Unicode::utf8on($fullpath) if $fullpath; + } + else { + my $path = 'html/images/artists.png'; + my $skin = $params->{skinOverride} || $prefs->get('skin'); + $fullpath = $skinMgr->fixHttpPath($skin, $path); + } + + main::INFOLOG && $log->is_info && $log->info(" Found contributor portrait at $fullpath"); + } + # If path begins with "plugins/cache" it is a special path # meaning we need to lookup the actual path in our cache directory elsif ( $path =~ m{^plugins/cache} ) { diff --git a/Slim/Web/HTTP.pm b/Slim/Web/HTTP.pm index a9e2dfe1d25..cf88075de82 100644 --- a/Slim/Web/HTTP.pm +++ b/Slim/Web/HTTP.pm @@ -2,7 +2,7 @@ package Slim::Web::HTTP; # Logitech Media Server Copyright 2001-2024 Logitech. -# Lyrion Music Server Copyright 2024 Lyrion Community. +# Lyrion Music Server Copyright 2025 Lyrion Community. # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License, # version 2. @@ -649,7 +649,7 @@ sub processHTTP { $path =~ s|^/+||; - if ( !main::WEBUI || $path =~ m{^(?:html|music|plugins|apps|settings|firmware|clixmlbrowser|index\.html|imageproxy)/}i || Slim::Web::Pages->isRawDownload($path) ) { + if ( !main::WEBUI || $path =~ m{^(?:html|music|contributor|plugins|apps|settings|firmware|clixmlbrowser|index\.html|imageproxy)/}i || Slim::Web::Pages->isRawDownload($path) ) { # not a skin } elsif ($path =~ m|^([a-zA-Z0-9]+)$| && $skinMgr->isaSkin($1)) { @@ -1004,7 +1004,7 @@ sub generateHTTPResponse { $contentType = 'application/octet-stream'; } - if ( $path =~ /music\/[0-9a-f]+\/(?:download|cover)/ || $path =~ /^imageproxy\// ) { + if ( $path =~ /music\/[0-9a-f]+\/(?:download|cover)/ || /contributor\/[0-9a-f]+\/image/ || $path =~ /^imageproxy\// ) { # Avoid generating templates for download URLs $contentType = 'application/octet-stream'; } @@ -1202,6 +1202,7 @@ sub generateHTTPResponse { return 0; } elsif ($path =~ m{music/([^/]+)/(cover|thumb)} || + $path =~ m{contributor/([^/]+)/image} || $path =~ m{^(?:plugins/cache/icons|imageproxy)} || $path =~ $IMAGE_RESIZE_REGEX ) { @@ -2539,7 +2540,7 @@ sub closeStreamingSocket { sub shouldHandleCookies { my ($path) = @_; return unless $path; - return $path && $path !~ m/(?:gif|png|jpe?g|css)$/i && $path !~ m{^/(?:music/[a-f\d]+/cover|imageproxy/.*/image)}; + return $path && $path !~ m/(?:gif|png|jpe?g|css)$/i && $path !~ m{^/(?:music/[a-f\d]+/cover|contributor/[a-f\d]+/image|imageproxy/.*/image)}; } sub checkAuthorization { diff --git a/Slim/Web/JSONRPC.pm b/Slim/Web/JSONRPC.pm index 39633f61ac2..ee339cea5f6 100644 --- a/Slim/Web/JSONRPC.pm +++ b/Slim/Web/JSONRPC.pm @@ -15,6 +15,8 @@ use strict; use HTTP::Status qw(RC_OK RC_FORBIDDEN); use JSON::XS::VersionOneAndTwo; use Scalar::Util qw(blessed); +use URI; +use URI::QueryParam; use Slim::Web::HTTP; use Slim::Utils::Compress; @@ -128,6 +130,12 @@ sub handleURI { # get the request data (POST for JSON 1.0) my $input = $httpResponse->request()->content(); + if (!$input && $httpResponse->request()->method() eq 'GET') { + main::INFOLOG && $log->is_info && $log->info("This is GET request - get data from query string"); + my $uri = new URI($httpResponse->request()->uri()); + $input = $uri->query_param('request'); + } + if (!$input) { # No data diff --git a/Slim/Web/Settings/Player/Basic.pm b/Slim/Web/Settings/Player/Basic.pm index aa36b8e62c2..8eaf49f68a9 100644 --- a/Slim/Web/Settings/Player/Basic.pm +++ b/Slim/Web/Settings/Player/Basic.pm @@ -234,6 +234,16 @@ sub getPlayerIcon { my $model = $client->model(1); + # Squeezelite players can use images based on model name: + # remove all but a-z, 0-9, - and _ from the lowercase name to match a PNG image. + if ($model eq 'squeezelite') { + $model = lc($client->modelName()); + $model =~ s/[^-_a-z0-1]//g; + return $model if Slim::Web::HTTP::fixHttpPath($paramRef->{'skinOverride'} || $prefs->get('skin'), "html/images/Players/$model.png"); + + $model = $client->model(1); + } + # default icon for software emulators and media players $model = 'squeezebox' if $model eq 'squeezebox2'; diff --git a/Slim/Web/Settings/Server/TextFormatting.pm b/Slim/Web/Settings/Server/TextFormatting.pm index ebb0c70b618..7fd24ec8fe4 100644 --- a/Slim/Web/Settings/Server/TextFormatting.pm +++ b/Slim/Web/Settings/Server/TextFormatting.pm @@ -2,7 +2,7 @@ package Slim::Web::Settings::Server::TextFormatting; # Logitech Media Server Copyright 2001-2024 Logitech. -# Lyrion Music Server Copyright 2024 Lyrion Community. +# Lyrion Music Server Copyright 2025 Lyrion Community. # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License, # version 2. @@ -23,7 +23,7 @@ sub page { } sub prefs { - return ($prefs, qw(coverArt artfolder)); + return ($prefs, qw(coverArt artfolder noContributorPictures)); } sub handler { diff --git a/Slim/Web/Template/SkinManager.pm b/Slim/Web/Template/SkinManager.pm index f298fa34769..b83f13ad2e6 100644 --- a/Slim/Web/Template/SkinManager.pm +++ b/Slim/Web/Template/SkinManager.pm @@ -2,7 +2,7 @@ package Slim::Web::Template::SkinManager; # Logitech Media Server Copyright 2001-2024 Logitech. -# Lyrion Music Server Copyright 2024 Lyrion Community. +# Lyrion Music Server Copyright 2025 Lyrion Community. # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License, # version 2. @@ -263,9 +263,9 @@ sub _parseURIs { return $text unless $text; - if (!($text =~ s!\b(https?://[A-Za-z0-9\-_\.\!~*'();/?:@%&=+$,]+)!$1!igo)) { + if (!($text =~ s!\b(https?://[-A-Z\d_.~*'();/?:@%&=+,#\$\!]+)!$1!igo)) { # handle emusic-type urls which don't have http:// - $text =~ s!\b(www\.[A-Za-z0-9\-_\.\!~*'();/?:@%&=+$,]+)!$1!igo; + $text =~ s!\b(www\.[-A-Z\d_.~*'();/?:@%&=+,#\$\!]+)!$1!igo; } return $text; @@ -309,7 +309,7 @@ sub _resizeImage { # music artwork my $webroot = $context->{STASH}->{webroot}; - if ( $url =~ m{^((?:$webroot|/)music/.*/cover)(?:\.jpg)?$} || $url =~ m{(.*imageproxy/.*/image)(?:\.(jpe?g|png|gif))} ) { + if ( $url =~ m{^((?:$webroot|/)music/.*/cover)(?:\.jpg)?$} || $url =~ m{^((?:$webroot|/)contributor/.*/image)(?:\.jpg)?$} || $url =~ m{(.*imageproxy/.*/image)(?:\.(jpe?g|png|gif))} ) { return $1 . $resizeParams . (($mode && $mode ne '-') ? "_$mode" : '_o'); } diff --git a/Slim/Web/XMLBrowser.pm b/Slim/Web/XMLBrowser.pm index 4b73298c77a..c01dbb35fff 100644 --- a/Slim/Web/XMLBrowser.pm +++ b/Slim/Web/XMLBrowser.pm @@ -2,7 +2,7 @@ package Slim::Web::XMLBrowser; # Logitech Media Server Copyright 2001-2024 Logitech. -# Lyrion Music Server Copyright 2024 Lyrion Community. +# Lyrion Music Server Copyright 2025 Lyrion Community. # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License, # version 2. @@ -43,7 +43,7 @@ if ( !main::SCANNER ) { $prefs->setChange( \&wipeCaches, qw(itemsPerPage thumbSize showArtist showYear additionalPlaylistButtons noGenreFilter noRoleFilter searchSubString browseagelimit composerInArtists conductorInArtists bandInArtists trackartistInArtists variousArtistAutoIdentification titleFormat titleFormatWeb language useUnifiedArtistsList groupArtistAlbumsByReleaseType ignoreReleaseTypes releaseTypesToIgnore showComposerReleasesbyAlbum myClassicalGenres onlyAlbumYears userDefinedRoles - artistAlbumLink albumartistAlbumLink trackartistAlbumLink composerAlbumLink conductorAlbumLink bandAlbumLink) ); + artistAlbumLink albumartistAlbumLink trackartistAlbumLink composerAlbumLink conductorAlbumLink bandAlbumLink noContributorPictures) ); } tie my %cacheables, 'Tie::RegexpHash'; diff --git a/Slim/bootstrap.pm b/Slim/bootstrap.pm index 5df28337cd0..82b9348f6c3 100644 --- a/Slim/bootstrap.pm +++ b/Slim/bootstrap.pm @@ -87,10 +87,6 @@ sub loadModules { #system("/usr/bin/chcon -R -t texrel_shlib_t $archDir"); } - if ($] <= 5.007) { - push @$required_modules, qw(Storable Digest::MD5); - } - my @SlimINC = (); Slim::Utils::OSDetect::init(); @@ -193,11 +189,7 @@ sub loadModules { print "The following modules failed to load: $failed\n\n"; - if ( main::ISACTIVEPERL ) { - print "To run from source on Windows 32-bit, please install ActivePerl 5.14.\n"; - print "http://downloads.activestate.com/ActivePerl/releases/\n\n"; - } - elsif ( main::ISWINDOWS ) { + if ( main::ISWINDOWS ) { print "To run from source on Windows 64-bit, please install dependencies using Strawberry Perl 5.32.\n"; print "https://strawberryperl.com/releases.html\n\n"; } diff --git a/cleanup.pl b/cleanup.pl index a31a408e599..bc62bfc952c 100755 --- a/cleanup.pl +++ b/cleanup.pl @@ -15,25 +15,9 @@ require 5.010; use Config; -use constant SPLASH_LOGO => 'lms_splash.png'; use constant ISWINDOWS => ( $^O =~ /^m?s?win/i ) ? 1 : 0; use constant ISMAC => ( $^O =~ /darwin/i ) ? 1 : 0; -use constant ISACTIVEPERL => ( $Config{cf_email} =~ /ActiveState/i ) ? 1 : 0; - -# don't use Wx, if script is run using perl on OSX, it needs to be run using wxperl -my $splash; -my $useWx = (!ISMAC || $^X =~ /wxPerl/i) && eval { - require Wx; - - showSplashScreen(); - - require Wx::Event; - require Slim::GUI::ControlPanel; - - return 1; -}; - -print "$@\n" if $@ && ISWINDOWS; +use constant ISACTIVEPERL => 0; use strict; use Socket; @@ -61,14 +45,7 @@ require Slim::Utils::OSDetect; require Slim::Utils::Light; -our $VERSION = '9.0.3'; - -BEGIN { - if (ISWINDOWS) { - eval { require Wx::Perl::Packager; } - } -} - +our $VERSION = '9.1.0'; if (DEBUG && $@) { print "GUI can't be loaded: $@\n"; @@ -80,7 +57,7 @@ sub main { Slim::Utils::OSDetect::init(); $os = Slim::Utils::OSDetect->getOS(); - if (checkForSC() && !$useWx) { + if (checkForSC()) { print sprintf("\n%s\n\n", Slim::Utils::Light::string('CLEANUP_PLEASE_STOP_SC')); exit; } @@ -107,26 +84,8 @@ sub main { }); unless (scalar @$folders) { - - # show simple GUI if possible - if ($useWx) { - - my $app = Slim::GUI::ControlPanel->new({ - folderCB => \&getFolderList, - cleanCB => \&cleanup, - options => options(), - }); - - $splash->Destroy(); - - $app->MainLoop; - exit; - } - - else { - usage(); - exit; - } + usage(); + exit; } cleanup($folders, $dryrun); @@ -332,12 +291,12 @@ sub cleanup { my ($folders, $dryrun) = @_; for my $item (@$folders) { - print sprintf("\n%s %s...\n", Slim::Utils::Light::string('CLEANUP_DELETING'), $item->{label}) unless $useWx; + print sprintf("\n%s %s...\n", Slim::Utils::Light::string('CLEANUP_DELETING'), $item->{label}); foreach ( @{$item->{folders}} ) { next unless $_; - print "-> $_\n" if (-e $_ && !$useWx); + print "-> $_\n" if -e $_; next if $dryrun; @@ -352,39 +311,6 @@ sub cleanup { } } -sub showSplashScreen { - return unless $^O =~ /win/i; - - my $file; - - if (defined $PerlApp::VERSION) { - $file = PerlApp::extract_bound_file(SPLASH_LOGO); - } - - else { - $file = SPLASH_LOGO; - } - - if (!$file || !-f $file) { - $file = '../platforms/win32/res/' . SPLASH_LOGO; - } - - Wx::Image::AddHandler(Wx::PNGHandler->new()); - - if (my $bitmap = Wx::Bitmap->new($file, Wx::wxBITMAP_TYPE_PNG())) { - - $splash = Wx::SplashScreen->new( - $bitmap, - Wx::wxSPLASH_CENTRE_ON_SCREEN() | Wx::wxSPLASH_NO_TIMEOUT(), - 0, - undef, - -1, [-1, -1], [-1, -1], - Wx::wxSIMPLE_BORDER() | Wx::wxSTAY_ON_TOP() - ); - - } -} - main(); __END__ diff --git a/gdresize.pl b/gdresize.pl deleted file mode 100755 index df2dc13d79e..00000000000 --- a/gdresize.pl +++ /dev/null @@ -1,134 +0,0 @@ -#!/usr/bin/perl -# -# Stand-alone interface to GDResizer -# -# TODO: -# Better error handling -# - -use strict; -use FindBin qw($Bin); -use lib $Bin; - -use constant RESIZER => 1; -use constant SLIM_SERVICE => 0; -use constant PERFMON => 0; -use constant SCANNER => 0; -use constant WEBUI => 0; -use constant ISWINDOWS => ( $^O =~ /^m?s?win/i ) ? 1 : 0; -use constant DEBUG => ( grep { /--debug/ } @ARGV ) ? 1 : 0; -use constant LOCALFILE => 0; -use constant NOMYSB => 1; - -BEGIN { - use Slim::bootstrap (); - Slim::bootstrap->loadModules( ['Image::Scale'], [] ); -}; - -use Getopt::Long; - -use Slim::Utils::GDResizer; - -my $help; -our ($file, $url, @spec, $cacheroot, $cachekey, $faster, $debug); - -my $ok = GetOptions( - 'help|?' => \$help, - 'file=s' => \$file, - 'url=s' => \$url, - 'spec=s' => \@spec, - 'cacheroot=s' => \$cacheroot, - 'cachekey=s' => \$cachekey, - 'faster' => \$faster, - 'debug' => \$debug, -); - -if ( !$ok || $help || ( !$file && !$url ) || !@spec ) { - require Pod::Usage; - Pod::Usage::pod2usage(1); -} - -# Download URL to a temp file -my $fh; -if ( $url ) { - require File::Temp; - require LWP::UserAgent; - - $fh = File::Temp->new(); - $file = $fh->filename; - - my $ua = LWP::UserAgent->new( timeout => 5 ); - - $debug && warn "Downloading URL to $file\n"; - - my $res = $ua->get( $url, ':content_file' => $file ); - - if ( !$res->is_success ) { - die "Unable to download $url: " . $res->status_line . "\n"; - } -} - -# Setup cache -my $cache; -if ( $cacheroot && $cachekey ) { - require Cache::FileCache; - - $cache = Cache::FileCache->new( { - namespace => 'Artwork', - cache_root => $cacheroot, - directory_umask => umask(), - } ); -} - -eval { - Slim::Utils::GDResizer->gdresize( - file => $file, - debug => $debug, - faster => $faster, - cache => $cache, - cachekey => $cachekey, - spec => \@spec, - ); -}; - -if ( $@ ) { - die "$@\n"; -} - -exit 0; - - -__END__ - -=head1 NAME - -gdresize.pl - Standalone artwork resizer - -=head1 SYNOPSIS - -Resize normal image file or an audio file's embedded tags: - -Options: - - --file [ /path/to/image.jpg | /path/to/image.mp3 ] - Supported file types: - Images: jpg, jpeg, gif, png, bmp - Audio: see Audio::Scan documentation - - --url http://... - - --spec x_[.ext] ... - Mode is one of: - m: max (default) - p: pad (same as max) - o: original - - Multiple spec arguments may be specified to resize in series. - - --cacheroot [dir] Cache resulting image in a FileCache called - 'Artwork' located in dir - --cachekey [key] Use this key for the cached data. - Note: spec value will be appended to the cachekey - if multiple spec values were supplied. - -=cut diff --git a/lib/Protocol/WebSocket/Frame.pm b/lib/Protocol/WebSocket/Frame.pm new file mode 100644 index 00000000000..a1694cbd9db --- /dev/null +++ b/lib/Protocol/WebSocket/Frame.pm @@ -0,0 +1,486 @@ +# This is Copyright (C) 2010-2018, Viacheslav Tykhanovskyi. +# This forms part of Protocol::Websockets v 0.26 +# +# This file has by modified by the Lyrion Community (2024) +# It has been modified so that a ping message is not converted to UTF-8. +# This enables a client to correctly format a corresponding 'pong' in raw bytes to keep a server connection alive. +# +# This program is free software, you can redistribute it and/or modify it under +# the same terms as Perl 5.10. + + +package Protocol::WebSocket::Frame; + +use strict; +use warnings; + +use Config; +use Encode (); +use Scalar::Util 'readonly'; + +use constant MAX_RAND_INT => 2**32; +use constant MATH_RANDOM_SECURE => eval "require Math::Random::Secure;"; + +our $MAX_PAYLOAD_SIZE = 65536; +our $MAX_FRAGMENTS_AMOUNT = 128; + +our %TYPES = ( + continuation => 0x00, + text => 0x01, + binary => 0x02, + ping => 0x09, + pong => 0x0a, + close => 0x08 +); + +sub new { + my $class = shift; + $class = ref $class if ref $class; + my $buffer; + + if (@_ == 1) { + $buffer = shift @_; + } + else { + my %args = @_; + $buffer = delete $args{buffer}; + } + + my $self = {@_}; + bless $self, $class; + + $buffer = '' unless defined $buffer; + + if (Encode::is_utf8($buffer)) { + $self->{buffer} = Encode::encode('UTF-8', $buffer); + } + else { + $self->{buffer} = $buffer; + } + + if (defined($self->{type}) && defined($TYPES{$self->{type}})) { + $self->opcode($TYPES{$self->{type}}); + } + + $self->{version} ||= 'draft-ietf-hybi-17'; + + $self->{fragments} = []; + + $self->{max_fragments_amount} ||= $MAX_FRAGMENTS_AMOUNT unless exists $self->{max_fragments_amount}; + $self->{max_payload_size} ||= $MAX_PAYLOAD_SIZE unless exists $self->{max_payload_size}; + + return $self; +} + +sub version { + my $self = shift; + + return $self->{version}; +} + +sub append { + my $self = shift; + + return unless defined $_[0]; + + $self->{buffer} .= $_[0]; + $_[0] = '' unless readonly $_[0]; + + return $self; +} + +sub next { + my $self = shift; + + my $bytes = $self->next_bytes; + + return unless defined $bytes; + return Encode::decode('UTF-8', $bytes) unless $self->is_ping(); + return $bytes; +} + +sub fin { + @_ > 1 ? $_[0]->{fin} = + $_[1] + : defined($_[0]->{fin}) ? $_[0]->{fin} + : 1; +} +sub rsv { @_ > 1 ? $_[0]->{rsv} = $_[1] : $_[0]->{rsv} } + +sub opcode { + @_ > 1 ? $_[0]->{opcode} = + $_[1] + : defined($_[0]->{opcode}) ? $_[0]->{opcode} + : 1; +} +sub masked { @_ > 1 ? $_[0]->{masked} = $_[1] : $_[0]->{masked} } + +sub is_ping { $_[0]->opcode == 9 } +sub is_pong { $_[0]->opcode == 10 } +sub is_close { $_[0]->opcode == 8 } +sub is_continuation { $_[0]->opcode == 0 } +sub is_text { $_[0]->opcode == 1 } +sub is_binary { $_[0]->opcode == 2 } + +sub next_bytes { + my $self = shift; + + if ( $self->version eq 'draft-hixie-75' + || $self->version eq 'draft-ietf-hybi-00') + { + if ($self->{buffer} =~ s/^\xff\x00//) { + $self->opcode(8); + return ''; + } + + return unless $self->{buffer} =~ s/^[^\x00]*\x00(.*?)\xff//s; + + return $1; + } + + return unless length $self->{buffer} >= 2; + + while (length $self->{buffer}) { + my $hdr = substr($self->{buffer}, 0, 1); + + my @bits = split //, unpack("B*", $hdr); + + $self->fin($bits[0]); + $self->rsv([@bits[1 .. 3]]); + + my $opcode = unpack('C', $hdr) & 0b00001111; + + my $offset = 1; # FIN,RSV[1-3],OPCODE + + my $payload_len = unpack 'C', substr($self->{buffer}, 1, 1); + + my $masked = ($payload_len & 0b10000000) >> 7; + $self->masked($masked); + + $offset += 1; # + MASKED,PAYLOAD_LEN + + $payload_len = $payload_len & 0b01111111; + if ($payload_len == 126) { + return unless length($self->{buffer}) >= $offset + 2; + + $payload_len = unpack 'n', substr($self->{buffer}, $offset, 2); + + $offset += 2; + } + elsif ($payload_len > 126) { + return unless length($self->{buffer}) >= $offset + 4; + + my $bits = join '', map { unpack 'B*', $_ } split //, + substr($self->{buffer}, $offset, 8); + + # Most significant bit must be 0. + # And here is a crazy way of doing it %) + $bits =~ s{^.}{0}; + + # Can we handle 64bit numbers? + if ($Config{ivsize} <= 4 || $Config{longsize} < 8 || $] < 5.010) { + $bits = substr($bits, 32); + $payload_len = unpack 'N', pack 'B*', $bits; + } + else { + $payload_len = unpack 'Q>', pack 'B*', $bits; + } + + $offset += 8; + } + + if ($self->{max_payload_size} && $payload_len > $self->{max_payload_size}) { + $self->{buffer} = ''; + die "Payload is too big. " + . "Deny big message ($payload_len) " + . "or increase max_payload_size ($self->{max_payload_size})"; + } + + my $mask; + if ($self->masked) { + return unless length($self->{buffer}) >= $offset + 4; + + $mask = substr($self->{buffer}, $offset, 4); + $offset += 4; + } + + return if length($self->{buffer}) < $offset + $payload_len; + + my $payload = substr($self->{buffer}, $offset, $payload_len); + + if ($self->masked) { + $payload = $self->_mask($payload, $mask); + } + + substr($self->{buffer}, 0, $offset + $payload_len, ''); + + # Injected control frame + if (@{$self->{fragments}} && $opcode & 0b1000) { + $self->opcode($opcode); + return $payload; + } + + if ($self->fin) { + if (@{$self->{fragments}}) { + $self->opcode(shift @{$self->{fragments}}); + } + else { + $self->opcode($opcode); + } + $payload = join '', @{$self->{fragments}}, $payload; + $self->{fragments} = []; + return $payload; + } + else { + + # Remember first fragment opcode + if (!@{$self->{fragments}}) { + push @{$self->{fragments}}, $opcode; + } + + push @{$self->{fragments}}, $payload; + + die "Too many fragments" + if @{$self->{fragments}} > $self->{max_fragments_amount}; + } + } + + return; +} + +sub to_bytes { + my $self = shift; + + if ( $self->version eq 'draft-hixie-75' + || $self->version eq 'draft-ietf-hybi-00') + { + if ($self->{type} && $self->{type} eq 'close') { + return "\xff\x00"; + } + + return "\x00" . $self->{buffer} . "\xff"; + } + + if ($self->{max_payload_size} && length $self->{buffer} > $self->{max_payload_size}) { + die "Payload is too big. " + . "Send shorter messages or increase max_payload_size"; + } + + + my $rsv_set = 0; + if ( $self->{rsv} && ref( $self->{rsv} ) eq 'ARRAY' ) { + for my $i ( 0 .. @{ $self->{rsv} } - 1 ) { + $rsv_set += $self->{rsv}->[$i] * ( 1 << ( 6 - $i ) ); + } + } + + my $string = ''; + my $opcode = $self->opcode; + $string .= pack 'C', ($opcode | $rsv_set | ($self->fin ? 128 : 0)); + + my $payload_len = length($self->{buffer}); + if ($payload_len <= 125) { + $payload_len |= 0b10000000 if $self->masked; + $string .= pack 'C', $payload_len; + } + elsif ($payload_len <= 0xffff) { + $string .= pack 'C', 126 + ($self->masked ? 128 : 0); + $string .= pack 'n', $payload_len; + } + else { + $string .= pack 'C', 127 + ($self->masked ? 128 : 0); + + # Shifting by an amount >= to the system wordsize is undefined + $string .= pack 'N', $Config{ivsize} <= 4 ? 0 : $payload_len >> 32; + $string .= pack 'N', ($payload_len & 0xffffffff); + } + + if ($self->masked) { + + my $mask = $self->{mask} + || ( + MATH_RANDOM_SECURE + ? Math::Random::Secure::irand(MAX_RAND_INT) + : int(rand(MAX_RAND_INT)) + ); + + $mask = pack 'N', $mask; + + $string .= $mask; + $string .= $self->_mask($self->{buffer}, $mask); + } + else { + $string .= $self->{buffer}; + } + + return $string; +} + +sub to_string { + my $self = shift; + + die 'DO NOT USE'; +} + +sub _mask { + my $self = shift; + my ($payload, $mask) = @_; + + $mask = $mask x (int(length($payload) / 4) + 1); + $mask = substr($mask, 0, length($payload)); + $payload = "$payload" ^ $mask; + + return $payload; +} + +sub max_payload_size { + my $self = shift; + + return $self->{max_payload_size}; +} + +1; +__END__ + +=head1 NAME + +Protocol::WebSocket::Frame - WebSocket Frame + +=head1 SYNOPSIS + + # Create frame + my $frame = Protocol::WebSocket::Frame->new('123'); + $frame->to_bytes; + + # Parse frames + my $frame = Protocol::WebSocket::Frame->new; + $frame->append(...); + $f->next; # get next message + $f->next; # get another next message + +=head1 DESCRIPTION + +Construct or parse a WebSocket frame. + +=head1 RANDOM MASK GENERATION + +By default built-in C is used, this is not secure, so when +L is installed it is used instead. + +=head1 METHODS + +=head2 C + + Protocol::WebSocket::Frame->new('data'); # same as (buffer => 'data') + Protocol::WebSocket::Frame->new(buffer => 'data', type => 'close'); + +Create a new L instance. Automatically detect if the +passed data is a Perl string (UTF-8 flag) or bytes. + +When called with more than one arguments, it takes the following named arguments +(all of them are optional). + +=over + +=item C => STR (default: C<"">) + +The payload of the frame. + +=item C => TYPE_STR (default: C<"text">) + +The type of the frame. Accepted values are: + + continuation + text + binary + ping + pong + close + +=item C => INT (default: 1) + +The opcode of the frame. If C field is set to a valid string, this field is ignored. + +=item C => BOOL (default: 1) + +"fin" flag of the frame. "fin" flag must be 1 in the ending frame of fragments. + +=item C => BOOL (default: 0) + +If set to true, the frame will be masked. + +=item C => VERSION_STR (default: C<'draft-ietf-hybi-17'>) + +WebSocket protocol version string. See L for valid version strings. + +=back + +=head2 C + +Check if frame is of continuation type. + +=head2 C + +Check if frame is of text type. + +=head2 C + +Check if frame is of binary type. + +=head2 C + +Check if frame is a ping request. + +=head2 C + +Check if frame is a pong response. + +=head2 C + +Check if frame is of close type. + +=head2 C + + $opcode = $frame->opcode; + $frame->opcode(8); + +Get/set opcode of the frame. + +=head2 C + + $masked = $frame->masked; + $frame->masked(1); + +Get/set masking of the frame. + +=head2 C + + $frame->append($chunk); + +Append a frame chunk. + +Beware that this method is B. +It makes C<$chunk> empty unless C<$chunk> is read-only. + +=head2 C + + $frame->append(...); + + $frame->next; # next message + +Return the next message as a Perl string (UTF-8 decoded). + +=head2 C + +Return the next message as is. + +=head2 C + +Construct a WebSocket message. + +=head2 C + +The maximum size of the payload. You may set this to C<0> or C to disable +checking the payload size. + +=cut diff --git a/scanner.pl b/scanner.pl index a05cf0c755b..966e1a48423 100755 --- a/scanner.pl +++ b/scanner.pl @@ -1,7 +1,7 @@ #!/usr/bin/perl # Logitech Media Server Copyright 2001-2024 Logitech. -# Lyrion Music Server Copyright 2024 Lyrion Community. +# Lyrion Music Server Copyright 2025 Lyrion Community. # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License, # version 2. @@ -25,7 +25,7 @@ use constant TRANSCODING => 0; use constant PERFMON => 0; use constant ISWINDOWS => ( $^O =~ /^m?s?win/i ) ? 1 : 0; -use constant ISACTIVEPERL => ( $Config{cf_email} =~ /ActiveState/i ) ? 1 : 0; +use constant ISACTIVEPERL => 0; use constant ISMAC => ( $^O =~ /darwin/i ) ? 1 : 0; use constant DEBUGLOG => ( grep { /--nodebuglog/ } @ARGV ) ? 0 : 1; use constant INFOLOG => ( grep { /--noinfolog/ } @ARGV ) ? 0 : 1; @@ -36,24 +36,18 @@ use constant LOCALFILE => 0; use constant NOMYSB => 1; -# Tell PerlApp to bundle these modules -if (0) { - require 'auto/Compress/Raw/Zlib/autosplit.ix'; - require Cache::FileCache; -} - our $REVISION = undef; our $BUILDDATE = undef; BEGIN { # hack a Strawberry Perl specific path into the environment variable - XML::Parser::Expat needs it! - if (ISWINDOWS && !ISACTIVEPERL) { + if (ISWINDOWS) { my $path = File::Basename::dirname($^X); $path =~ s/perl(?=.bin)/c/i; $ENV{PATH} = "$path;" . $ENV{PATH} if -d $path; } - our $VERSION = '9.0.3'; + our $VERSION = '9.1.0'; use Slim::bootstrap; use Slim::Utils::OSDetect; @@ -89,6 +83,7 @@ BEGIN use Slim::Music::Import; use Slim::Music::Info; use Slim::Music::PlaylistFolderScan; +use Slim::Music::ContributorPictureScan; use Slim::Music::ReleaseTypes; use Slim::Music::VirtualLibraries; use Slim::Player::ProtocolHandlers; @@ -270,6 +265,7 @@ sub main { Slim::Music::Import->scanOnlineLibraryOnly($onlineLibrary); Slim::Media::MediaFolderScan->init; Slim::Music::PlaylistFolderScan->init; + Slim::Music::ContributorPictureScan->init; Slim::Music::ReleaseTypes->init(); } @@ -418,7 +414,6 @@ sub usage { --playlists Only scan files in your playlistdir. --onlinelibrary Only update online library content --progress Show a progress bar of the scan. - --dbtype TYPE Force database type (valid values are MySQL or SQLite) --prefsdir Specify alternative preferences directory. --priority set process priority from -20 (high) to 20 (low) --logfile Send all debugging messages to the specified logfile. diff --git a/slimserver.pl b/slimserver.pl index 0ebde9c1306..658b3800662 100755 --- a/slimserver.pl +++ b/slimserver.pl @@ -1,7 +1,7 @@ #!/usr/bin/perl # Logitech Media Server Copyright 2001-2024 Logitech. -# Lyrion Music Server Copyright 2024 Lyrion Community. +# Lyrion Music Server Copyright 2025 Lyrion Community. # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License, # version 2. @@ -15,28 +15,6 @@ require 5.010; use strict; -# Bug 7491 - bug in PerlSvc: ARGV is not populated when executable is run in service mode. -# Try to work around this limitation by reading the command line from the registry. Ugh... -BEGIN { - if ($PerlSvc::VERSION && $^O =~ /^m?s?win/i && !@ARGV) { - eval { - require Win32::TieRegistry; - my $swKey = $Win32::TieRegistry::Registry->Open( - 'LMachine/System/ControlSet001/services/squeezesvc', - { - Access => Win32::TieRegistry::KEY_READ(), - Delimiter =>'/' - } - ); - - if ($swKey) { - push @ARGV, split(" ", $swKey->{ImagePath}); - shift @ARGV; # remove script name - } - }; - } -} - use constant SCANNER => 0; use constant RESIZER => 0; use constant ISWINDOWS => ( $^O =~ /^m?s?win/i ) ? 1 : 0; @@ -55,96 +33,13 @@ BEGIN # leaving some legacy flags for the moment - unlikely but possibly some 3rd party plugin is referring to it use constant SLIM_SERVICE => 0; use constant NOUPNP => 0; +use constant ISACTIVEPERL => 0; use Config; -use constant ISACTIVEPERL => ( $Config{cf_email} =~ /ActiveState/i ) ? 1 : 0; - my %check_inc; $ENV{PERL5LIB} = join $Config{path_sep}, grep { !$check_inc{$_}++ } @INC; -# This package section is used for the windows service version of the application, -# as built with ActiveState's PerlSvc -if (ISACTIVEPERL && $PerlSvc::VERSION) { - package PerlSvc; - - our %Config = ( - DisplayName => 'Lyrion Music Server', - Description => "Lyrion Music Server - streaming media server", - ServiceName => "squeezesvc", - StartNow => 0, - ); - - sub Startup { - # Tell PerlSvc to bundle these modules - if (0) { - require 'auto/Compress/Raw/Zlib/autosplit.ix'; - require Cache::FileCache; - } - - # added to workaround a problem with 5.8 and perlsvc. - # $SIG{BREAK} = sub {} if RunningAsService(); - main::initOptions(); - main::init(); - - # here's where your startup code will go - while (ContinueRun() && !main::idle()) { } - - main::stopServer(); - } - - sub Install { - - my($Username,$Password); - - use Getopt::Long; - - Getopt::Long::GetOptions( - 'username=s' => \$Username, - 'password=s' => \$Password, - ); - - main::initLogging(); - - if ((defined $Username) && ((defined $Password) && length($Password) != 0)) { - my @infos; - my ($host, $user); - - # use the localhost '.' by default, unless user has defined "domain\username" - if ($Username =~ /(.+)\\(.+)/) { - $host = $1; - $user = $2; - } - else { - $host = '.'; - $user = $Username; - } - - # configure user to be used to run the server - my $grant = PerlSvc::extract_bound_file('grant.exe'); - if ($host && $user && $grant && !`$grant add SeServiceLogonRight $user`) { - $Config{UserName} = "$host\\$user"; - $Config{Password} = $Password; - } - } - } - - sub Interactive { - main::main(); - } - - sub Remove { - # add your additional remove messages or functions here - main::initLogging(); - } - - sub Help { - main::showUsage(); - main::initLogging(); - } -} - - package main; use FindBin qw($Bin); @@ -157,13 +52,13 @@ package main; BEGIN { # hack a Strawberry Perl specific path into the environment variable - XML::Parser::Expat needs it! - if (ISWINDOWS && !ISACTIVEPERL) { + if (ISWINDOWS) { my $path = File::Basename::dirname($^X); $path =~ s/perl(?=.bin)/c/i; $ENV{PATH} = "$path;" . $ENV{PATH} if -d $path; } - our $VERSION = '9.0.3'; + our $VERSION = '9.1.0'; # With EV, only use select backend # I have seen segfaults with poll, and epoll is not stable @@ -420,12 +315,7 @@ sub init { $SIG{'HUP'} = \&initSettings; } - if (Slim::Utils::Misc::runningAsService()) { - $SIG{'QUIT'} = \&Slim::bootstrap::ignoresigquit; - } else { - $SIG{'QUIT'} = \&Slim::bootstrap::sigquit; - } - + $SIG{'QUIT'} = \&Slim::bootstrap::sigquit; $SIG{__WARN__} = sub { msg($_[0]) }; # Uncomment to enable crash debugging. @@ -641,11 +531,15 @@ sub init { Slim::Utils::PerfMon->init($perfwarn); } + + # Reset the update flag upon each start + $prefs->remove('serverUpdateAvailable'); + if ( !$os->runningFromSource && $prefs->get('checkVersion') ) { require Slim::Utils::Update; Slim::Utils::Timers::setTimer( undef, - time() + 30, + time() + (logger('server.update')->is_info ? 2 : 30), \&Slim::Utils::Update::checkVersion, ); } @@ -669,7 +563,7 @@ sub main { # all other initialization init(); - if ( ISWINDOWS && !ISACTIVEPERL && $daemon ) { + if ( ISWINDOWS && $daemon ) { Slim::Utils::OSDetect->getOS()->runService(); } else { @@ -813,7 +707,6 @@ sub showUsage { --checkstrings => Enable reloading of changed string files for plugin development --charset => Force a character set to be used, eg. utf8 on Linux devices which don't have full utf8 locale installed - --dbtype => Force database type (valid values are MySQL or SQLite) --logging => Enable logging for the specified comma separated categories --localfile => Enable LocalFile protocol handling for locally connected squeezelite service @@ -1166,6 +1059,7 @@ sub cleanup { Slim::Utils::PluginManager->shutdownPlugins(); main::DEBUGLOG && $log->is_debug && $log->debug("Write out prefs changes."); + $prefs->remove('serverUpdateAvailable'); Slim::Utils::Prefs::writeAll(); main::DEBUGLOG && $log->is_debug && $log->debug("Stop image resizer daemon."); @@ -1202,15 +1096,12 @@ sub remove_pid_file { sub END { Slim::bootstrap::theEND(); - # tell Windows Service manager to resart - if (ISWINDOWS && !ISACTIVEPERL && $? == Slim::Utils::OS::Win64::RESTART_STATUS) { + # tell Windows Service manager to restart + if (ISWINDOWS && $? == Slim::Utils::OS::Win64::RESTART_STATUS) { POSIX::_exit($?); } } -# start up the server if we're not running as a service. -if (!defined($PerlSvc::VERSION)) { - main() -} +main() __END__ diff --git a/strings.txt b/strings.txt index 4a689162409..26539b77aaa 100644 --- a/strings.txt +++ b/strings.txt @@ -97,38 +97,38 @@ CREDITS ZH_CN Kok-Bin Lee COPYRIGHT - CS © 2001-2024 Lyrion – verze 9.0.3 - DA © 2001-2024 Lyrion - version 9.0.3 - DE © 2001-2024 Lyrion Version 9.0.3 - EN © 2001-2024 Lyrion Version 9.0.3 - ES © 2001-2024 Lyrion Versión 9.0.3 - FI © 2001-2024 Lyrionin versio 9.0.3 - FR © 2001-2024 Lyrion Version 9.0.3 - HU © 2001-2024 Lyrion Version 9.0.3 - IT © 2001-2024 Lyrion versione 9.0.3 - NL © 2001-2024 Lyrion versie 9.0.3 - NO © 2001–2024 Lyrion versjon 9.0.3 - PL © 2001-2024 Lyrion wersja 9.0.3 - PT © 2001-2024 Lyrion wersão 9.0.3 - RU © Lyrion, 2001-2024. Версия 9.0.3 - SV © 2001–2024 Lyrion Version 9.0.3 + CS © 2001-2024 Lyrion – verze 9.1.0 + DA © 2001-2024 Lyrion - version 9.1.0 + DE © 2001-2024 Lyrion Version 9.1.0 + EN © 2001-2024 Lyrion Version 9.1.0 + ES © 2001-2024 Lyrion Versión 9.1.0 + FI © 2001-2024 Lyrionin versio 9.1.0 + FR © 2001-2024 Lyrion Version 9.1.0 + HU © 2001-2024 Lyrion Version 9.1.0 + IT © 2001-2024 Lyrion versione 9.1.0 + NL © 2001-2024 Lyrion versie 9.1.0 + NO © 2001–2024 Lyrion versjon 9.1.0 + PL © 2001-2024 Lyrion wersja 9.1.0 + PT © 2001-2024 Lyrion wersão 9.1.0 + RU © Lyrion, 2001-2024. Версия 9.1.0 + SV © 2001–2024 Lyrion Version 9.1.0 VERSION - CS Verze 9.0.3 / r%s - DA Version 9.0.3 / r%s - DE Version 9.0.3 / r%s - EN Version 9.0.3 / r%s - ES Versión 9.0.3 / r%s - FI Versio 9.0.3 / r%s - HU Versio 9.0.3 / r%s - FR Version 9.0.3 / r%s - IT Versione 9.0.3/r%s - NL Versie 9.0.3 / r%s - NO Versjon 9.0.3 / r%s - PL Wersja 9.0.3 / r%s - PT Versão 9.0.3 / r%s - RU Версия 9.0.3 / r%s - SV Version 9.0.3 / r%s + CS Verze 9.1.0 / r%s + DA Version 9.1.0 / r%s + DE Version 9.1.0 / r%s + EN Version 9.1.0 / r%s + ES Versión 9.1.0 / r%s + FI Versio 9.1.0 / r%s + HU Versio 9.1.0 / r%s + FR Version 9.1.0 / r%s + IT Versione 9.1.0/r%s + NL Versie 9.1.0 / r%s + NO Versjon 9.1.0 / r%s + PL Wersja 9.1.0 / r%s + PT Versão 9.1.0 / r%s + RU Версия 9.1.0 / r%s + SV Version 9.1.0 / r%s CHOOSE_A_LANGUAGE CS Zvolte prosím jazyk @@ -6981,11 +6981,11 @@ SETUP_ARTFOLDER SETUP_ARTFOLDER_DESC CS Můžete si zvolit ukládání všech vašich obalů alb do jedné složky s pomocí volby proměnných názvů souborů výše. Zde zadejte umístění souborů obalů alb. Bez ohledu na toto umístění bude Lyrion Music Server stále hledat obaly alb na stejné cestě jako každý zvukový soubor, pokud nebude ve složce obalů alb nalezen žádný odpovídající obal alba. DA Du kan vælge at gemme alle albumcovere i en enkelt mappe og bruge indstillingen til variable filnavne ovenfor. Her skal du angive hvor filerne med albumcoverne er placeret. Uanset hvor mappen er placeret, vil Lyrion Music Server stadig se efter coverbilleder i samme mappe som de enkelte lydfiler hvis der ikke blev fundet et cover i mappen med albumcovere. - DE Mit der Option 'Variable Dateinamen' können Sie alle Plattenhüllen in einem Ordner ablegen. Geben Sie hier den Speicherort der entsprechenden Dateien ein. Unabhängig von diesem Ordner sucht Lyrion Music Server die Plattenhülle im selben Pfad wie die entsprechende Audiodatei, falls keine Plattenhülle im Ordner für Plattenhüllen gefunden wird. - EN You may choose to store all your artwork in a single folder, using the variable filenames option above. Enter the location of the Artwork files here. Regardless of this location, Lyrion Music Server will still look for artwork in the same path as each audio file if no matching artwork is found in the Artwork Folder. + DE Mit der Option 'Variable Dateinamen' können Sie alle Plattenhüllen und Künstlerportraits in einem Ordner ablegen. Geben Sie hier den Speicherort der entsprechenden Dateien ein. Unabhängig von diesem Ordner sucht Lyrion Music Server die Plattenhülle im selben Pfad wie die entsprechende Audiodatei, falls keine Plattenhülle im Ordner für Plattenhüllen gefunden wird. + EN You may choose to store all your artwork (album covers, contributor portraits) in a single folder, using the variable filenames option above. Enter the location of the Artwork files here. Regardless of this location, Lyrion Music Server will still look for artwork in the same path as each audio file if no matching artwork is found in the Artwork Folder. ES Se puede optar por almacenar todas las carátulas en una única carpeta, con la opción de nombre de archivos variables anterior. Introduzca aquí la ubicación de los archivos de carátula. Independientemente de esta ubicación, Lyrion Music Server seguirá buscando carátulas en la misma ruta que cada archivo de audio si no se encuentran carátulas coincidentes en la carpeta de carátulas. FI Halutessasi voit tallentaa kaikki kansikuvat yhteen kansioon käyttäen tiedostonimien muuttujien asetusta yllä. Kirjoita kansikuvatiedostojen sijainti tähän. Tästä huolimatta Lyrion Music Server etsii yhä kansikuvia samasta polusta kuin äänitiedostoja, jos se ei löydä vastaavia kansikuvia kansikuvakansiosta. - FR Vous pouvez saisir un nom de dossier où stocker toutes les pochettes. Si aucune pochette correspondante n'est trouvée dans le dossier spécifié, le Lyrion Music Server recherchera la pochette à l'emplacement du fichier audio. + FR Vous pouvez choisir de stocker toutes vos pochettes d'albums et portraits de contributeurs/artistes dans un seul dossier, en utilisant l'option de noms de fichiers ci-dessus et en indiquant un emplacement ici. Si aucune illustration n'est trouvée dans ce dossier, Lyrion Music Server cherchera à l'emplacement du fichier audio. HE באפשרותך לבחור לאחסן את כל העטיפות בתיקייה יחידה, באמצעות האפשרות לשינוי שמות קבצים שלעיל. הזן כאן את המיקום של קובצי העטיפות. ללא תלות במיקום זה, השרת עדיין יחפש עטיפות בנתיב של כל קובץ שמע אם לא נמצאו עטיפות מתאימות בתיקיית העטיפות. HU Dönthet úgy, hogy az összes grafikát egyetlen mappában tárolja a fenti változó fájlnevek beállításával. Adja meg itt a grafikai fájlok helyét. Ettől a helytől függetlenül a Lyrion Music Server továbbra is ugyanazon az útvonalon keresi a grafikákat, mint az egyes hangfájlok, ha nem található megfelelő grafikát az Artwork mappában. IT Si può scegliere di archiviare tutte le copertine in una sola cartella, usando l'opzione per i nomi di file variabili indicata sopra. Inserire qui la posizione dei file delle copertine. Se nella cartella delle copertine non viene trovata alcuna copertina corrispondente, ne viene eseguita una ricerca nello stesso percorso dei file audio . @@ -6997,6 +6997,21 @@ SETUP_ARTFOLDER_DESC SV Du kan välja att spara alla albumomslag i en och samma mapp med hjälp av alternativet för variabla filnamn ovan. Ange sökvägen till omslagsfilerna här. Oavsett sökvägen du anger här kommer Lyrion Music Server att söka efter omslagsbilder i samma mapp som var och en av ljudfilerna om inget omslag hittas i mappen för omslagsfiler. ZH_CN 您可以利用以上的文件名变量选项,把所有的图象集中存放在一个文件夹内。请在这里输入图象文件所在地点。如果服务器未能在所指定的封面图象文件夹中找到匹配图象,便会在各个音像文件所属的文件夹中寻找匹配的图象。 +SETUP_NO_PORTRAITS + DE Künstlerbilder + EN Artist Portraits + FR Photos d'artistes + +SETUP_NO_PORTRAITS_ON + DE Beim Blättern durch Künstler keine Bilder zeigen + EN Don't show pictures when browsing artists + FR Ne pas afficher de photos lors du parcours des artistes + +SETUP_NO_PORTRAITS_OFF + DE Beim Blättern durch Künstler Bilder anzeigen + EN Show pictures when browsing artists + FR Afficher les photos lors du parcours des artistes + SETUP_BAD_FILE CS Ouha – "%s" asi nebude platný soubor. Zkuste to znovu. DA %s er ikke en gyldig fil. Prøv igen. @@ -22133,6 +22148,9 @@ DEBUG_NETWORK_ASYNCHTTP RU Сведения асинхронного удаленного HTTP-запроса SV Information om asynkron fjärr-HTTP-begäran +DEBUG_NETWORK_WS + EN Web Sockets Client Information + DEBUG_NETWORK_ASYNCDNS CS Protokolování asynchronního DNS DA Asynkron DNS-logføring @@ -23314,6 +23332,11 @@ MERGEVA_PROGRESS RU Объединить неск. исполнителей SV Slå ihop Blandade artister +CONTRIBUTOR_PICTURE_PROGRESS + DE Nach Künstlerbildern suchen + EN Looking for contributor pictures + FR Recherche des photos d'artistes/contributeurs + UPDATESTANDALONEARTWORK_PROGRESS CS Vyhledávání aktualizovaných souborů obalů alb DA Søg efter opdaterede albumcovers @@ -24921,280 +24944,6 @@ BACKUP_ALARM RU Резервный будильник SV Reservalarm -CONTROLPANEL_TITLE - CS Ovládací panel Lyrion Music Serveru - DA Kontrolpanel til Lyrion Music Server - DE Lyrion Music Server-Systemsteuerung - EN Lyrion Music Server Control Panel - ES Panel de control de Lyrion Music Server - FI Lyrion Music Serverin ohjauspaneeli - FR Panneau de configuration du Lyrion Music Server - HU Lyrion Music Server vezérlőpult - IT Pannello di controllo di Lyrion Music Server - NL Lyrion Music Server-configuratiescherm - NO Kontrollpanel for Lyrion Music Server - PL Panel sterowania programu Lyrion Music Server - RU Панель управления Lyrion Music Server - SV Kontrollpanelen för Lyrion Music Server - -CONTROLPANEL_SERVERSTATUS - CS Stav - DA Status - DE Status - EN Status - ES Estado - FI Tila - FR Etat - HE מצב - HU Státusz - IT Stato - JA ステータス - NL Status - NO Status - PL Stan - RU Статус - SV Status - -CONTROLPANEL_STATUS_RUNNING - CS Stav: Server je spuštěn - DA Status: Serveren kører - DE Status: Der Server wird ausgeführt - EN Status: The server is running - ES Estado: el servidor está en ejecución - FI Tila: palvelin on käynnissä - FR Etat : le serveur est en cours d'exécution. - HU Állapot: A szerver fut - IT Stato: il server è in esecuzione - NL Status: De server is actief - NO Status: Serveren kjører - PL Stan: Serwer działa - RU Состояние: сервер выполняется - SV Status: Servern körs - -CONTROLPANEL_STATUS_STARTING - CS Stav: Server se spouští - DA Status: Serveren startes - DE Status: Der Server wird gestartet. - EN Status: The server is starting - ES Estado: el servidor está iniciando - FI Tila: palvelin on käynnistymässä - FR Etat : le serveur est en cours de démarrage. - HU Állapot: A szerver elindul - IT Stato: il server si sta avviando - NL Status: De server wordt gestart - NO Status: Serveren starter opp - PL Stan: Trwa uruchamianie serwera - RU Состояние: сервер запускается - SV Status: Servern startar - -CONTROLPANEL_STATUS_STOPPED - CS Stav: Server je zastaven - DA Status: Serveren er stoppet - DE Status: Der Server wurde angehalten. - EN Status: The server is stopped - ES Estado: el servidor está detenido - FI Tila: palvelin on pysäytetty - FR Etat : le serveur est arrêté. - HU Állapot: A szerver leállt - IT Stato: il server è stato arrestato - NL Status: De server is gestopt - NO Status: Serveren er stoppet - PL Stan: Serwer jest zatrzymany - RU Состояние: сервер остановлен - SV Status: Servern har stoppats - -CONTROLPANEL_ACCOUNT - CS Účet - DA Konto - DE Konto - EN Account - ES Cuenta - FI Tili - FR Compte - HU Fiók - IT Account - NL Account - NO Konto - PL Konto - RU Учетная запись - SV Konto - -CONTROLPANEL_STARTUP_OPTIONS - CS Volby při spuštění - DA Indstillinger for systemstart - DE Startoptionen - EN Startup Options - ES Opciones de inicio - FI Käynnistysasetukset - FR Options de démarrage - HU Indítási lehetőségek - IT Opzioni di avvio - NL Opstartopties - NO Oppstartsalternativer - PL Opcje Autostartu - RU Параметры запуска - SV Startalternativ - -CONTROLPANEL_MUSIC_LIBRARY - CS Knihovna - DA Bibliotek - DE Bibliothek - EN Library - ES Biblioteca - FI Kirjasto - FR Bibliothèque - HU Könyvtár - IT Libreria - NL Bibliotheek - NO Bibliotek - PL Biblioteka - RU Медиатека - SV Bibliotek - -CONTROLPANEL_AUTHENTICATION_REQUIRED - CS Pro přístup do Lyrion Music Serveru je vyžadována autentizace - DA Du skal godkendes for at få adgang til Lyrion Music Server - DE Für den Zugriff auf Lyrion Music Server ist eine Authentifizierung erforderlich - EN Authentication is required to access Lyrion Music Server - ES El acceso a Lyrion Music Server requiere autenticación - FI Lyrion Music Serverin käyttö vaatii todennuksen - FR Une authentification est requise pour accéder au Lyrion Music Server - HU A Lyrion Music Server eléréséhez hitelesítés szükséges - IT Per accedere a Lyrion Music Server è necessario eseguire l'autenticazione - NL Verificatie vereist voor toegang tot Lyrion Music Server - NO Det kreves godkjenning for å få tilgang til Lyrion Music Server - PL W celu uzyskania dostępu do programu Lyrion Music Server wymagane jest uwierzytelnienie - RU Для доступа к Lyrion Music Server требуется проверка подлинности - SV Det krävs autentisering för att komma åt Lyrion Music Server - -CONTROLPANEL_WEB_UI - CS Webové rozhraní - DA Webbaseret brugerflade - DE Web-Benutzeroberfläche - EN Web based Interface - ES Interfaz basada en Web - FI Internet-pohjainen käyttöliittymä - FR Interface Web - HU Web alapú felület - IT Interfaccia basata su Web - NL Webinterface - NO Nettbasert grensesnitt - PL Interfejs internetowy - RU Веб-интерфейс - SV Webbaserat gränssnitt - -CONTROLPANEL_WEB_CONTROL_DESC - CS Webové dálkové ovládání - DA Fjernbetjening via browser - DE Fernbedienung - EN Web Remote Control - ES Control remoto por Web - FI Kauko-ohjaus - FR Commande Web - HU Webes távirányító - IT Controllo remoto Web - NL Afstandsbediening voor web - NO Fjernkontroll - PL Pilot zdalnego sterowania - RU Пульт управления по Интернету - SV Fjärrkontroll - -CONTROLPANEL_TRAY_DOUBLECLICK_WEB - CS Webové dálkové ovládání otevřete dvojitým kliknutím na ikonu v oznamovací oblasti - DA Åbn Fjernbetjening via browser ved at dobbeltklikke på ikonet i systembakken - DE Fernbedienung per Doppelklick auf das Symbol in der Taskleiste öffnen - EN Open Web Remote Control on doubleclicking the tray icon - ES Abrir el Control remoto por Web haciendo doble clic en el icono de la bandeja - FI Avaa WWW-etähallinta kaksoisnapsauttamalla ilmaisinalueen kuvaketta - FR Ouvrir la commande Web en cliquant deux fois sur l'icône de la barre d'état - HU Megnyitja a Webes távvezérlőt, ha duplán kattint a tálca ikonjára - IT Aprire Controllo remoto Web facendo doppio clic sull'icona nell'area di notifica - NL Open web-afstandsbediening door te dubbelklikken op het pictogram in het systeemvak - NO Åpne Fjernkontroll ved dobbeltklikk på ikonet i systemstatusfeltet - PL Otwórz Pilot zdalnego sterowania, klikając dwukrotnie ikonę na pasku zadań - RU Открывать пульт управления по Интернету двойным щелчком по значку на панели задач - SV Öppna webbfjärrkontrollen genom att klicka på ikonen i aktivitetsfältet - -CONTROLPANEL_TRAY_DOUBLECLICK_CONTROLPANEL - CS Ovládací panel otevřete dvojitým kliknutím na ikonu v oznamovací oblasti - DA Åbn kontrolpanelet ved at dobbeltklikke på ikonet i systembakken - DE Systemsteuerung per Doppelklick auf das Symbol in der Taskleiste öffnen - EN Open the Control Panel on doubleclicking the tray icon - ES Abrir el Panel de control haciendo doble clic en el icono de la bandeja - FI Avaa Ohjauspaneeli kaksoisnapsauttamalla ilmaisinalueen kuvaketta - FR Ouvrir le panneau de configuration en cliquant deux fois sur l'icône de la barre d'état - HU Megnyitja a Vezérlőpultot, ha duplán kattint a tálca ikonjára - IT Aprire il pannello di controllo facendo doppio clic sull'icona nell'area di notifica - NL Open het configuratiescherm door te dubbelklikken op het pictogram in het systeemvak - NO Åpne kontrollpanelet ved dobbeltklikk på ikonet i systemstatusfeltet - PL Otwórz Panel sterowania, klikając dwukrotnie ikonę na pasku zadań - RU Открывать панель управления двойным щелчком по значку на панели задач - SV Öppna Kontrollpanelen genom att klicka på ikonen i fältet - -CONTROLPANEL_ADVANCED_SETTINGS_DESC - CS Upřesnit nastavení - DA Avancerede indstillinger - DE Erweiterte Einstellungen - EN Advanced Settings - ES Configuración avanzada - FI Lisäasetukset - FR Paramètres avancés - HU Speciális beállítások - IT Impostazioni avanzate - NL Geavanceerde instellingen - NO Avanserte innstillinger - PL Ustawienia zaawansowane - RU Дополнительные настройки - SV Avancerade inställningar - -CONTROLPANEL_LOGFILES - CS Protokolovací soubory - DA Logfiler - DE Protokolldateien - EN Log Files - ES Archivos de registro - FI Lokitiedostot - FR Fichiers journaux - HU Naplófájlok - IT File di registro - NL Logboeken - NO Loggfiler - PL Pliki dziennika - RU Файлы журнала - SV Loggfiler - -CONTROLPANEL_SHOW_SERVER_LOG - CS Zobrazit protokol serveru - DA Vis serverlogfil - DE Serverprotokoll anzeigen - EN Show server log - ES Mostrar registro de servidor - FI Näytä palvelimen loki - FR Afficher le journal du serveur - HU Szervernapló megjelenítése - IT Mostra registro del server - NL Serverlogboek weergeven - NO Vis serverlogg - PL Pokaż dziennik serwera - RU Показать журнал сервера - SV Visa serverlogg - -CONTROLPANEL_SHOW_SCANNER_LOG - CS Zobrazit protokol prohledávání - DA Vis gennemsøgningslogfilen - DE Scannerprotokoll anzeigen - EN Show scanner log - ES Mostrar registro de examen - FI Näytä tarkistuksen loki - FR Afficher le journal de l'analyseur - HU Szkennernapló megjelenítése - IT Mostra registro analisi - NL Scannerlogboek weergeven - NO Vis søkelogg - PL Pokaż dziennik skanera - RU Показать scanner.log - SV Visa loggfilen för sökning - CONTROLPANEL_UPDATE_AVAILABLE CS Aktualizovaná verze Lyrion Music Serveru je k dispozici a připravena k instalaci. DA Der findes en opdateret version af Lyrion Music Server som er klar til at blive installeret. @@ -25243,278 +24992,6 @@ CONTROLPANEL_NO_UPDATE_AVAILABLE RU Нет доступных обновленных версий Lyrion Music Server. SV Det finns ingen uppdaterad version av Lyrion Music Server tillgänglig. -CONTROLPANEL_CHECK_UPDATE - CS Hledat aktualizace - DA Søg efter opdateringer - DE Nach Update suchen - EN Check for update - ES Buscar actualización - FI Etsi päivityksiä - FR Rechercher les mises à jour - HU Frissítések ellenőrzése - IT Verifica disponibilità aggiornamenti - NL Op update controleren - NO Se etter oppdatering - PL Sprawdź dostępność aktualizacji - RU Проверить наличие обновления - SV Sök efter uppdatering - -CONTROLPANEL_DOWNLOAD_UPDATE - CS Stáhnout aktualizaci - DA Hent opdatering - DE Update herunterladen - EN Download update - ES Descargar actualización - FI Lataa päivitys - FR Télécharger la mise à jour - HU Frissítés letöltése - IT Scarica aggiornamento - NL Update downloaden - NO Last ned oppdatering - PL Pobierz aktualizację - RU Загрузить обновление - SV Ladda ner uppdatering - -CONTROLPANEL_INSTALL_UPDATE - CS Instalovat aktualizaci - DA Installer opdatering - DE Update installieren - EN Install update - ES Instalar actualización - FI Asenna päivitys - FR Installer la mise à jour - HU Frissítés telepítése - IT Installa aggiornamento - NL Update installeren - NO Installer oppdatering - PL Zainstaluj aktualizację - RU Установить обновление - SV Installera uppdatering - -CONTROLPANEL_MAINTENANCE - CS Údržba - DA Vedligeholdelse - DE Reinigen der Maus - EN Maintenance - ES Mantenimiento - FI Huolto - FR Entretien - HU Karbantartás - IT Manutenzione - NL Onderhoud - NO Vedlikehold - PL Konserwacja - RU Обслуживание - SV Underhåll - -CONTROLPANEL_DIAGNOSTICS - CS Diagnostika - DA Diagnosticering - DE Diagnose - EN Diagnostics - ES Diagnósticos - FI Diagnostiikka - FR Diagnostic - HU Diagnosztika - IT Diagnostica - NL Diagnose - NO Diagnose - PL Diagnostyka - RU Диагностика - SV Diagnostik - -CONTROLPANEL_PORTNO - CS Port %s (%s): - DA Port %s (%s): - DE Port %s (%s): - EN Port %s (%s): - ES Puerto %s (%s): - FI Portti %s (%s): - FR Port %s (%s) : - HU %s port (%s) : - IT Porta %s (%s): - NL Poort %s (%s): - NO Port %s (%s): - PL Port %s (%s): - RU Порт %s (%s): - SV Port %s (%s): - -CONTROLPANEL_PING - CS Ping: - DA Ping: - DE Ping: - EN Ping: - ES Ping: - FI Ping: - FR Ping : - HU Ping: - IT Ping: - NL Ping: - NO Ping: - PL Ping: - RU Ping: - SV Ping: - -CONTROLPANEL_FAILED - CS Selhání - DA Mislykkedes - DE Fehlgeschlagen - EN Failed - ES Fallo - FI Epäonnistui - FR Echec - HU Sikertelen - IT Non riuscito - NL Mislukt - NO Mislyktes - PL Niepowodzenie - RU Сбой - SV Åtgärden kunde inte genomföras - -CONTROLPANEL_OK - CS OK - DA OK - DE OK - EN OK - ES Correcto - FI OK - FR OK - HU Rendben - IT OK - NL OK - NO OK - PL OK - RU ОК - SV OK - -CONTROLPANEL_ALERTS - CS Výstrahy - DA Advarsler - DE Benachrichtigungen - EN Alerts - ES Alertas - FI Hälytykset - FR Alertes - HU Figyelmeztetések - IT Avvisi - NL Waarschuwingen - NO Varsler - PL Alerty - RU Сигналы - SV Varningar - -CONTROLPANEL_PORTCONFLICT - CS Lyrion Music Server není v provozu, ale nějaká aplikace používá stejný port (%s). - DA Lyrion Music Server kører ikke, men et andet program benytter den samme port (%s). - DE Lyrion Music Server wird nicht ausgeführt. Port (%s) wird von einer anderen Anwendung verwendet. - EN Lyrion Music Server is not running, but some application is using the same port (%s). - ES Lyrion Music Server no está en ejecución, pero alguna aplicación está usando el mismo puerto (%s). - FI Lyrion Music Server ei ole käynnissä, mutta jokin sovellus käyttää samaa porttia (%s). - FR Le Lyrion Music Server n'est pas en cours d'exécution, mais une application utilise actuellement le même port (%s). - HU A Lyrion Music Server nem fut, de néhány alkalmazás ugyanazt a portot (%s) használja. - IT Lyrion Music Server non è in esecuzione ma qualche applicazione sta utilizzando la stessa porta (%s). - NL Lyrion Music Server is niet actief. Poort (%s) wordt door een andere applicatie gebruikt. - NO Lyrion Music Server kjører ikke, men et annet program bruker samme port (%s). - PL Program Lyrion Music Server nie jest uruchomiony, ale jakaś aplikacja używa tego samego portu (%s). - RU Lyrion Music Server не выполняется, но какое-то приложение использует этот же порт (%s). - SV Lyrion Music Server körs inte men något program använder samma port (%s). - -CONTROLPANEL_PORTBLOCKED - CS Lyrion Music Server je v provozu, ale nemůže se spojit s portem %s. - DA Lyrion Music Server kører men kan ikke kontaktes på port %s. - DE Lyrion Music Server wird ausgeführt, kann aber an Port %s nicht erreicht werden. - EN Lyrion Music Server is running but can't be contacted on port %s. - ES Lyrion Music Server está en ejecución pero no se puede contactar con él en el puerto %s. - FI Lyrion Music Server on käynnissä, mutta siihen ei saada yhteyttä portissa %s. - FR Le Lyrion Music Server est en cours d'exécution mais ne peut être contacté sur le port %s. - HU A Lyrion Music Server fut, de nem érhető el a %s porton. - IT Lyrion Music Server è in esecuzione ma non può essere contattato sulla porta %s - NL Lyrion Music Server wordt uitgevoerd maar is niet toegankelijk via poort %s. - NO Lyrion Music Server kjører, men kan ikke kontaktes på port %s - PL Program Lyrion Music Server działa, ale nie można skontaktować się z nim na porcie %s. - RU Lyrion Music Server выполняется, но подключение через порт %s невозможно. - SV Lyrion Music Server körs men går inte att ansluta till port %s. - -CONTROLPANEL_PORTBLOCKED_APPS - CS Vaše spojení mohou blokovat následující aplikace: - DA Følgende programmer blokerer muligvis forbindelsen: - DE Folgende Anwendungen blockieren unter Umständen die Verbindung: - EN The following applications might be blocking your connection: - ES Es posible que las aplicaciones siguientes estén bloqueando la conexión: - FI Seuraavat sovellukset saattavat estää yhteyden: - FR Les applications suivantes sont susceptibles de bloquer votre connexion : - HU Lehetséges, hogy a következő alkalmazások blokkolják a kapcsolatot: - IT Le seguenti applicazioni potrebbero bloccare la connessione: - NL Jouw verbinding wordt mogelijk door de volgende applicaties geblokkeerd: - NO Følgende programmer blokkerer kanskje tilkoplingen: - PL Następujące aplikacje mogą blokować połączenie: - RU Возможно, подключение блокируется следующими приложениями: - SV Följande program kan blockera anslutningen: - -CONTROLPANEL_CONFLICT_CISCOVPNSTATEFULINSPECTION - CS Pokud se vyskytnou problémy s připojením k Lyrion Music Serveru, ujistěte se, že je vypnuta funkce "Stateful Firewall (Always On)" - DA Hvis der er problemer med forbindelsen til og fra Lyrion Music Server, skal du kontrollere at "Stateful Firewall (Always On)" er slået fra - DE Wenn es Verbindungsprobleme mit Lyrion Music Server gibt, vergewissern Sie sich, dass die Option "Statusbehaftete Firewall (immer aktiv)" deaktiviert ist. - EN If you encounter connectivity issues with Lyrion Music Server, please make sure "Stateful Firewall (Always On)" is turned off - ES Si surgen problemas de conectividad con Lyrion Music Server, asegúrese de que la opción "Stateful Firewall (Always On)" está desactivada - FI Jos Lyrion Music Serverin kanssa on yhteysongelmia, varmista, että Tilallinen palomuuri (aina käytössä) -valinta ei ole valittuna. - FR Si vous rencontrez des problèmes de connectivité avec le Lyrion Music Server, vérifiez que l'option "Pare-feu stateful (toujours activé)" est désactivée. - HU Ha kapcsolódási problémákat tapasztal a Lyrion Music Serverrel, kérjük, győződjön meg arról, hogy az „Állapotfüggő tűzfal (mindig bekapcsolva)” ki van kapcsolva - IT In caso di problemi di connessione con Lyrion Music Server, verificare che il firewall con stato sia disattivato. - NL Ondervind je verbindingsproblemen met Lyrion Music Server, zorg dan dat 'Stateful Firewall (Altijd aan)' is uitgeschakeld - NO Hvis du har tilkoplingsproblemer med Lyrion Music Server, må du sørge for at "Tilstandsbevisst brannmur (Alltid på)" er slått av - PL W przypadku wystąpienia problemów z łącznością w programie Squeezebox, upewnij się, że opcja „Zapora stanowa (zawsze włączona)” jest wyłączona - RU При возникновении проблем с подключением к Lyrion Music Server убедитесь, что параметр "Брандмауэр с отслеживанием состояния (Всегда включено)" отключен - SV Om det uppstår anslutningsproblem med Lyrion Music Server bör du kontrollera att alternativet Tillståndskänslig brandvägg (alltid på) är avaktiverat - -CONTROLPANEL_CONFLICT_SCPERL - CS Pokud provozujete Lyrion Music Server s použitím verze Perlu, pak je to v pořádku a očekáváno. - DA Hvis du kører Lyrion Music Server i Perl-versionen, er det OK og forventet. - DE Das Ausführen von Lyrion Music Server mithilfe der Perl-Version wird akzeptiert und erwartet. - EN If you're running Lyrion Music Server using the perl version, then this is ok and expected. - ES Si ejecuta Lyrion Music Server con la versión perl, es correcto y está previsto. - FI Jos Lyrion Music Server on käynnissä ja käytät Perl-versiota, tämä on odotettavissa eikä aiheuta ongelmia. - FR Si vous exécutez Lyrion Music Server à l'aide de la version perl, cet événement est attendu. - HU Ha a Lyrion Music Servert perl verzióval fut, akkor ez rendben van. - IT Se è in esecuzione la versione Perl di Lyrion Music Server, il problema non sussiste. - NL Als je Lyrion Music Server met de perl-versie uitvoert, is dit normaal gedrag. - NO Hvis du kjører Lyrion Music Server med perl-versjonen, er dette greit og forventet. - PL Jeśli używasz programu Lyrion Music Server w wersji perl, jest to poprawne i oczekiwane zachowanie. - RU При выполнении Lyrion Music Server с версией perl данное поведение ожидаемо и нормально. - SV Om du kör du perlversionen av Lyrion Music Server är detta inget fel, utan OK och förväntat. - -CONTROLPANEL_OTHER_ISSUE - CS Nalezen možný konflikt softwaru - DA Der er fundet en mulig softwarekonflikt - DE Möglicher Software-Konflikt gefunden - EN Possible software conflict found - ES Encontrado posible conflicto de software - FI Löytyi mahdollinen ohjelmiston ristiriita - FR Conflit logiciel possible détecté - HU Lehetséges szoftverütközés található - IT Possibile conflitto software rilevato - NL Mogelijk softwareconflict gevonden - NO Mulig programvarekonflikt oppdaget - PL Znaleziono potencjalny konflikt oprogramowania - RU Обнаружен возможный конфликт ПО - SV Eventuellt programvarukonflikt upptäcktes - -CONTROLPANEL_OTHER_ISSUE_ESETPORTFILTERING - CS ESET Antivirus nebo Smart Security může při spuštění Lyrion Music Serveru způsobovat problémy. Pokud dojde k chybě při spuštění Lyrion Music Serveru, ujistěte se, že jste zrušili zaškrtnutí filtrování portů pro SqueezeboxSvr.exe v Pokročilém nastavení ESET / Antivirus a antispyware / Ochrana webového přístupu / HTTP, HTTPS / Webové prohlížeče. - DA ESET Antivirus eller Smart Security kan skabe problemer når du starter Lyrion Music Server. Hvis du ikke kan starte Lyrion Music Server, skal du sørge for at porten som bruges af SqueezeSvr.exe, ikke er lukket i ESET Advanced Settings/Antivirus og antispyware/Web access protection/HTTP, HTTPS/Web browsers. - DE ESET Antivirus oder ESET Smart Security können beim Starten von Lyrion Music Server Probleme verursachen. Wenn beim Starten von Lyrion Music Server Fehler auftreten, sollten Sie prüfen, ob Sie unter ESET Advanced Settings/Antivirus and antispyware/Web access protection/HTTP, HTTPS/Web browsers die Portfilterung für 'SqueezeSvr.exe' deaktiviert haben. - EN ESET Antivirus or Smart Security can cause problems starting Lyrion Music Server. If you experience failure starting Lyrion Music Server, then make sure you have unchecked port filtering for SqueezeSvr.exe in ESET Advanced Settings/Antivirus and antispyware/Web access protection/HTTP, HTTPS/Web browsers. - ES ESET Antivirus o Smart Security pueden producir problemas a la hora de iniciar Lyrion Music Server. Si no puede iniciar Lyrion Music Server, asegúrese de no tener seleccionada la opción de filtrado de puertos para SqueezeSvr.exe en ESET: Configuración avanzada/Antivirus y antiespía/Protección del tráfico de Internet/HTTP, HTTPS/Navegadores de Internet. - FI ESET Antivirus tai Smart Security saattavat aiheuttaa ongelmia Lyrion Music Serverin käynnistyksessä. Jos Lyrion Music Serverin käynnistys ei onnistu, varmista, että olet poistanut portinsuodatuksen valinnan SqueezeboxSvr.exe-tiedostolle kohteessa ESET Advanced Settings/Antivirus and antispyware/Web access protection/HTTP, HTTPS/Web browsers. - FR L'antivirus ESET ou Smart Security peut empêcher le démarrage du Lyrion Music Server. En cas d'échec du démarrage du Lyrion Music Server, vérifiez que le filtrage des ports n'est pas activé pour SqueezeSvr.exe sous ESET Advanced Settings/Antivirus et antispyware/Web access protection/HTTP, HTTPS/Web browsers. - HU Az ESET Antivirus vagy a Smart Security problémákat okozhat a Lyrion Music Server indításakor. Ha a Lyrion Music Server indításakor hiba lép fel, ellenőrizze, hogy nincs-e bejelölve a SqueezeSvr.exe portszűrése az ESET Speciális beállítások/Vírusirtó és kémprogram-elhárító/Webhozzáférés-védelem/HTTP, HTTPS/Webböngészők részben. - IT L'antivirus ESET o Smart Security possono causare problemi di avvio di Lyrion Music Server. Se Lyrion Music Server non si avvia, deselezionare il filtraggio delle porte per SqueezeSvr.exe in Impostazioni avanzate/Antivirus e antispyware/Protezione accesso Web/HTTP di ESET e nei browser HTTPS/Web. - NL ESET Antivirus of Smart Security kan problemen veroorzaken bij het opstarten van Lyrion Music Server. Controleer in dit geval of je het filteren van poorten hebt uitgeschakeld voor SqueezeSvr.exe in ESET Advanced Settings/Antivirus and antispyware/Web access protection/HTTP, HTTPS/Web browsers. - NO ESET Antivirus og Smart Security kan skape problemer med oppstarten av Lyrion Music Server. Hvis du ikke får til å starte Lyrion Music Server, må du sikre at du ikke har merket av for portfiltrering for SqueezeSvr.exe i ESET Advanced Settings/Antivirus and antispyware/Web access protection/HTTP, HTTPS/Web browsers. - PL Program ESET Antivirus lub Smart Security może powodować problemy z uruchomieniem programu Lyrion Music Server. W przypadku napotkania problemu z uruchomieniem programu Lyrion Music Server należy sprawdzić, czy wyłączono opcję filtrowania portów dla programu SqueezeSvr.exe w ustawieniach zaawansowanych funkcji antywirusowych i anty-spyware programu ESET, a także w ustawieniach zabezpieczeń dostępu do sieci Web oraz protokołów HTTP/HTTPS przeglądarki internetowej. - RU Антивирусная программа ESET или Smart Security может привести к неполадкам при запуске Lyrion Music Server. Если возникают ошибки при запуске Lyrion Music Server, убедитесь, что для SqueezeSvr.exe отключена фильтрация портов в разделе ESET Advanced Settings/Antivirus and antispyware/Web access protection/HTTP, HTTPS/Web browsers. - SV Om ESET Antivirus och Smart Security är installerade kan det uppstå problem när Lyrion Music Server ska startas. Vid eventuella problem bör du kontrollera att du har avmarkerat portfiltrering för SqueezeboxSvr.exe i ESET under Avancerade inställningar/Skydd mot virus och spionprogram/Webbåtkomstskydd/HTTP, HTTPS/Webbläsare. - CONTROLPANEL_REFRESH CS Obnovit DA Opdater @@ -25788,38 +25265,6 @@ CLEANUP_DELETING RU Удаление SV Raderar -CONTROLPANEL_NO_STATUS - CS Nejsou dostupné žádné informace o stavu. Vezměte na vědomí, že pro zobrazení informací o stavu musí být Lyrion Music Server aktivní a v provozu. - DA Der er ingen statusoplysninger. Husk at Lyrion Music Server skal køre for at du kan se statusoplysninger. - DE Keine Statusinformationen verfügbar. Lyrion Music Server muss eingerichtet und ausgeführt werden, damit die Statusinformationen angezeigt werden können. - EN No status information available. Please note that Lyrion Music Server has to be up and running in order to display its status information. - ES No hay información de estado disponible. Tenga en cuenta que Lyrion Music Server debe estar en ejecución para mostrar su información de estado. - FI Tilatietoja ei ole saatavilla. Huomaa, että Lyrion Music Serverin on oltava käynnissä, jotta sen tilatiedot voitaisiin näyttää. - FR Aucune information sur l'état n'est disponible. Notez que le Lyrion Music Server doit être en cours d'utilisation pour afficher ces informations. - HU Nem áll rendelkezésre állapotinformáció. Kérjük, vegye figyelembe, hogy a Lyrion Music Servernek működnie kell az állapotinformációk megjelenítéséhez. - IT Non sono disponibili informazioni sullo stato. Per visualizzare le informazioni sullo stato è necessario che Lyrion Music Server sia in esecuzione. - NL Geen statusinformatie beschikbaar. Lyrion Music Server moet actief zijn om statusinformatie te kunnen weergeven. - NO Ingen statusinformasjon er tilgjengelig. Lyrion Music Server må kjøre for at den skal kunne vise statusinformasjon. - PL Brak dostępnych informacji o stanie. Aby możliwe było wyświetlenie informacji o stanie programu Lyrion Music Server, musi on być uruchomiony. - RU Сведения о состоянии недоступны. Сведения о состоянии выводятся только в том случае, если Lyrion Music Server выполняется. - SV Det finns ingen statusinformation. Tänk på att statusinformationen inte kan visas när Lyrion Music Server inte körs. - -CONTROLPANEL_NEED_ADMINISTRATOR - CS Nemáte práva instalovat nebo spouštět/zastavovat procesy Lyrion Music Serveru na pozadí. Spusťte ovládací panel z nabídky Start systému Windows prostřednictvím kontextové nabídky vyvolané pravým klepnutím tlačítka, a klikněte na možnost "Spustit jako správce". - DA Du har ikke rettigheder til at installere eller starte/stoppe baggrundstjenesten Lyrion Music Server. Start kontrolpanelet fra Startmenuen i Windows – via højrekliksmenuen klikker du på "Kør som administrator". - DE Sie sind nicht dazu berechtigt, den Lyrion Music Server-Hintergrunddienst zu installieren oder zu starten bzw. anzuhalten. Öffnen Sie die Systemsteuerung im Windows-Startmenü über das Kontextmenü und wählen Sie 'Als Administrator ausführen'. - EN You don't have privileges to install or start/stop the Lyrion Music Server background service. Please start the control panel from the Windows Start Menu, via the right click context menu, and click "Run as Administrator". - ES No tiene privilegios para instalar o iniciar/detener el servicio en segundo plano Lyrion Music Server. Inicie el Panel de control desde el menú Inicio de Windows, mediante el menú contextual de botón derecho y haga clic en "Ejecutar como administrador". - FI Sinulla ei ole tarvittavia oikeuksia asentaa, käynnistää tai pysäyttää Lyrion Music Serverin taustapalvelua. Avaa Windowsin Käynnistä-valikosta palvelimen ohjauspaneeli napsauttamalla kakkospainiketta ja valitse pikavalikosta Suorita järjestelmänvalvojana. - FR Vous ne disposez pas des droits pour installer ou arrêter/démarrer le service d'arrière-plan Lyrion Music Server. Démarrez le Panneau de configuration en cliquant dessus à l'aide du bouton droit dans le menu Démarrer de Windows et en sélectionnant Exécuter en tant qu'administrateur. - HU Nincs jogosultsága a Lyrion Music Server háttérszolgáltatás telepítéséhez, elindításához/leállításához. Kérjük, indítsa el a vezérlőpultot a Windows Start menüjéből, a jobb gombbal a helyi menüből, majd kattintson a "Futtatás rendszergazdaként" elemre. - IT Non si dispone dei privilegi per installare o avviare/arrestare il servizio in background di Lyrion Music Server. Aprire il Pannello di controllo dal menu Start di Windows utilizzando il menu di scelta rapida visualizzabile facendo clic con il pulsante destro del mouse, quindi fare clic su "Esegui come amministratore". - NL Je hebt geen rechten om de achtergrondprocessen van Lyrion Music Server te installeren of te starten/stoppen. Start het Configuratiescherm vanuit het menu Start in Windows via de rechtermuisknop en klik in het snelmenu op 'Als administrator uitvoeren'. - NO Du har ikke rettighetene som trengs for å installere eller starte/stoppe bakgrunnstjenesten Lyrion Music Server. Start kontrollpanelet fra Start-menyen i Windows ved å høyreklikke og velge Kjør som administrator. - PL Brak uprawnień do uruchomienia lub zatrzymania działającej w tle usługi Lyrion Music Server. Kliknij menu Start, ustaw kursor myszy nad Panelem sterowania, kliknij prawym przyciskiem myszy i wybierz polecenie Uruchom jako administrator. - RU У вас нет прав на установку и запуск/остановку фоновой службы Lyrion Music Server. Откройте панель управления с помощью меню "Пуск" Windows и, открыв щелчком правой кнопки мыши контекстное меню, выберите в нем пункт "Запуск от имени администратора". - SV Du har inte behörighet att installera eller starta/stoppa Lyrion Music Server-bakgrundstjänsten. Starta kontrollpanelen från Start-menyn i Windows via den snabbmeny som visas när du högerklickar och klicka på Kör som administratör. - RUN_AT_BOOT CS Spustit automaticky při startu systému DA Kør automatisk ved systemstart