<commit_before>#| Copyright (c) 2012, 2013 <NAME> <<EMAIL>>
 | 
 | Permission to use, copy, modify, and distribute this software for any
 | purpose with or without fee is hereby granted, provided that the above
 | copyright notice and this permission notice appear in all copies.
 | 
 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 |#

(require-extension miscmacros)

(include "misc-helpers.scm")
(include "video.scm")

(define (tv4:download-xml-data xml-base-url)
  (and-let* ((xml-base (fetch xml-base-url #:reader xml-read))
             (xml-play (fetch (conc xml-base-url "/play") #:reader xml-read)))
    (list (caddr xml-base)
          (caddr xml-play))))

(define (tv4:xml-item->stream data)
  (and-let* ((url-form (sxml-ref data 'base))
             (url (sxml-ref data 'url))
             (scheme (or (sxml-ref data 'scheme)
                         (url->protocol (sxml-ref data 'url))))
             (mediaformat (sxml-ref data 'mediaFormat))
             (is-media-stream? (not (string=? "smi" mediaformat)))
             (bitrate (string->number (sxml-ref data 'bitrate))))
    (cond
     ((string=? mediaformat "flv")
      ;; Was/is this the correct value? Are there even any rtmp streams
      ;; left at TV4 Play?
      (make-stream (make-stream-value 'stream-type 'rtmp)
                   (make-stream-value 'url url-form)
                   (make-stream-value 'swf-path url)
                   (make-stream-value 'bitrate bitrate)))
     ((string=? mediaformat "mp4")
      (make-stream (make-stream-value 'stream-type 'hds)
                   (make-stream-value 'url url)
                   (make-stream-value 'bitrate bitrate)))
     (else #f))))

(define (tv4:xml-items->subtitles-url data)
  (cond
   ((or (null? data)
        (not (string? (sxml-ref (car data) 'mediaFormat))))
    #f)
   ((string=? "smi" (sxml-ref (car data) 'mediaFormat))
    (sxml-ref (car data) 'url))
   (else
    (tv4:xml-items->subtitles-url (cdr data)))))

(define (tv4:xml-data->video data)
  (and-let* ((xml-items (sxml-ref/proper data 'playback 'items)))
    (let* ((subtitles (tv4:xml-items->subtitles-url xml-items))
           (is-live (string=? "true" (sxml-ref data 'playback 'live)))
           (video-id (sxml-ref data 'playback '@ 'assetId))
           (suggest-filename (lambda ()
                               (if* (sxml-ref data 'playback 'title)
                                    it
                                    (conc "tv4-video-" video-id))))
           (swf-player "http://www.tv4play.se/flash/tv4playflashlets.swf"))
      (streams->video
       (map (lambda (stream)
              (update-stream stream
                             (if subtitles
                                 (make-stream-value 'subtitles subtitles))
                             (make-stream-value 'live is-live)
                             (make-stream-value 'default-filename
                                                (suggest-filename))
                             (if (eq? 'rtmp (stream-ref 'stream-type stream))
                                 (make-stream-value 'swf-player swf-player))))
            (filter-map tv4:xml-item->stream xml-items))))))

(define (tv4:xml-url->video xml-url)
  (and-let* ((data (tv4:download-xml-data xml-url)))
    (tv4:xml-data->video data)))

(define (tv4:video-id->xml-url id)
  (conc "http://prima.tv4play.se/api/web/asset/" id))
<commit_msg>Add HLS support for TV4 Play<commit_after>#| Copyright (c) 2012, 2013 <NAME> <<EMAIL>>
 | 
 | Permission to use, copy, modify, and distribute this software for any
 | purpose with or without fee is hereby granted, provided that the above
 | copyright notice and this permission notice appear in all copies.
 | 
 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 |#

(require-extension miscmacros)

(include "misc-helpers.scm")
(include "parsers/apple-hls.scm")
(include "video.scm")

(define (tv4:download-xml-data xml-base-url)
  (and-let* ((xml-base (fetch xml-base-url #:reader xml-read))
             (xml-play-hds (fetch (conc xml-base-url "/play")
                             #:reader xml-read))
             (xml-play-hls (fetch (conc xml-base-url "/play?protocol=hls")
                                   #:reader xml-read)))
    (list (caddr xml-base)
          (caddr xml-play-hds)
          (caddr xml-play-hls))))

(define (tv4:xml-item->streams data)
  (and-let* ((url-form (sxml-ref data 'base))
             (url (sxml-ref data 'url))
             (scheme (or (sxml-ref data 'scheme)
                         (url->protocol (sxml-ref data 'url))))
             (mediaformat (sxml-ref data 'mediaFormat))
             (is-media-stream? (not (string=? "smi" mediaformat)))
             (bitrate (string->number (sxml-ref data 'bitrate)))
             (add-hls-values (lambda (stream)
                               (update-stream
                                stream
                                (make-stream-value 'stream-type 'hls)
                                (make-stream-value 'ffmpeg-parameters
                                                   "-absf aac_adtstoasc")
                                (make-stream-value 'url url)))))
    (cond
     ((string=? mediaformat "flv")
      ;; Was/is this the correct value? Are there even any rtmp streams
      ;; left at TV4 Play?
      (list
       (make-stream (make-stream-value 'stream-type 'rtmp)
                    (make-stream-value 'url url-form)
                    (make-stream-value 'swf-path url)
                    (make-stream-value 'bitrate bitrate))))
     ((and (string=? mediaformat "mp4")
           (string-suffix? ".m3u8" url-form))
      (map add-hls-values (hls-master->streams url)))
     ((and (string=? mediaformat "mp4")
           (string-suffix? ".f4m" url-form))
      (list
       (make-stream (make-stream-value 'stream-type 'hds)
                    (make-stream-value 'url url)
                    (make-stream-value 'bitrate bitrate))))
     (else #f))))

(define (tv4:xml-items->subtitles-url data)
  (cond
   ((or (null? data)
        (not (string? (sxml-ref (car data) 'mediaFormat))))
    #f)
   ((string=? "smi" (sxml-ref (car data) 'mediaFormat))
    (sxml-ref (car data) 'url))
   (else
    (tv4:xml-items->subtitles-url (cdr data)))))

(define (tv4:xml-data->video data)
  (and-let* ((playback-items (filter-map (lambda (x)
                                           (if (equal? (caip x) 'playback)
                                               x
                                               #f))
                                         data)))
    (video-join (filter-map
     (lambda (playback-item)
       (and-let* ((xml-items (sxml-ref/proper playback-item 'items)))
         (let* ((subtitles (tv4:xml-items->subtitles-url xml-items))
                (is-live (string=? "true" (sxml-ref data 'playback 'live)))
                (video-id (sxml-ref data 'playback '@ 'assetId))
                (suggest-filename (lambda ()
                                    (if* (sxml-ref data 'playback 'title)
                                         it
                                         (conc "tv4-video-" video-id))))
                (swf-player "http://www.tv4play.se/flash/tv4playflashlets.swf"))
           (streams->video
            (map (lambda (stream)
                   (update-stream stream
                                  (if subtitles
                                      (make-stream-value 'subtitles subtitles))
                                  (make-stream-value 'live is-live)
                                  (make-stream-value 'default-filename
                                                     (suggest-filename))
                                  (if (eq? 'rtmp
                                           (stream-ref 'stream-type stream))
                                      (make-stream-value 'swf-player
                                                         swf-player))))
                 (join (filter-map tv4:xml-item->streams xml-items)))))))
     playback-items))))

(define (tv4:xml-url->video xml-url)
  (and-let* ((data (tv4:download-xml-data xml-url)))
    (tv4:xml-data->video data)))

(define (tv4:video-id->xml-url id)
  (conc "http://prima.tv4play.se/api/web/asset/" id))

{'fraction_non_alphanumeric': 0.12988857330128906, 'fraction_numerical': 0.00600830238147258, 'mean_word_length': 1.7492492492492493, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 34, 'https://': 0, 'lorem ipsum': 0, 'www.': 2, 'xml': 80}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 41, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1592869', 'n_tokens_mistral': 2734, 'n_tokens_neox': 2622, 'n_words': 740}