view release on metacpan or  search on metacpan

lib/Quiq/File/Video.pm  view on Meta::CPAN

=head2 Interne Methoden

=head3 analyzeFile() - Analysiere Video-Datei

=head4 Synopsis

  $vid->analyzeFile;

=head4 Description

Analysiere die Video-Datei mit ffprobe und weise die ermittelten
Eigenschaften an die Attribute des Objektes zu.

=cut

# -----------------------------------------------------------------------------

sub analyzeFile {
    my $self = shift;

    if (!defined $self->get('width')) {
        my $file = $self->file;
        $file =~ s/([\$"])/\\$1/g;

        # Dateiinformation in XML gewinnen

        my $cmd = q|ffprobe -loglevel error -print_format xml|.
            qq| -show_streams -select_streams v:0 '$file'|;

        if ($self->verbose) {
            print "$cmd\n";
        }

        my ($xml) = Quiq::Ipc->filter($cmd);

        # Breite, Höhe

        my ($width) = $xml =~ /\bwidth="(\d+)"/;
        my ($height) = $xml =~ /\bheight="(\d+)"/;

        if (!$width || !$height) {
            $self->throw;
        }

        $self->set(width=>$width);
        $self->set(height=>$height);

        # Bitrate in kb

        my ($bitrate) = $xml =~ /\bbit_rate="(\d+)"/;
        $self->set(bitrate=>int $bitrate/1000); # ffmpeg rechnet offenbar so

        # Framerate
    
        # MEMO: manchmal gibt es das Feld frame_rate nicht, sondern
        # nur die r_frame_rate und avg_frame_rate.

        my ($framerate) = $xml =~ /\b(?:avg_)?frame_rate="(.+?)"/;
        if ($framerate =~ m|/|) {
            my ($x,$y) = split m|/|,$framerate;
            $framerate = Quiq::Formatter->normalizeNumber(
                sprintf '%.2f',$x/$y);
        }
        $self->set(framerate=>$framerate);

        # Dauer (millisekundengenau)

        my ($duration) = $xml =~ /\bduration="([\d.]+)"/;
        $duration = Quiq::Formatter->normalizeNumber(
            sprintf '%.3f',$duration);
        $self->set(duration=>$duration);

        # Anzahl Frames

        my ($frames) = $xml =~ /\bnb_frames="(\d+)"/;
        $self->set(frames=>$frames);
    }

    return;
}

# -----------------------------------------------------------------------------

=head1 VERSION

1.238

=head1 AUTHOR

Frank Seitz, L<http://fseitz.de/>

=head1 COPYRIGHT

Copyright (C) 2026 Frank Seitz

=head1 LICENSE

This code is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

# -----------------------------------------------------------------------------

1;

# eof