[Mldonkey-commits] mldonkey distrib/ChangeLog distrib/html_themes/...

[mldonkey-commits]

CVSROOT:        /sources/mldonkey
Module name:    mldonkey
Changes by:     spiralvoice <spiralvoice>       13/07/07 11:03:34

Modified files:
        distrib        : ChangeLog 
        distrib/html_themes/ease: h.css 
        distrib/html_themes/old: h.css 
        src/daemon/common: commonMessages.ml 
        src/daemon/driver: driverCommands.ml 
        src/networks/bittorrent: bTInteractive.ml 
        src/utils/cdk  : list2.ml list2.mli 

Log message:
        patch #8112

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/mldonkey/distrib/ChangeLog?cvsroot=mldonkey&r1=1.1575&r2=1.1576
http://cvs.savannah.gnu.org/viewcvs/mldonkey/distrib/html_themes/ease/h.css?cvsroot=mldonkey&r1=1.1&r2=1.2
http://cvs.savannah.gnu.org/viewcvs/mldonkey/distrib/html_themes/old/h.css?cvsroot=mldonkey&r1=1.1&r2=1.2
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/common/commonMessages.ml?cvsroot=mldonkey&r1=1.77&r2=1.78
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/driver/driverCommands.ml?cvsroot=mldonkey&r1=1.266&r2=1.267
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/bittorrent/bTInteractive.ml?cvsroot=mldonkey&r1=1.168&r2=1.169
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/utils/cdk/list2.ml?cvsroot=mldonkey&r1=1.6&r2=1.7
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/utils/cdk/list2.mli?cvsroot=mldonkey&r1=1.5&r2=1.6

Patches:
Index: distrib/ChangeLog
===================================================================
RCS file: /sources/mldonkey/mldonkey/distrib/ChangeLog,v
retrieving revision 1.1575
retrieving revision 1.1576
diff -u -b -r1.1575 -r1.1576
--- distrib/ChangeLog   7 Jul 2013 11:01:42 -0000       1.1575
+++ distrib/ChangeLog   7 Jul 2013 11:03:33 -0000       1.1576
@@ -15,6 +15,7 @@
 =========
 
 2013/07/07:
+8112: BT/HTML: select/unselect whole directories in BT multifile downloads 
(ygrek)
 8110: http_server: refactor error_page (ygrek)
 8109: FTP: fix CWD (ygrek)
 8108: FTP: fix authentication (ygrek)

Index: distrib/html_themes/ease/h.css
===================================================================
RCS file: /sources/mldonkey/mldonkey/distrib/html_themes/ease/h.css,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -b -r1.1 -r1.2
--- distrib/html_themes/ease/h.css      14 Jan 2004 20:43:57 -0000      1.1
+++ distrib/html_themes/ease/h.css      7 Jul 2013 11:03:33 -0000       1.2
@@ -86,7 +86,13 @@
  border: #000 solid 1px;
  border-collapse: collapse;
 }
-table.sourcesInfo, table.serversC { width: 100%; margin-right: auto; 
margin-left: auto; border: 1; border: #000 solid 1px; border-collapse: 
collapse;}
+table.sourcesInfo, table.subfilesInfo, table.serversC {
+  width: 100%;
+  margin-right: auto;
+  margin-left: auto; 
+  border: #000 solid 1px;
+  border-collapse: collapse;
+}
 table.sources {border: 1; border: #000 solid 1px; border-collapse: collapse; }
 table.main { margin-right: auto; margin-left: auto; }
 div.main, div.uploaders, div.friends, div.cs, div.shares, div.upstats, 
div.servers, div.serversC, div.vo,

Index: distrib/html_themes/old/h.css
===================================================================
RCS file: /sources/mldonkey/mldonkey/distrib/html_themes/old/h.css,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -b -r1.1 -r1.2
--- distrib/html_themes/old/h.css       14 Jan 2004 20:43:57 -0000      1.1
+++ distrib/html_themes/old/h.css       7 Jul 2013 11:03:33 -0000       1.2
@@ -86,7 +86,13 @@
  border: #000 solid 1px;
  border-collapse: collapse;
 }
