/[mldonkey]/mldonkey/src/networks/fileTP/fileTPComplexOptions.ml
ViewVC logotype

Diff of /mldonkey/src/networks/fileTP/fileTPComplexOptions.ml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.10 by spiralvoice, Sun Jul 17 16:11:13 2005 UTC revision 1.11 by spiralvoice, Tue Jul 26 23:16:48 2005 UTC
# Line 22  open Printf2 Line 22  open Printf2
22  open Md4  open Md4
23  open Options  open Options
24  open BasicSocket  open BasicSocket
25      
26  open CommonDownloads  open CommonDownloads
27  open CommonTypes  open CommonTypes
28  open CommonFile  open CommonFile
# Line 32  open FileTPOptions Line 32  open FileTPOptions
32  open FileTPGlobals  open FileTPGlobals
33    
34  module ClientOption = struct  module ClientOption = struct
35        
36      let value_to_client v =      let value_to_client v =
37        match v with        match v with
38        | Module assocs ->        | Module assocs ->
39              
40            let get_value name conv = conv (List.assoc name assocs) in            let get_value name conv = conv (List.assoc name assocs) in
41            let get_value_nil name conv =            let get_value_nil name conv =
42              try conv (List.assoc name assocs) with _ -> []              try conv (List.assoc name assocs) with _ -> []
43            in            in
44            let client_hostname = get_value "client_hostname" value_to_string in            let client_hostname = get_value "client_hostname" value_to_string in
# Line 50  module ClientOption = struct Line 50  module ClientOption = struct
50    
51  (*  (*
52            (try            (try
53                c.client_user.user_speed <- get_value "client_speed" value_to_int                c.client_user.user_speed <- get_value "client_speed" value_to_int
54              with _ -> ());              with _ -> ());
55              
56            (try            (try
57                if get_value "client_push" value_to_bool then                if get_value "client_push" value_to_bool then
58                  c.client_user.user_kind <- Indirect_location ("", client_uid)                  c.client_user.user_kind <- Indirect_location ("", client_uid)
# Line 60  with _ -> ()); Line 60  with _ -> ());
60    *)    *)
61            c            c
62        | _ -> failwith "Options: Not a client"        | _ -> failwith "Options: Not a client"
63        
       
64      let client_to_value c =      let client_to_value c =
65        Options.Module [        Options.Module [
66          "client_hostname", string_to_value c.client_hostname;          "client_hostname", string_to_value c.client_hostname;
# Line 72  with _ -> ()); Line 71  with _ -> ());
71  "client_push", bool_to_value false;  "client_push", bool_to_value false;
72    *)    *)
73        ]        ]
74          
75      let t =      let t =
76        define_option_class "Client" value_to_client client_to_value        define_option_class "Client" value_to_client client_to_value
77      
78    end    end
79    
80  let value_to_int32pair v =  let value_to_int32pair v =
81    match v with    match v with
82      List [v1;v2] | SmallList [v1;v2] ->      List [v1;v2] | SmallList [v1;v2] ->
83        (value_to_int64 v1, value_to_int64 v2)        (value_to_int64 v1, value_to_int64 v2)
84    | _ ->    | _ ->
85        failwith "Options: Not an int32 pair"        failwith "Options: Not an int32 pair"
86    
87  let value_to_file file_size file_state assocs =  let value_to_file file_size file_state assocs =
88    let get_value name conv = conv (List.assoc name assocs) in    let get_value name conv = conv (List.assoc name assocs) in
89    let get_value_nil name conv =    let get_value_nil name conv =
90      try conv (List.assoc name assocs) with _ -> []      try conv (List.assoc name assocs) with _ -> []
91    in    in
92    
93    let file_name = get_value "file_filename" value_to_string in    let file_name = get_value "file_filename" value_to_string in
94    let file_id =    let file_id =
95      try      try
96        Md4.of_string (get_value "file_id" value_to_string)        Md4.of_string (get_value "file_id" value_to_string)
97      with _ -> failwith "Bad file_id"      with _ -> failwith "Bad file_id"
98    in    in
99      
100    let file = new_file file_id file_name file_size in    let file = new_file file_id file_name file_size in
101    
102    (match file.file_swarmer with    (match file.file_swarmer with
# Line 114  let value_to_file file_size file_state a Line 113  let value_to_file file_size file_state a
113                    add_download file s (Url.of_string (value_to_string index))                    add_download file s (Url.of_string (value_to_string index))
114                | _ -> failwith "Bad source"                | _ -> failwith "Bad source"
115            )))            )))
116      with e ->      with e ->
117          lprintf "Exception %s while loading source\n"          lprintf "Exception %s while loading source\n"
118            (Printexc2.to_string e);            (Printexc2.to_string e);
119    );    );
120    as_file file    as_file file
121      
122  let file_to_value file =  let file_to_value file =
123    let assocs =    let assocs =
124      [      [
125  (*      "file_name", string_to_value file.file_name; *)  (*      "file_name", string_to_value file.file_name; *)
126        "file_downloaded", int64_to_value (file_downloaded file);        "file_downloaded", int64_to_value (file_downloaded file);
127        "file_id", string_to_value (Md4.to_string file.file_id);        "file_id", string_to_value (Md4.to_string file.file_id);
128        "file_sources",        "file_sources",
129        list_to_value (fun c ->        list_to_value (fun c ->
130            lprintf "SAVING: find_client...\n";            lprintf "SAVING: find_client...\n";
131            let n = (find_download file c.client_downloads).download_url in            let n = (find_download file c.client_downloads).download_url in
132            lprintf "SAVING: find_client...done...saving\n";            lprintf "SAVING: find_client...done...saving\n";
133            SmallList [ClientOption.client_to_value c;            SmallList [ClientOption.client_to_value c;
134              string_to_value (Url.to_string n)]              string_to_value (Url.to_string n)]
135        ) file.file_clients;        ) file.file_clients;
136      ]      ]
137    in    in
138    match file.file_swarmer with    match file.file_swarmer with
139      None -> assocs      None -> assocs
140    | Some swarmer ->    | Some swarmer ->
141        Int64Swarmer.swarmer_to_value swarmer assocs        Int64Swarmer.swarmer_to_value swarmer assocs
142    
143  let old_files =  let old_files =
144    define_option fileTP_section ["old_urls"]    define_option fileTP_section ["old_urls"]
145      "" (list_option Url.option) []      "" (list_option Url.option) []
146        
147  let save_config () =  let save_config () =
148      
149    let files = !!old_files in    let files = !!old_files in
150    old_files =:= [];    old_files =:= [];
151    List.iter (fun file ->    List.iter (fun file ->
152        if not (List.mem file !!old_files) then        if not (List.mem file !!old_files) then
153          old_files =:= file :: !!old_files          old_files =:= file :: !!old_files
154    ) files;    ) files;
     
155    ()    ()
156      
157  let _ =  let _ =
158    network.op_network_file_of_option <- value_to_file;    network.op_network_file_of_option <- value_to_file;
159    file_ops.op_file_to_option <- file_to_value;    file_ops.op_file_to_option <- file_to_value;

Legend:
Removed from v.1.10  
changed lines
  Added in v.1.11

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26