OPML.xxm

[[@Classes,ActiveX,Variants,MSXML2_TLB,DataLank,xxmSession,fCommon]][[!var
m:TStreamAdapter;
d:DOMDocument60;
db:TDataConnection;
qr:TQueryResult;
c,c1,pn:string;
cn,i,j,l:integer;
p:IXxmParameter;

const
DefaultReadWidth=32;

procedure DoOutlines(xl:IXMLDOMNodeList;const Group:string);
var
  x:IXMLDOMElement;
  s,t,feedcolor,autounread:string;
  qr:TQueryResult;
  id,id1,rw,ur0:integer;
  ur:Variant;
begin
  x:=xl.nextNode as IXMLDOMElement;
  if x<>nil then
   begin
    Context.SendHTML('<div style="margin-left:0.5em;">'#13#10);
    while x<>nil do
     begin
      s:=VarToStr(x.getAttribute('xmlUrl'));
      if s<>'' then
       begin
        //feed exists?
        t:=VarToStr(x.getAttribute('f:label'));
        qr:=TQueryResult.Create(db,'select id, name from "Feed" where url=$1',[s]);
        try
          if qr.EOF then id:=0 else
           begin
            id:=qr.GetInt(0);
            if t='' then t:=qr.GetStr(1);
           end;
        finally
          qr.Free;
        end;
        if id=0 then
         begin
          if t='' then t:=NameFromFeedURL(s);
          id1:=0;
         end
        else
         begin
          //already subscribed?
          qr:=TQueryResult.Create(db,'select id from "Subscription" where user_id=$1 and feed_id=$2',[Session.UserID,id]);
          try
            if qr.EOF then id1:=0 else id1:=qr.GetInt(0);
          finally
            qr.Free;
          end;
         end;
      
        feedcolor:=VarToStr(x.getAttribute('f:color'));
        if not TryStrToInt(VarToStr(x.getAttribute('f:readwidth')),rw) then
          rw:=DefaultReadWidth;
        autounread:=VarToStr(x.getAttribute('f:autounread'));
        if autounread='' then ur:=Null else
          if TryStrToInt(autounread,ur0) then ur:=ur0 else ur:=Null;

        if id1=0 then
          Context.SendHTML('<label><input type="checkbox" name="f" value="'+URLEncode(
              ['l',s
              ,'f',id
              ,'t',t
              ,'c',feedcolor
              ,'x',Group
              ,'w',rw
              ,'u',ur
              ])+'" checked="1" />')
        else
          Context.SendHTML('&emsp;');
        Context.SendHTML('&nbsp;'+ShowLabel(t,feedcolor,'')+'&nbsp;'+HTMLEncode(t)+' <span style="color:silver;">'+HTMLEncode(s)+'</span>');
        if Group<>'' then Context.SendHTML(' ('+HTMLEncode(Group)+')');
        if id1=0 then
          Context.SendHTML('</label>');
        Context.SendHTML('<br />'#13#10);
  
       end;
  
      s:=VarToStr(x.getAttribute('title'));
      if s='' then s:=Group else if Group<>'' then s:=Group+'\'+s;
      DoOutlines(x.selectNodes('outline'),s);
      DoOutlines(x.selectNodes('opml:outline'),s);
      x:=xl.nextNode as IXMLDOMElement;
     end;
    Context.SendHTML('</div>'#13#10);
   end;
end;

var
  s,t,u,g,feedcolor:string;
  id,id1,rw:integer;
  ur:Variant;


]][[
Context.Include('dHead.xxmi');

<<div style="position:fixed;top:0;left:0em;background-color:gold;padding:4pt;user-select:none;">
<a href="."><img src="img_l.png" width="16" height="16" border="0" alt="Back" /></a>
<a href="Feeds.xxm"><img src="img_l.png" width="16" height="16" border="0" alt="Back" /></a>
&nbsp;
<b>OPML</b>
</div>

<div style="height:1.5em;padding-bottom:2pt;">&nbsp;</div>>


case Context['x'].AsInteger of
  0:
   begin
    <ul>
    <li><a href="?x=1">import...</a></li>
    <li><a href="?x=2">export...</a></li>
    </ul>
    <p><a href=".">back</a></p>
   end;
  1://import
   begin
    <form method="post" action="?" enctype="multipart/form-data">
    <input type="hidden" name="x" value="3" />
    <dl>
    <dt>OPML file:</dt>
    <dd><input type="file" name="f" /></dd>
    <dt>Prefix categories with:</dt>
    <dd><input type="text" name="c" /></dd>
    </dl>
    <p><input type="submit" value=" Upload " /></p>
    </form>
    <p><a href="?">back</a></p>
   end;
  2://export
   begin
    <<p><a href="OPML1.xxm">Click here do download your personal "subscriptions.opml"...</a></p>
    <form method="post" action="OPML1.xxm">
    <input type="hidden" name="x" value="1" />
    <dl>
    <dt>subscriptions</dt>
    <dd>>
    qr:=TQueryResult.Create(Session.Connection,
      'select S.*, F.name, F.url'+
      ' from "Subscription" S'+
      ' inner join "Feed" F on F.id=S.feed_id'+
      ' where S.user_id=$1'+
      ' order by lower(S.category), lower(S.label), lower(F.name), S.id',[Session.UserID]);
    try
      c:='';
      cn:=0;
      while qr.Read do
       begin
        c1:=qr.GetStr('category');
        if c<>c1 then
         begin
          inc(cn);
          <<br /><div class="catlink"><a href="#t-[[=c1]]" onclick="return ct([[=cn]]);">>=c1<</a></div>>
          c:=c1;
         end;
        ]]
        <label style="white-space:nowrap;"><input type="checkbox" name="s[[.id]]" value="1" xc="[[=cn]]" />&nbsp;[[#StringReplace(
          ShowLabel(qr.GetStr('label'),qr.GetStr('color'),''),
          '<div ','<div title="'+HTMLEncode(qr.GetStr('name'))+'" ',[])<</label>>
       end;
    finally
      qr.Free;
    end;
    <</dd>
    </dl>
    <p><input type="submit" value="Export OPML of selected subscriptions..." /></p>
    </form>
    <script>
    function ct(n){
      var e=document.forms[0].elements;
      for(var i=0;i<e.length;i++){
        var f=e[i];
        if(f.attributes["xc"]&&f.attributes["xc"].value==n)f.checked=!f.checked;
      }
      return false;
    }
    </script>
    <p><a href="Feeds.xxm">back</a></p>>
   end;
  3://import upload
   begin
    <form method="post" action="?">
    <input type="hidden" name="x" value="4" />
    db:=Session.Connection;
    m:=TStreamAdapter.Create(TMemoryStream.Create,soOwned);
    try
      (m as IUnknown)._AddRef;
      (Context['f'] as IxxmParameterPostFile).SaveToStream(m);
      m.Stream.Position:=0;
      d:=CoDOMDocument60.Create;
      d.async:=false;
      d.validateOnParse:=false;
      d.resolveExternals:=false;
      if not d.load(m as IStream) then
        raise Exception.Create(d.parseError.reason);

      d.setProperty('SelectionNamespaces','xmlns:opml=''http://opml.org/spec2'' xmlns:f=''http://yoy.be/schema/2018/feeder_subs''');
      
      DoOutlines(d.documentElement.selectNodes('body/outline'),Context['c'].Value);
      DoOutlines(d.documentElement.selectNodes('opml:body/opml:outline'),Context['c'].Value);

    finally
      d:=nil;
      db:=nil;
      //m.Free;
      (m as IUnknown)._Release;
    end;
    <p><input type="submit" value=" Add " /></p>
    </form>
    <p><a href="?">back</a></p>
   end;
  4://import selected
   begin
    //TODO

    db:=Session.Connection;
    db.BeginTrans;
    try

      p:=Context['f'];
      while p<>nil do
       begin
        id:=0;//default
        id1:=0;//default
        rw:=0;//default
        pn:=p.Value;
        l:=Length(pn);
        i:=2;//assert pn[1]='?'
        while i<=l do
         begin
          //assert pn[i+1]='='
          j:=i+2;
          while (j<=l) and (pn[j]<>'&') do inc(j);
          u:=URLDecode(AnsiString(Copy(pn,i+2,j-i-2)));
          case pn[i] of
            'l':s:=u;
            'f':id:=StrToInt(u);
            't':t:=u;
            'c':feedcolor:=u;
            'x':g:=u;
            'w':rw:=StrToInt(u);
            'u':if u='' then ur:=Null else ur:=StrToInt(u);
            else raise Exception.Create('Unexpected parameter "'+pn[i]+'"');
          end;
          i:=j+1;
         end;
        <<p>>=s<</p>>
        Context.Flush;

        if id=0 then
          id:=db.Insert('Feed',['name',t,'url',s,'created',double(UtcNow)],'id');

        if id1=0 then
         begin
          //add subscription
          db.Insert('Subscription',
            ['user_id',Session.UserID
            ,'feed_id',id
            ,'label',t
            ,'color',feedcolor
            ,'category',g
            ,'readwidth',rw
            ,'autounread',ur
            ,'created',double(UtcNow)
            ],'id');
          //mark recent posts as unread
          db.Execute('insert into "UserPost" (user_id,post_id,subscription_id,pubdate) select $1,P.id,S.id,P.pubdate '
            +' from "Post" P'
            +' inner join "Subscription" S on S.feed_id=P.feed_id and S.user_id=$1'
            +' where P.feed_id=$2 and P.pubDate>$3',
            [Session.UserID,id,double(UtcNow-366.0)]);
         end
        else
         begin
          //update category? (allow duplicates?)
         end;

        p:=p.NextBySameName;
       end;


      db.CommitTrans;
    except
      db.RollbackTrans;
      raise;
    end;

    <p><a href="Feeds.xxm">continue...</a></p>
   end
  //5:
  else
    raise Exception.Create('Unknown action');
end;

Context.Include('dFoot.xxmi');