-table.sourcesInfo, table.serversC { width: 100%; margin-right: auto; 
margin-left: auto; border: 1; border: #000 solid 1px; border-collapse: 
collapse;}
+table.sourcesInfo, table.subfilesInfo, table.serversC {
+  width: 100%;
+  margin-right: auto;
+  margin-left: auto; 
+  border: #000 solid 1px;
+  border-collapse: collapse;
+}
 table.sources {border: 1; border: #000 solid 1px; border-collapse: collapse; }
 table.main { margin-right: auto; margin-left: auto; }
 div.main, div.uploaders, div.friends, div.cs, div.shares, div.upstats, 
div.servers, div.serversC, div.vo,

Index: src/daemon/common/commonMessages.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonMessages.ml,v
retrieving revision 1.77
retrieving revision 1.78
diff -u -b -r1.77 -r1.78
--- src/daemon/common/commonMessages.ml 24 Jun 2012 08:03:39 -0000      1.77
+++ src/daemon/common/commonMessages.ml 7 Jul 2013 11:03:33 -0000       1.78
@@ -336,7 +336,7 @@
   border: @color_general_border@ solid 1px;
   border-collapse: collapse;
   }
-table.sourcesInfo, table.serversC {
+table.sourcesInfo, table.subfilesInfo, table.serversC {
   width: 100%;
   margin-right: auto;
   margin-left: auto;
@@ -1464,7 +1464,7 @@
 table.uploaders, table.friends, table.bw_stats, table.vo, table.cs, 
table.servers,
 table.shares, table.downloaders, table.scan_temp, table.upstats, 
table.messages,
 table.shares, table.vc, table.results, table.networkInfo { border: 
@color_general_border@; }
-table.sourcesInfo, table.serversC { border: @color_general_border@; }
+table.sourcesInfo, table.subfilesInfo, table.serversC { border: 
@color_general_border@; }
 table.sources { border: @color_general_border@;}
 td.srb { border-right: @color_general_border@; border-bottom: 
@color_general_border@;
 border-left: @color_general_border@; border-top: @color_general_border@; }

Index: src/daemon/driver/driverCommands.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/driver/driverCommands.ml,v
retrieving revision 1.266
retrieving revision 1.267
diff -u -b -r1.266 -r1.267
--- src/daemon/driver/driverCommands.ml 24 Jun 2012 08:09:08 -0000      1.266
+++ src/daemon/driver/driverCommands.ml 7 Jul 2013 11:03:33 -0000       1.267
@@ -3940,7 +3940,8 @@
             let subfileend =
               match q with
               | subfileend :: _ -> int_of_string subfileend
-              | _ -> subfilestart in
+              | [] -> subfilestart
+            in
             let file = file_find filenum in
             let swarmer = CommonSwarming.file_swarmer file in
 (*

Index: src/networks/bittorrent/bTInteractive.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/bittorrent/bTInteractive.ml,v
retrieving revision 1.168
retrieving revision 1.169
diff -u -b -r1.168 -r1.169
--- src/networks/bittorrent/bTInteractive.ml    27 Jul 2012 17:46:38 -0000      
1.168
+++ src/networks/bittorrent/bTInteractive.ml    7 Jul 2013 11:03:34 -0000       
1.169
@@ -17,6 +17,8 @@
     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 *)
 
+open Printf
+
 open Int64ops
 open Options
 open Printf2
@@ -251,37 +253,79 @@
     end;
   List.rev !r
 
+(** @return parent directories of [path] *)
+let parent_dirs path =
+  let rec loop acc path =
+    match Filename.dirname path with
+    | "." -> acc
+    | dir -> loop (dir :: acc) dir
+  in
+  loop [] path
+
+let show_progress f = sprintf "%.0f%%" (100. *. f)
 
 let op_file_print file o =
 
+  (* merge swarming info with file tree *)
   let subfiles =
     let subfiles = ref (get_subfiles file) in
     List.map begin fun (name,size,magic) ->
     let magic = match magic with None -> "" | Some m -> Printf.sprintf " / %s" 
m in
     match !subfiles with
-    | [] -> (name,size,magic,"",None)
+    | [] -> (name,size,magic,0.,None)
     | (i_name,i_size,i_prio,progress)::t ->
 (*
       lprintf_nl "%S = %S %Ld = %Ld | priority %d" name i_name size i_size 
i_prio;
 *)
       subfiles := t;
-      let progress = Printf.sprintf ", %.0f%%" (100. *. progress) in
       if name = i_name && size = i_size then (* sanity check *)
         (name,size,magic,progress,Some i_prio)
       else 
         (name,size,magic,progress,None)
     end file.file_files 
   in
+  let merge_priority acc prio =
+    match acc, prio with
+    | (Some false|None),Some prio when prio > 0 -> Some true
+    | None,Some 0 -> Some false
+    | None,None -> None
+    | acc,_ -> acc
+  in
+  (* calculate subfile ranges covered by directories *)
+  let directories =
+    let h = Hashtbl.create 16 in
+    List2.iteri begin fun i (path,size,_,progress,prio) ->
+      List.iter begin fun dir ->
+        let (i_from,_,acc_size,acc_progress,acc_prio) = try Hashtbl.find h dir 
with Not_found -> (i,i,0L,0.,None) in
+        let new_size = Int64.add acc_size size in
+        let acc_progress =
+          if new_size > 0L then
+            (acc_progress *. Int64.to_float acc_size +. progress *. 
Int64.to_float size) /. Int64.to_float new_size
+          else
+            0.
+        in
+        Hashtbl.replace h dir (i_from,i,new_size,acc_progress,merge_priority 
acc_prio prio)
+      end (parent_dirs path)
+    end subfiles;
+    h
+  in
   let buf = o.conn_buf in
   if use_html_mods o then
   begin
-  let emit text ?(desc=text) value =
+  let emit_tds l =
     Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr 
());
-    html_mods_td buf [ 
+    html_mods_td buf l
+  in
+  let emit text ?(desc=text) value =
+    emit_tds [
       (desc, "sr br", text);
-      ("", "sr", value)
+      ("", "sr", value);
     ]
   in
+  let emit_file text ?(desc=text) ~value ~size ~progress ~extra =
+    let l = List.map (fun v -> "", "sr", v) [value; size_of_int64 size; 
show_progress progress; extra] in
+    emit_tds ((desc, "sr br", text) :: l)
+  in
 
   emit (_s"Filename") file.file_name;
   emit (_s"Hash") ~desc:(_s"Torrent metadata hash") (Sha1.to_hexa 
file.file_id);
@@ -400,33 +444,57 @@
   end;
   (* -- End bad -- *)
 
-  let extra =
-    match List.fold_left (fun acc subfile ->
-      match acc, subfile with
-      | (Some false|None),(_,_,_,_,Some prio) when prio > 0 -> Some true
-      | None,(_,_,_,_,Some 0) -> Some false
-      | None,(_,_,_,_,None) -> None
-      | acc,_ -> acc) None subfiles
-    with
+  (* this will reload the page because we must toggle multiple select/unselect 
states,
+     TODO javascript toggle_priority function should operate on ranges too *)
+  let toggle_priority ?(all=false) i_from i_to = function
     | None -> ""
     | Some dl ->
-      Printf.sprintf ", \\<a title=\\\"toggle all files\\\" 
href=\\\"submit?q=set_subfile_prio+%d+%d+%d+%d\\\"\\>%s\\</a\\>"
-        (file_num file) (if dl then 0 else 1) 0 (List.length subfiles - 1)
-        (if dl then "unselect all" else "select all")
+    let all = if all then " all" else "" in
+    Printf.sprintf ", \\<a title=\\\"toggle%s files\\\" 
href=\\\"submit?q=set_subfile_prio+%d+%d+%d+%d\\\"\\>%s%s\\</a\\>"
+      all (file_num file) (if dl then 0 else 1) i_from i_to
+      (if dl then "unselect" else "select") all
+  in
+
+  let extra =
+    let root_priority = List.fold_left merge_priority None (List.map (fun 
(_,_,_,_,prio) -> prio) subfiles) in
+    toggle_priority ~all:true 0 (List.length subfiles - 1) root_priority
   in
   emit (_s"Full path"^extra) ~desc:(_s"Full path to the download") 
(file_disk_name file);
 
-  let cntr = ref 0 in
-  List.iter (fun (filename, size, magic, progress, prio) ->
-    Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr 
());
-    let fs = Printf.sprintf (_b"File %d") !cntr in
-    let extra = match prio with
+  if subfiles <> [] then
+  begin
+    Printf.bprintf buf "\\</tr\\>\\</table\\>\\</div\\>\\<br\\>";
+
+    let header_list = [
+      ( Str, "srh br", "File", "File" ) ;
+      ( Str, "srh", "Path", "Path" ) ;
+      ( Num, "srh", "Size", "Size" ) ;
+      ( Num, "srh", "Download progress", "%" ) ;
+      ( Str, "srh", "Additional information", "Details" ) ;
+    ] in
+    html_mods_table_header buf "subfilesInfo" "subfilesInfo" header_list;
+  end;
+
+  List2.iteri begin fun cntr (filename, size, magic, progress, prio) ->
+
+    (* check whether it is new directory *)
+    List.iter begin fun dir ->
+      match try Some (Hashtbl.find directories dir) with Not_found -> None with
+      | None -> ()
+      | Some (i_from,i_to,size,progress,prio) ->
+        Hashtbl.remove directories dir; (* output each dir once *)
+        let desc = "Directory" in
+        let cmd = toggle_priority i_from i_to prio in
+        emit_file (desc ^ cmd) ~desc ~value:dir ~size ~progress 
~extra:(sprintf "%d files" (i_to - i_from + 1));
+    end (parent_dirs filename);
+
+    let desc = Printf.sprintf (_b"File %d") cntr in
+    let cmd = match prio with
       | None -> ""
-      | Some prio -> Printf.sprintf ", \\<a title=\\\"toggle file\\\" 
href=\\\"javascript:void(0)\\\" 
onclick=\\\"xhr_get('submit?api=set_subfile_prio+%d+%d+%d',toggle_priority(this,%d,%d))\\\"\\>priority
 %d\\</a\\>" (file_num file) (if prio = 0 then 1 else 0) !cntr (file_num file) 
!cntr prio
+      | Some prio -> Printf.sprintf ", \\<a title=\\\"toggle file\\\" 
href=\\\"javascript:void(0)\\\" 
onclick=\\\"xhr_get('submit?api=set_subfile_prio+%d+%d+%d',toggle_priority(this,%d,%d))\\\"\\>priority
 %d\\</a\\>" (file_num file) (if prio = 0 then 1 else 0) cntr (file_num file) 
cntr prio
     in
-    emit (fs^extra) ~desc:fs (Printf.sprintf "%s (%Ld bytes%s)%s" filename 
size progress magic);
-    incr cntr;
-  ) subfiles 
+    emit_file (desc ^ cmd) ~desc ~value:(Filename.basename filename) ~size 
~progress ~extra:magic;
+  end subfiles
   end (* use_html_mods *)
   else begin
 
@@ -454,7 +522,7 @@
   List.iter (fun (filename, size, magic, progress, prio) ->
     incr cntr;
     let prio = match prio with Some n -> Printf.sprintf ", priority %d" n | 
None -> "" in
-    Printf.bprintf buf "File %d%s: %s (%Ld bytes%s)%s\n" !cntr prio filename 
size progress magic
+    Printf.bprintf buf "File %d%s: %s (%s, %s)%s\n" !cntr prio filename 
(size_of_int64 size) (show_progress progress) magic
   ) subfiles
   end
 

Index: src/utils/cdk/list2.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/utils/cdk/list2.ml,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -b -r1.6 -r1.7
--- src/utils/cdk/list2.ml      23 Jan 2011 15:20:35 -0000      1.6
+++ src/utils/cdk/list2.ml      7 Jul 2013 11:03:34 -0000       1.7
@@ -114,3 +114,9 @@
 let filter_map f =
   List.fold_left (fun acc x -> match f x with Some y -> y :: acc | None -> 
acc) []
 
+let iteri f l =
+  let rec loop i = function
+  | [] -> ()
+  | x::xs -> f i x; loop (i+1) xs
+       in
+       loop 0 l

Index: src/utils/cdk/list2.mli
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/utils/cdk/list2.mli,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -b -r1.5 -r1.6
--- src/utils/cdk/list2.mli     18 Jul 2010 10:59:20 -0000      1.5
+++ src/utils/cdk/list2.mli     7 Jul 2013 11:03:34 -0000       1.6
@@ -49,3 +49,5 @@
 (** [filter_map f l] *)
 val filter_map : ('a -> 'b option) -> 'a list -> 'b list
 
+(** [iteri f l] call [f] on each element of [l] with the corresponding index, 
starting from zero *)
+val iteri : (int -> 'a -> unit) -> 'a list -> unit