Scriptwiki - User contributions [en]

COM Tutorial

2015-07-19T23:18:16Z

Aca20031: Adding Stack example, Powershell information (Except i cant upload the pics yet)

mIRC supports interaction with COM through dynamic binding. COM in mIRC is an advanced topic and usually requires knowledge in strongly typed language. Knowledge of C++ is a big plus.

For this tutorial to make sense, you should at a minimum know
* How to use [[Identifiers]] in mIRC
* About identifier properties (e.g. $identifier().prop)
* That the [[noop]] command will execute but not print or take an action
* What objects are in object oriented programming
* Basics of strongly typed languages (e.g. int vs short vs string)

If you aren't sure you know each of these things, turn around and save yourself the time.

==What is COM?==
COM stands for [https://msdn.microsoft.com/en-us/library/windows/desktop/ms680573(v=vs.85).aspx Component Object Model] and the details of this are quite complicated. We will be skipping over too many specifics, but MSDN has more.

To speak generally, COM is a Windows technology for creating and accessing [https://en.wikipedia.org/wiki/Object_(computer_science) Objects] no matter what language. For example, you could create an object with methods and properties in C++ and use it in mIRC.

==Specific Object-Oriented Concepts==

mIRC allows us to create an instance of a class using [[comopen]] and to call methods, get the value of properties, or set the value of properties using [[$com]] and [[$comcall]].

''[[$com]] and [[$comcall]] are basically identical except that [[$comcall]] is asynchronous and will call an [[alias]] (like a callback function) when the call completes.

Where a language such as Java might an infinite number of types (String, Socket, Integer, InputStream, etc) COM has only a handful - albeit a large handful. In COM, every variable is represented as VARIANT. This is a [https://msdn.microsoft.com/en-us/library/windows/desktop/ms221627(v=vs.85).aspx C structure] and it can be used to represent many things. The way this works in C that the "vt" member is set to the type of variable the Variant is to represent, and then the corresponding field is set to the value.

For example, a Variant can represent a byte like this:
VARIANT v; v.vt = VT_BYTE; v.bVal = 4;
Or, it can be changed to a float like this:
v.vt = VT_FLOAT; v.fltVal = 4.0f;

If you are familiar with the common types, you will probably recognize most of them. What you might not recognize is '''dispatch''' and '''unknown''' and these are very important.

Unknown (IUnknown) is a COM specific construct that is beyond the scope of this tutorial. If you need it, you probably know what it is (and if you do, know that you can call QueryService/Release/AddRef through [[$com]] and [[$comcall]] - this is only useful though if you eventually get a '''dispatch''' back (see below))

===Methods===
There are 4 things you can do to a COM object via Dispatches
* Call a method on them
* Get the value of a property they have
* Set the value of a property they have
* Set the value of a property they have to a reference

The third parameter of [[$com]] allows you to pick from one of these 4 things by passing it in either 1 (call a method), 2 (get a property), 4 (put a property) or 8 (put a property reference). We'll see an example of this soon.

===Dispatch===
In COM, a dispatch is how we support complex types. It represents an IDispatch object in C, which is important because it has the Invoke method which lets you call members.

Ok let's back up. You know how Java and C# represent all complex types as "Object" - sort of like a super-class? A String is an Object, an InputStream is an Object, etc? In COM, IDispatch serves a similar function. It represents a COM object what you can call methods or get and set properties on. If you have one, you can pass it as an argument to [[$com]] and [[$comopen]].

''Still lost on what a Dispatch is? It's OK - move on and use the examples to help gain an understanding.

==Programmatic and Class IDs==
In order to get started in COM, you need a [[https://msdn.microsoft.com/en-us/library/dd542719(VS.85).aspx ProgID]]. A ProgID essentially represents the name of a class that supports COM instantiation via dynamic binding (which is what we are doing here).

In C#, you might do this
var nameOfStack = new System.Collections.Stack()

If Stack was exported as a com object with a prog ID (and it is!) you would do this in mIRC
comopen nameOfStack System.Collections.Stack

===Details===
''You can skip this part - it's just some extra info''

Internally, program IDs are mapped to GUIDs in the Registry. For example, check out HKEY_CLASSES_ROOT\System.Collections.Stack\CLSID - this is the Class ID for the Stack class.

If you want to do this same thing in C++, you would use code like the following:
CLSID id;
CLSIDFromProgID(L"System.Collections.Stack", &id);
IDispatch *disp;
CoCreateInstance(id, nullptr, CLSCX_INPROC_SERVER,IID_IDispatch, (LPVOID*)&disp);
==Example 1, titleof==
Enough theory, let's jump in. Here are some things you need to know
* Internet Explorer exports it's [https://msdn.microsoft.com/en-us/library/aa752127(v=vs.85).aspx IWebBrowser2] interface as the progid InternetExplorer.Application
* It has a method called [https://msdn.microsoft.com/en-us/library/aa752093(v=vs.85).aspx Navigate] which takes a string and goes there
* Navigate is asynchronous. It will return as soon as the loading has started.
* It has a property called [https://msdn.microsoft.com/en-us/library/aa752066(v=vs.85).aspx ReadyState]. This is an [https://msdn.microsoft.com/en-us/library/bb268229(v=vs.85).aspx enum which is set to 4 when it is done.]
* It has a property called [https://msdn.microsoft.com/en-us/library/aa752057(v=vs.85).aspx LocationName] This is a String set to the title of the page.

We're going to make an identifier that takes a URL and returns the title of the page. For example:
$titleof(google.com) == Google
$titleof(facebook.com) == Welcome to Facebook - Log In, Sign Up or Learn More

''Disclaimer: Titles may have changed since I wrote this''

We're going to do this by instantiating WebBrowser2, navigating to the URL we are passed, waiting until the page is loaded, then returning the location.

alias titleof {
if (!$isid) { return }

; Instantiate the class
.comopen titleof InternetExplorer.Application

; Call Navigate. Pass it one parameter of type bstr (string) - the URL we were passed. 1 = DISPATCH_METHOD because we are calling a method
noop $com(titleof, Navigate, 1, bstr, $1-)

; [[$com]](<dispatch>).result returns the value the last call returned. Loop until it is 4 ([https://msdn.microsoft.com/en-us/library/bb268229(v=vs.85).aspx READYSTATE_COMPLETE])
while ($com(titleof).result != 4) {
; Get (2 = DISPATCH_PROPERTYGET) the value of the ReadyState property
noop $com(titleof, ReadyState, 2)
; Now we'll loop again and check the value to see if it was 4 or not.
}

; Get the value of the LocationName property
noop $com(titleof, LocationName, 2)

; Save it so we can cleanup
var %value = $com(titleof).result

; Quit closes InternetExplorer's background tasks
noop $com(titleof, Quit, 1)

; Close the COM object to tidy up
.comclose titleof

; Return what we saved
return %value
}

==Example 2: Using the managed stack==
Now let's use [[https://msdn.microsoft.com/en-us/library/system.collections.stack(v=vs.110).aspx System.Collections.Stack]]

alias stacktest {
;Instantiate it
.comopen stack System.Collections.Stack
; Call push, push "First" onto the stack
noop $com(stack, Push, 1, bstr, First)
echo -atg Pushed "First" onto the stack
; Call Push, push "Second onto the stack"
noop $com(stack, Push, 1, bstr, Second)
echo -atg Pushed "Second" onto the stack

; See how many elements are in the stack
noop $com(stack, Count, 2)
echo -atg There are now $com(stack).result elements in the stack

; Pop off the first item
noop $com(stack, pop, 1)
echo -atg Pop: $com(stack).result
noop $com(stack, Count, 2)
echo -atg There are now $com(stack).result elements in the stack

; Clean it up
.comclose stack
}

==Powershell Help==
PowerShell is a program which shipped with Windows since Windows 7, and it provides some cool ways to test and view these COM objects before doing them in mIRC. Try out the following
```TODO: Picture for powershell-stack.PNG```

And use the get-members (GM) pipe to list what all your COM objects can do. This can give you a good idea of what you can do from mIRC and it's a bit easier to debug and test.
```TODO: Picture for stack-gm.PNG```

''This page not yet completed...Sorry!''

[[Category:COM Objects]]
[[Category:Tutorials]]

COM Tutorial

2015-07-19T22:58:01Z

Aca20031: Broke code formatting there...

mIRC supports interaction with COM through dynamic binding. COM in mIRC is an advanced topic and usually requires knowledge in strongly typed language. Knowledge of C++ is a big plus.

For this tutorial to make sense, you should at a minimum know
* How to use [[Identifiers]] in mIRC
* About identifier properties (e.g. $identifier().prop)
* That the [[noop]] command will execute but not print or take an action
* What objects are in object oriented programming
* Basics of strongly typed languages (e.g. int vs short vs string)

If you aren't sure you know each of these things, turn around and save yourself the time.

==What is COM?==
COM stands for [https://msdn.microsoft.com/en-us/library/windows/desktop/ms680573(v=vs.85).aspx Component Object Model] and the details of this are quite complicated. We will be skipping over too many specifics, but MSDN has more.

To speak generally, COM is a Windows technology for creating and accessing [https://en.wikipedia.org/wiki/Object_(computer_science) Objects] no matter what language. For example, you could create an object with methods and properties in C++ and use it in mIRC.

==Specific Object-Oriented Concepts==

mIRC allows us to create an instance of a class using [[comopen]] and to call methods, get the value of properties, or set the value of properties using [[$com]] and [[$comcall]].

''[[$com]] and [[$comcall]] are basically identical except that [[$comcall]] is asynchronous and will call an [[alias]] (like a callback function) when the call completes.

Where a language such as Java might an infinite number of types (String, Socket, Integer, InputStream, etc) COM has only a handful - albeit a large handful. In COM, every variable is represented as VARIANT. This is a [https://msdn.microsoft.com/en-us/library/windows/desktop/ms221627(v=vs.85).aspx C structure] and it can be used to represent many things. The way this works in C that the "vt" member is set to the type of variable the Variant is to represent, and then the corresponding field is set to the value.

For example, a Variant can represent a byte like this:
VARIANT v; v.vt = VT_BYTE; v.bVal = 4;
Or, it can be changed to a float like this:
v.vt = VT_FLOAT; v.fltVal = 4.0f;

If you are familiar with the common types, you will probably recognize most of them. What you might not recognize is '''dispatch''' and '''unknown''' and these are very important.

Unknown (IUnknown) is a COM specific construct that is beyond the scope of this tutorial. If you need it, you probably know what it is (and if you do, know that you can call QueryService/Release/AddRef through [[$com]] and [[$comcall]] - this is only useful though if you eventually get a '''dispatch''' back (see below))

===Methods===
There are 4 things you can do to a COM object via Dispatches
* Call a method on them
* Get the value of a property they have
* Set the value of a property they have
* Set the value of a property they have to a reference

The third parameter of [[$com]] allows you to pick from one of these 4 things by passing it in either 1 (call a method), 2 (get a property), 4 (put a property) or 8 (put a property reference). We'll see an example of this soon.

===Dispatch===
In COM, a dispatch is how we support complex types. It represents an IDispatch object in C, which is important because it has the Invoke method which lets you call members.

Ok let's back up. You know how Java and C# represent all complex types as "Object" - sort of like a super-class? A String is an Object, an InputStream is an Object, etc? In COM, IDispatch serves a similar function. It represents a COM object what you can call methods or get and set properties on. If you have one, you can pass it as an argument to [[$com]] and [[$comopen]].

''Still lost on what a Dispatch is? It's OK - move on and use the examples to help gain an understanding.

==Programmatic and Class IDs==
In order to get started in COM, you need a [[https://msdn.microsoft.com/en-us/library/dd542719(VS.85).aspx ProgID]]. A ProgID essentially represents the name of a class that supports COM instantiation via dynamic binding (which is what we are doing here).

In C#, you might do this
var nameOfStack = new System.Collections.Stack()

If Stack was exported as a com object with a prog ID (and it is!) you would do this in mIRC
comopen nameOfStack System.Collections.Stack

===Details===
''You can skip this part - it's just some extra info''

Internally, program IDs are mapped to GUIDs in the Registry. For example, check out HKEY_CLASSES_ROOT\System.Collections.Stack\CLSID - this is the Class ID for the Stack class.

If you want to do this same thing in C++, you would use code like the following:
CLSID id;
CLSIDFromProgID(L"System.Collections.Stack", &id);
IDispatch *disp;
CoCreateInstance(id, nullptr, CLSCX_INPROC_SERVER,IID_IDispatch, (LPVOID*)&disp);
==Example 1, titleof==
Enough theory, let's jump in. Here are some things you need to know
* Internet Explorer exports it's [https://msdn.microsoft.com/en-us/library/aa752127(v=vs.85).aspx IWebBrowser2] interface as the progid InternetExplorer.Application
* It has a method called [https://msdn.microsoft.com/en-us/library/aa752093(v=vs.85).aspx Navigate] which takes a string and goes there
* Navigate is asynchronous. It will return as soon as the loading has started.
* It has a property called [https://msdn.microsoft.com/en-us/library/aa752066(v=vs.85).aspx ReadyState]. This is an [https://msdn.microsoft.com/en-us/library/bb268229(v=vs.85).aspx enum which is set to 4 when it is done.]
* It has a property called [https://msdn.microsoft.com/en-us/library/aa752057(v=vs.85).aspx LocationName] This is a String set to the title of the page.

We're going to make an identifier that takes a URL and returns the title of the page. For example:
$titleof(google.com) == Google
$titleof(facebook.com) == Welcome to Facebook - Log In, Sign Up or Learn More

''Disclaimer: Titles may have changed since I wrote this''

We're going to do this by instantiating WebBrowser2, navigating to the URL we are passed, waiting until the page is loaded, then returning the location.

alias titleof {
if (!$isid) { return }

; Instantiate the class
.comopen titleof InternetExplorer.Application

; Call Navigate. Pass it one parameter of type bstr (string) - the URL we were passed. 1 = DISPATCH_METHOD because we are calling a method
noop $com(titleof, Navigate, 1, bstr, $1-)

; [[$com]](<dispatch>).result returns the value the last call returned. Loop until it is 4 ([https://msdn.microsoft.com/en-us/library/bb268229(v=vs.85).aspx READYSTATE_COMPLETE])
while ($com(titleof).result != 4) {
; Get (2 = DISPATCH_PROPERTYGET) the value of the ReadyState property
noop $com(titleof, ReadyState, 2)
; Now we'll loop again and check the value to see if it was 4 or not.
}

; Get the value of the LocationName property
noop $com(titleof, LocationName, 2)

; Save it so we can cleanup
var %value = $com(titleof).result

; Quit closes InternetExplorer's background tasks
noop $com(titleof, Quit, 1)

; Close the COM object to tidy up
.comclose titleof

; Return what we saved
return %value
}

==Example 2: Using the managed stack==
Now let's use System.Collections.Stack

''This page not yet completed...Sorry!''

[[Category:COM Objects]]
[[Category:Tutorials]]

COM Tutorial

2015-07-19T22:57:08Z

Aca20031: Created page with "mIRC supports interaction with COM through dynamic binding. COM in mIRC is an advanced topic and usually requires knowledge in strongly typed language. Knowledge of C++ is a ..."

mIRC supports interaction with COM through dynamic binding. COM in mIRC is an advanced topic and usually requires knowledge in strongly typed language. Knowledge of C++ is a big plus.

For this tutorial to make sense, you should at a minimum know
* How to use [[Identifiers]] in mIRC
* About identifier properties (e.g. $identifier().prop)
* That the [[noop]] command will execute but not print or take an action
* What objects are in object oriented programming
* Basics of strongly typed languages (e.g. int vs short vs string)

If you aren't sure you know each of these things, turn around and save yourself the time.

==What is COM?==
COM stands for [https://msdn.microsoft.com/en-us/library/windows/desktop/ms680573(v=vs.85).aspx Component Object Model] and the details of this are quite complicated. We will be skipping over too many specifics, but MSDN has more.

To speak generally, COM is a Windows technology for creating and accessing [https://en.wikipedia.org/wiki/Object_(computer_science) Objects] no matter what language. For example, you could create an object with methods and properties in C++ and use it in mIRC.

==Specific Object-Oriented Concepts==

mIRC allows us to create an instance of a class using [[comopen]] and to call methods, get the value of properties, or set the value of properties using [[$com]] and [[$comcall]].

''[[$com]] and [[$comcall]] are basically identical except that [[$comcall]] is asynchronous and will call an [[alias]] (like a callback function) when the call completes.

Where a language such as Java might an infinite number of types (String, Socket, Integer, InputStream, etc) COM has only a handful - albeit a large handful. In COM, every variable is represented as VARIANT. This is a [https://msdn.microsoft.com/en-us/library/windows/desktop/ms221627(v=vs.85).aspx C structure] and it can be used to represent many things. The way this works in C that the "vt" member is set to the type of variable the Variant is to represent, and then the corresponding field is set to the value.

For example, a Variant can represent a byte like this:
VARIANT v; v.vt = VT_BYTE; v.bVal = 4;
Or, it can be changed to a float like this:
v.vt = VT_FLOAT; v.fltVal = 4.0f;

If you are familiar with the common types, you will probably recognize most of them. What you might not recognize is '''dispatch''' and '''unknown''' and these are very important.

Unknown (IUnknown) is a COM specific construct that is beyond the scope of this tutorial. If you need it, you probably know what it is (and if you do, know that you can call QueryService/Release/AddRef through [[$com]] and [[$comcall]] - this is only useful though if you eventually get a '''dispatch''' back (see below))

===Methods===
There are 4 things you can do to a COM object via Dispatches
* Call a method on them
* Get the value of a property they have
* Set the value of a property they have
* Set the value of a property they have to a reference

The third parameter of [[$com]] allows you to pick from one of these 4 things by passing it in either 1 (call a method), 2 (get a property), 4 (put a property) or 8 (put a property reference). We'll see an example of this soon.

===Dispatch===
In COM, a dispatch is how we support complex types. It represents an IDispatch object in C, which is important because it has the Invoke method which lets you call members.

Ok let's back up. You know how Java and C# represent all complex types as "Object" - sort of like a super-class? A String is an Object, an InputStream is an Object, etc? In COM, IDispatch serves a similar function. It represents a COM object what you can call methods or get and set properties on. If you have one, you can pass it as an argument to [[$com]] and [[$comopen]].

''Still lost on what a Dispatch is? It's OK - move on and use the examples to help gain an understanding.

==Programmatic and Class IDs==
In order to get started in COM, you need a [[https://msdn.microsoft.com/en-us/library/dd542719(VS.85).aspx ProgID]]. A ProgID essentially represents the name of a class that supports COM instantiation via dynamic binding (which is what we are doing here).

In C#, you might do this
var nameOfStack = new System.Collections.Stack()

If Stack was exported as a com object with a prog ID (and it is!) you would do this in mIRC
comopen nameOfStack System.Collections.Stack

===Details===
''You can skip this part - it's just some extra info''

Internally, program IDs are mapped to GUIDs in the Registry. For example, check out HKEY_CLASSES_ROOT\System.Collections.Stack\CLSID - this is the Class ID for the Stack class.

If you want to do this same thing in C++, you would use code like the following:
CLSID id;
CLSIDFromProgID(L"System.Collections.Stack", &id);
IDispatch *disp;
CoCreateInstance(id, nullptr, CLSCX_INPROC_SERVER,IID_IDispatch, (LPVOID*)&disp);
==Example 1, titleof==
Enough theory, let's jump in. Here are some things you need to know
* Internet Explorer exports it's [https://msdn.microsoft.com/en-us/library/aa752127(v=vs.85).aspx IWebBrowser2] interface as the progid InternetExplorer.Application
* It has a method called [https://msdn.microsoft.com/en-us/library/aa752093(v=vs.85).aspx Navigate] which takes a string and goes there
* Navigate is asynchronous. It will return as soon as the loading has started.
* It has a property called [https://msdn.microsoft.com/en-us/library/aa752066(v=vs.85).aspx ReadyState]. This is an [https://msdn.microsoft.com/en-us/library/bb268229(v=vs.85).aspx enum which is set to 4 when it is done.]
* It has a property called [https://msdn.microsoft.com/en-us/library/aa752057(v=vs.85).aspx LocationName] This is a String set to the title of the page.

We're going to make an identifier that takes a URL and returns the title of the page. For example:
$titleof(google.com) == Google
$titleof(facebook.com) == Welcome to Facebook - Log In, Sign Up or Learn More

''Disclaimer: Titles may have changed since I wrote this''

We're going to do this by instantiating WebBrowser2, navigating to the URL we are passed, waiting until the page is loaded, then returning the location.

alias titleof {
if (!$isid) { return }

; Instantiate the class
.comopen titleof InternetExplorer.Application

; Call Navigate. Pass it one parameter of type bstr (string) - the URL we were passed. 1 = DISPATCH_METHOD because we are calling a method
noop $com(titleof, Navigate, 1, bstr, $1-)

; [[$com]](<dispatch>).result returns the value the last call returned. Loop until it is 4 ([https://msdn.microsoft.com/en-us/library/bb268229(v=vs.85).aspx READYSTATE_COMPLETE])
while ($com(titleof).result != 4) {
; Get (2 = DISPATCH_PROPERTYGET) the value of the ReadyState property
noop $com(titleof, ReadyState, 2)
; Now we'll loop again and check the value to see if it was 4 or not.
}

; Get the value of the LocationName property
noop $com(titleof, LocationName, 2)

; Save it so we can cleanup
var %value = $com(titleof).result

; Quit closes InternetExplorer's background tasks
noop $com(titleof, Quit, 1)

; Close the COM object to tidy up
.comclose titleof

; Return what we saved
return %value
}

==Example 2: Using the managed stack==
Now let's use System.Collections.Stack

''This page not yet completed...Sorry!''

[[Category:COM Objects]]
[[Category:Tutorials]]

MHTTP

2015-06-10T21:02:14Z

Aca20031: Adding known issue about not supporting arrays in POST

Often times you may want to download a web page from the internet using HTTP, but HTTP can be complicated. This script handles most of the basics for you including
* URL Parsing
* SSL
* Cookies
* Sending POST data
* Following redirects
* Handling CHUNKED encoding

Typical usage simply involves using the /http.open, save and close commands to download a file, and creating a signal event to do something with it once it is done.
== Example ==
alias DownloadGooglesLogo {
http.open google https://www.google.com/images/srpr/logo11w.png
http.save -f google logo.png
}
on *:SIGNAL:http: {
if ($1 == google) {
if ($2 == SAVED) { run $3- | http.close $1 }
if ($2 == PROGRESS) { echo -atg Download progress: $bytes($3).suf $+ / $+ $bytes($4).suf downloaded }
}
}

== Script ==
; Ben's (ben@st0rm.net) HTTP for mIRC script (mHTTP)
; Used to download over HTTP
; Basic usage
; /http.open [name] <URL>
; Opens an HTTP handle for the given URL
; /http.save [-f] <name> <file|bvar>
; Downloads a given HTTP resource to the given file or binvar
; -f forces the file to be overwritten
; /http.close <name>
; Closes and HTTP handle for the given URL
;
; Here are some things you can do after opening a handle, but before saving it
; Manage POST data:
; /http.addpost <handle> <variable> <value>
; /http.delpost <handle> <variable>
; Manage cookies
; /http.addcookie <handle> <value>
; $http.cookie(handle,N) - gets Nth cookie
;
; After a request completes (e.g. after a save) you can get some data:
; $http.responseheader(handle, header, N) - Returns value of given responseheader, or $false. Only useful after a request is made
;
; You can mark a socket with data of your choice (it's a transparent write to a hashtable) similar to sockmark
; /http.mark <handle> [data] - Writes the data. Specify no data to delete the mark
; $http.mark(handle) - Reads the data
;
; Signals
; In order to tell via script when something happens (your file is being saved, for example) use
; on *:SIGNAL:http:
; where $1 = Handle name, $2 = Event name, $3- = parameters
; Events:
; COMPLETED <statuscode> - when a request completes
; SAVED <location> - when a save completes
; REDIRECT <location> - when a request is redirected elsewhere
; PROGRESS <bytes> [total size] - When part but not all of the data is downloaded. Total size is not available for chunked transfer
;
;
; Known issues:
; POSTing arrays is not currently supported
; Cookies do not respect attributes such as domain, path, expiration, or secure. They are always sent
; Relative redirects don't work, only absolute
; Redirects from insecure to secure links when you don't have SSL will not be handled well
; Creates a request that when completed is saved to a file
alias http.save {
if ($1 == -f) {
var %force = $true
tokenize 32 $2-
}
else { var %force = $false }
if ($0 < 2) {
echo -atg * /http.save: Use /http.save <http handle> <file>
return
}
var %hashtable = http. $+ $1
if (!$hget(%hashtable)) {
echo -atg * /http.save: No such HTTP handle exists. Use /http.open first
return
}
if ($sock(%hashtable)) {
echo -atg * /http.save: There is a pending request for this HTTP handle already. A connection is open the the remote host. Close it, or wait for it to complete
return
}
var %destination = $2-
if ($exists(%destination)) {
if (%force) {
.remove %destination
}
else {
echo -atg * /http.save: File already exists. Try /http.save -f to force an overwrite
return
}
}
if (&* iswm %destination) {
.hadd %hashtable bvarout %destination
}
else {
; Open file handler stream for writing
.fopen -n %hashtable %destination
if ($ferr) {
echo -atg * /http.save: Could not use file. Error: $ferr
return
}
; Store fstream name in hashtable to indicate that we want to save this once it completes
.hadd %hashtable fstream %hashtable
}
; Set redirect counter to 0
.hadd %hashtable redirects 0
; Start socket
http.sockstart %hashtable
}
alias http.mark {
var %hashtable = http. $+ $1
if ($isid) {
; As an identifier, read the mark
return $hget(%hashtable,mark)
}
else {
; As a command, set the mark
if (!$hget(%hashtable)) {
echo -atg * /http.mark - No such handle $1
}
elseif (!$2) {
.hdel %hashtable mark
}
else {
.hadd %hashtable mark $2-
}
}
}
; Opens socket
alias -l http.sockstart {
if ($hget($1,secure) == $true) {
if ($sock($1) && $sock($1).ssl) {
http.sendrequest $1
}
else {
if ($sock($1)) { .sockclose $1 }
if (!$sslready) {
echo -atg HTTP Error - request $qt($right($1,-5)) would require you to use SSL but you are not SSL ready. Please see http://mirc.com/ssl.html
http.close $right($1,-5)
return
}
sockopen -e $1 $hget($1, host) $hget($1, port)
}
}
else {
if ($sock($1)) {
http.sendrequest $1
}
else {
sockopen $1 $hget($1, host) $hget($1, port)
}
}
}
; Sends the request. Assumes the socket is open and ready
alias -l http.sendrequest {
if (!$sock($1)) { echo -atg HTTP Internal error. Socket not open in /http.sendrequest | return }
var %inname = $1
var %exname = $right($1,-5)
; Cleanup from previous requests
.hdel %inname responseheaders
.hdel %inname body
.hdel %inname contentlength
.hdel %inname chunkleft
; Get POST binvar
var %postBV = $http.postdata(%exname)
; Use GET if there's no post data, POST otherwise
if ($bvar(%postBV,0) == 0) {
sockwrite -n %inname GET $hget(%inname,path) HTTP/1.1
}
else {
sockwrite -n %inname POST $hget(%inname,path) HTTP/1.1
}
; Send the host
sockwrite -n %inname Host: $hget(%inname,host)
; Send the user-agent
sockwrite -n %inname User-agent: $hget(%inname,user-agent)
sockwrite -n %inname Connection: Keep-Alive
; Only plain-text supported
sockwrite -n %inname Accept: text/plain; q=0.5, text/html
; Send cookies
if ($http.cookie(%exname, 0) > 0) {
sockwrite %inname Cookie: $+ $chr(32)
var %i = 1
while ($http.cookie(%exname, %i)) {
sockwrite %inname $http.urlencode($ifmatch) $+ ;
inc %i
}
sockwrite -n %inname
}
; If POST send content type and length
if ($bvar(%postBV,0) > 0) {
sockwrite -n %inname Content-Type: application/x-www-form-urlencoded
sockwrite -n %inname Content-Length: $v1
}
; End request headers with empty line
sockwrite -n %inname
; If POST, send data
if ($bvar(%postBV,0) > 0) {
sockwrite %inname %postBV
; sockwrite -n %inname
}
}
; Just some bookeeping in case we miss it
on *:SOCKCLOSE:http.*: {
if ($fopen($sockname)) { .fclose $sockname }
}
on *:SOCKOPEN:http.*: {
http.sendrequest $sockname
}
on *:SOCKREAD:http.*: {
if ($sockerr > 0) {
echo -atg * HTTP handle $qt($right($sockname,-5)) failed with socket error $sockerr
http.close $right($sockname,-5)
return
}
;Read all the data into &bvTemp
:read
; First, read this buffer
sockread &bvThis
if ($sockbr > 0) {
; If data was read, copy it to the on-going buffer and continue
bcopy &bvTemp $calc($bvar(&bvTemp,0) +1) &bvThis 1 -1
goto read
}
if ($bvar(&bvTemp,0) == 0) { echo -atg HTTP sockread called with no data to read... | return }
; Do we need to parse headers?
; If response headers not set, this call has the headers
if (!$hget($sockname,responseheaders)) {
; Find the response headers
var %end = $bfind(&bvTemp,1, 13 10 13 10)
if (%end == 0) { echo -atg Error: No headers found, but no content length so this can't be a subsequent call | return }
; Increase to include the 3 extra characters
inc %end 3
bcopy &bvResponseHeaders 1 &bvTemp 1 %end
; If there's still non-header data copy it over
if (%end < $bvar(&bvTemp, 0)) {
bcopy -c &bvTemp 1 &bvTemp $calc(%end + 1) -1
}
else { bunset &bvTemp }
; If this is the first header response, save in hash table
if (!$hget($sockname, responseheaders)) {
.hadd -b $sockname responseheaders &bvResponseHeaders
http.OnHeaders $sockname
}
}
; there's no more to read, bail
if (!$bvar(&bvTemp,0)) {
; If that's all this response has to offer, we're done
if ($hget($sockname,contentlength) == 0) {
http.ondone $sockname
}
return
}
; Read body
var %contentlength = $hget($sockname,contentlength)
if (%contentlength == $null || %contentlength == $false) {
var %chunked = $true
}
else {
var %chunked = $false
}
; Set bvBody to the body ready so far
if ($hget($sockname,body)) {
noop $hget($sockname, body, &bvBody)
}
if (%chunked) {
:readChunk
var %chunkleft = $hget($sockname, chunkleft)
if (!%chunkleft) {
; If we've read all of a chunk, or this is the first one, get its size
var %crlf = $bfind(&bvTemp, 1, 13 10)
if (!%crlf) {
echo -atg HTTP internal error. Handle $qt($right($sockname,-5)) is in chunked encoding but no chunk size found in data
return
}
var %chunkleft = $base($bvar(&bvTemp, 1, $calc(%crlf - 1)).text,16,10)
if (%chunkleft !isnum) {
echo -atg HTTP internal error. Handle $qt($right($sockname,-5)) has invalid chunk size: %chunkleft
}
; New chunk
else {
; Save chunk size and remove it (plus its \r\n) from temp
.hadd $sockname chunkleft %chunkleft
.bcopy -c &bvTemp 1 &bvTemp $calc(%crlf +2) -1
if (%chunkLeft == 0) {
; if we just read chunk size 0, that was the end.
.hadd -b $sockname body &bvBody
http.onDone $sockname
return
}
}
}
; read %chunkleft bytes
var %bytesToRead = $iif(%chunkLeft < $bvar(&bvTemp,0),%chunkLeft, $bvar(&bvTemp,0))
.bcopy &bvBody $calc($bvar(&bvBody,0) +1) &bvTemp 1 %bytesToRead
hdec $sockname chunkleft %bytesToRead
.signal http $right($sockname,-5) PROGRESS %bytesToRead
if (%bytesToRead == %chunkLeft) {
; If this is the end of the chunk, consume crlf
inc %bytesToRead 2
; If there's still stuff in this var, go back and read the new chunk
if (%bytesToRead < $bvar(&bvTemp,0)) {
.bcopy -c &bvTemp 1 &bvTemp $calc(%bytesToRead + 1) -1
goto readChunk
}
}
; End of this call, save body in hashtable for future calls
.hadd -b $sockname body &bvBody
}
else {
; Copy everything
.bcopy &bvBody $calc($bvar(&bvBody,0) +1) &bvTemp 1 -1
; Add read-so-far body to hashtable
.hadd -b $sockname body &bvBody
.signal http $right($sockname,-5) PROGRESS $bvar(&bvBody,0) $hget($sockname,contentlength)
; Check if we're done
if ($bvar(&bvBody,0) >= $hget($sockname,contentlength)) {
; We're done
http.onDone $sockname
if ($bvar(&bvBody,0) > $hget($sockname,contentlength)) {
echo -qatg HTTP Warning: Read past content-length.
}
}
}
}
; Internal event called when we get the first header response from the server
alias -l http.OnHeaders {
noop $hget($1,responseheaders, &bvResponseHeaders)
; First header is always the status response
var %end = $bfind(&bvResponseHeaders, 1, 13 10)
if (%end <= 1) {
echo -atg Error: HTTP $qt($right($1,-5)) Server did not respond with HTTP status
goto cleanup
}
var %status = $bvar(&bvResponseHeaders,1,$calc(%end - 1)).text
.hadd $1 responsestatus %status
var %version = $gettok(%status,1,32)
if (%version != HTTP/1.1 && %version != HTTP/1.0) {
echo -atg Error: HTTP $qt($right($1,-5)) Server indicated unknown version: %version
goto cleanup
}
var %statuscode = $gettok(%status,2,32)
if (%statuscode !isnum) {
echo -atg Error: HTTP $qt($right($1,-5)) Server indicated invalid status code: %statuscode
goto cleanup
}
; Check transfer type
if ($http.responseheader($right($1,-5),Content-Length,1) != $null) {
hadd $1 contentlength $v1
}
elseif ($http.responseheader($right($1,-5), Transfer-Encoding, 1) != chunked) {
echo -atg HTTP Handle $qt($right($1,-5)) has no content-length header and is not chunked
echo -atg $bvar(&bvResponseHeaders,1-).text
return
}
; Add any cookies that were set
var %cookie = 1
while ($http.responseheader($right($1,-5), Set-Cookie, %cookie)) {
inc %cookie
var %cookieValue = $gettok($ifmatch,1,$asc(;))
http.addcookie $right($1,-5) %cookieValue
}
; Handle redirects
if (%statuscode == 303 || %statuscode == 302 || %statuscode == 307) {
var %location = $http.responseheader($right($1,-5), Location)
.signal http $right($1,-5) REDIRECT %location
http.seturl $1 %location
hinc $1 redirects
; If the server doesn't promise us this connection is keep-alive, close it and use a new one
if ($http.responseheader($right($1,-5), Connection, 1) != Keep-Alive) {
if ($sock($1)) { .sockclose $1 }
}
if ($hget($1, redirects) > 5) {
echo -atg HTTP Handle $qt($right($1,-5)) redirect loop detected
return
}
http.sockstart $1
}
return
:cleanup
if ($sock($1)) { .sockclose $1 }
}
alias http.addcookie {
var %hashtable = http. $+ $1
if (!$hget(%hashtable)) {
echo -atg * /http.addcookie: No such HTTP handle
return
}
if ($0 < 2) {
echo -atg * /http.addcookie: Usage: /http.addcookie <handle> <value>
return
}
var %i = 1
var %cookieNum = 1
while ($hget(%hashtable,%i).item) {
var %item = $ifmatch
inc %i
if (cookie-* iswm %item) {
var %tmp = $gettok(%item,2,$asc(-))
; If the value is the same, overwrite
if ($2- == $hget(%hashtable,%item)) {
%cookieNum = %tmp
break
}
; Otherwise store max cookie num
elseif (%tmp >= %cookieNum) { %cookieNum = $calc(%tmp + 1) }
}
}
.hadd %hashtable cookie- $+ %cookieNum $+ -value $2-
}
; Gets an HTTP cookie for the given handle
; $http.cookie(<handle>, <index>)
alias http.cookie {
if ($2 !isnum) {
echo -atg * $!http.cookie invalid parameters
return
}
var %hashtable = http. $+ $1
if (!$hget(%hashtable)) {
echo -atg * $!http.cookie no such HTTP handle
return
}
var %i = 1
var %found = 0
while ($hget(%hashtable, %i).item) {
inc %i
var %item = $ifmatch
if (cookie-*-value iswm %item) {
inc %found
var %id = $gettok(%item,2,$asc(-))
if (%found == $2) {
return $hget(%hashtable, cookie- $+ %id $+ -value)
}
}
}
if ($2 == 0) { return %found }
}
; Returns the value of the given response header
; Case sensitive since it is binary variable operation
alias http.responseheader {
if ($0 < 2) {
echo -atg Invalid usage. Use: $http.responseheader(<handle>, <header>[, index])
return
}
; %index is parameter 3 - 1-N or 0 for number
var %index = 1
if ($3 isnum) {
%index = $3
}
; Veriy hash table exists
var %table = http. $+ $1
if (!$hget(%table,responseheaders)) { return $false }
noop $hget(%table,responseheaders, &bvResponseHeaders))
; Set up parameters for the header search
; Offset is where we start searching from in the loop
; thisIndex is the number of matches found so far
var %offset = 1
var %thisIndex = 0
; The main search loop
:search
var %start = $bfind(&bvResponseHeaders, %offset, $2 $+ :).text
; If there isn't another match, either the index was too large or they want the count
if (!%start) {
if (%index == 0) { return %thisIndex }
else { return $false }
}
; Find the end of the header
var %end = $bfind(&bvResponseHeaders, %start, 13 10)
if (%end <= %start) { echo -atg HTTP Internal error ($http.responseheader), header $qt($2) for handle $qt($1) has no CRLF termination | return $false }
inc %thisIndex
; If this not the one they asked for, try again starting from the end of this header
if (%index != %thisIndex) {
var %offset = %end
goto search
}
; Find the colon. If there isn't one we'll return the whole string
if ($calc($bfind(&bvResponseHeaders, %start, $asc(:)) +1) < %end) {
%start = $v1
}
return $bvar(&bvResponseHeaders,%start, $calc(%end - %start)).text
}
; Internal event called when a request is filled. $1 = internal handle name
alias -l http.onDone {
if ($hget($1,responseheaders)) {
noop $hget($1,responseheaders,&bvResponseHeaders)
}
; Write out and close filestream if set
if ($hget($1,fstream)) {
noop $hget($1,body,&bvBody)
if (!$bvar(&bvBody,0)) {
.fclose $hget($1,fstream)
}
else {
.fwrite -b $hget($1,fstream) &bvBody
; Save fname so we can use it in the signal after the close
var %fname = $fopen($hget($1,fstream)).fname
.fclose $hget($1,fstream)
.signal http $right($1,-5) SAVED %fname
}
}
; If socket is still around, close it
if ($sock($1)) { .sockclose $1 }
; Reset redirects for future calls
.hadd $1 redirects 0
.signal HTTP $right($1,-5) COMPLETED $hget($1,responsestatus)
if ($hget($1, bvarout)) {
noop $hget($1,body,&bvBody)
var %bvarout = $ifmatch
bcopy %bvarout 1 &bvBody 1 -1
; Need to use -n so that the binvar is still in scope
; So we need to do this last
.signal -n http $right($1,-5) SAVED %bvarout
}
}
alias http.open {
var %hashtable
; If two parameters are given, $1 is the name, else create a new name
if ($0 > 1) { %hashtable = http. $+ $1 }
else {
var %h = $calc($ticks % $rand(1,1000000))
var %hashtable = http. $+ %h
}
if ($hget(%hashtable)) {
echo -atg * /http.open: HTTP Request $qt($1) already exists
return
}
; Encode the octects of the URL. e.g.: foo bar,pie --> foo%20bar,%2Cpie
var %url = $iif($0 > 1, $2-, $1-)
var %urlEncoded = $http.urlencode(%url)
; Check the URL
if (!$http.urlparse(%urlEncoded)) {
echo -atg * /http.open: Malformed URL. Use /http.open [name] <url>
return
}
if ($http.urlparse(%urlEncoded).secure && !$sslready) {
echo -atg * /http.open: URL is SSL but $!sslready = false. See http://www.mirc.com/ssl.html
return
}
; Everything checks out, let's store the relevent bits in a hashtable
.hmake %hashtable 10
http.seturl %hashtable %url
echo -qatg * /http.open: Opened HTTP request $qt($right(%hashtable,-5))
}
alias -l http.seturl {
if ($0 < 2) { echo -atg HTTP Internal error, seturl called with no url }
var %hashtable = $1
if (!$hget(%hashtable)) { echo -atg HTTP Internal error, seturl called with invalid handle }
var %urlEncoded = $http.urlencode($2-)
.hadd %hashtable host $http.urlparse(%urlEncoded).host
.hadd %hashtable port $http.urlparse(%urlEncoded).port
.hadd %hashtable secure $http.urlparse(%urlEncoded).secure
.hadd %hashtable path $http.urlparse(%urlEncoded).path
.hadd %hashtable user-agent mIRC $version
}
alias http.list {
var %i = 1
var %numFound = 0
while (%i <= $hget(0)) {
var %table = $hget(%i)
inc %i
if (http.* iswm %table) {
inc %numFound
echo -atg * $right(%table,-5) $+ : Host: $hget(%table,host) Port: $hget(%table,port) Path: $hget(%table,path)
}
}
if (%numFound == 0) { echo -atg * No HTTP handles opened }
}
alias http.close {
var %i = 1
var %numFound = 0
while (%i <= $hget(0)) {
var %table = $hget(%i)
if (http. $+ $1 iswm %table) {
; Cleanup resources
if ($sock(%table)) { .sockclose %table }
if ($fopen(%table)) { .fclose %table }
if ($hget(%table $+ .postdata)) { .hfree %table $+ .postdata }
.hfree %table
inc %numFound
echo -qatg * HTTP Closed $right(%table,-5)
}
; Only inc if we didnt find a match
else {
inc %i
}
}
if (%numFound == 0) { echo -qatg * No matching HTTP handles }
}
;
; Takes an encoded URL and returns based on the property
; .secure - true if https
; .host - the URL host
; .port - the port, 80 by default
; .path - The path to download, / by default
; Returns $false is URL is malformed
;
alias http.urlparse {
var %secure
var %host
var %port
var %path
var %pathIndex
var %protocol
var %regex = /^(https?://)?([a-z.0-9\-_]+)(:\d+)?(/.*)?$/i
if ($regex($1, %regex)) {
if (http*:// iswm $regml(1)) {
%protocol = $lower($left($regml(1),-3))
}
%secure = $false
if (%protocol == https) {
%secure = $true
}
if (%protocol) { %host = $regml(2) }
else { %host = $regml(1) }
var %portIndex = $iif(%protocol, 3, 2)
var %portfound = $false
if ($left($regml(%portIndex),1) == : && $right($regml(%portIndex),-1) isnum) {
%port = $right($regml(%portIndex),-1)
%portFound = $true
}
else {
if (%secure) {
%port = 443
}
else {
%port = 80
}
}
%pathIndex = $iif(%portFound, $calc(%portIndex + 1), %portIndex)
if ($regml(0) >= %pathIndex) {
%path = $regml(%pathIndex)
}
else { %path = / }
}
else { return $false }
if ($prop == secure) { return %secure }
if ($prop == host) { return %host }
if ($prop == path) { return %path }
if ($prop == port) { return %port }
return $true
}
alias http.addpost {
if ($0 < 3) {
echo -atg * /http.addpost: Usage: /http.addpost <handle> <variable> <value>
return
}
var %maintable = http. $+ $1
var %posttable = %maintable $+ .postdata
if (!$hget(%maintable)) {
echo -atg * /http.addpost: No such HTTP handle found
return
}
if (!$hget(%posttable)) { .hmake %posttable 10 }
hadd %posttable $2 $3-
echo -qatg Post variable added: $2 $+ = $+ $3-
}
alias http.delpost {
if ($0 < 2) {
echo -atg * /http.delpost: Usage: /http.delpost <handle> <variable>
return
}
var %maintable = http. $+ $1
var %posttable = %maintable $+ .postdata
if (!$hget(%maintable)) {
echo -atg * /http.addpost: No such HTTP handle found
return
}
if (!$hget(%posttable,$2)) {
echo -qatg * /http.addpost: No post variable with that name exists
return
}
hdel %posttable $2
echo -qatg Post variable deleted: $2
}
; Usage: $http.postdata(handle)
; Returns a binvar with a post data style query string (x=y&z=a) or $false
alias http.postdata {
; Post data is stored in INNAME.postdata
var %posttable = http. $+ $1 $+ .postdata
if (!$hget(%posttable,0).item) { return $false }
var %i = 1
while ($hget(%posttable,%i).item) {
var %item = $ifmatch
bset -t &bvPost $calc($bvar(&bvPost,0) +1) $iif(%i > 1,&,) $+ $http.urlencode(%item) $+ = $+ $http.urlencode($hget(%posttable,%item))
inc %i
}
return &bvPost
}
; Replace some commonly touchy URL characters with their hex-octect encoding
alias -l http.urlencode {
return $replacex($1-,$chr(32),% $+ 20, $chr(44), % $+ 2C,+, % $+ 2B, $chr(37), % $+ 25)
}

{{Author|aca20031}}

[[Category:Script Archive]]

MHTTP

2015-06-10T17:17:15Z

Aca20031: POST, should pick it up from the external name not the internal name

Often times you may want to download a web page from the internet using HTTP, but HTTP can be complicated. This script handles most of the basics for you including
* URL Parsing
* SSL
* Cookies
* Sending POST data
* Following redirects
* Handling CHUNKED encoding

Typical usage simply involves using the /http.open, save and close commands to download a file, and creating a signal event to do something with it once it is done.
== Example ==
alias DownloadGooglesLogo {
http.open google https://www.google.com/images/srpr/logo11w.png
http.save -f google logo.png
}
on *:SIGNAL:http: {
if ($1 == google) {
if ($2 == SAVED) { run $3- | http.close $1 }
if ($2 == PROGRESS) { echo -atg Download progress: $bytes($3).suf $+ / $+ $bytes($4).suf downloaded }
}
}

== Script ==
; Ben's (ben@st0rm.net) HTTP for mIRC script (mHTTP)
; Used to download over HTTP
; Basic usage
; /http.open [name] <URL>
; Opens an HTTP handle for the given URL
; /http.save [-f] <name> <file|bvar>
; Downloads a given HTTP resource to the given file or binvar
; -f forces the file to be overwritten
; /http.close <name>
; Closes and HTTP handle for the given URL
;
; Here are some things you can do after opening a handle, but before saving it
; Manage POST data:
; /http.addpost <handle> <variable> <value>
; /http.delpost <handle> <variable>
; Manage cookies
; /http.addcookie <handle> <value>
; $http.cookie(handle,N) - gets Nth cookie
;
; After a request completes (e.g. after a save) you can get some data:
; $http.responseheader(handle, header, N) - Returns value of given responseheader, or $false. Only useful after a request is made
;
; You can mark a socket with data of your choice (it's a transparent write to a hashtable) similar to sockmark
; /http.mark <handle> [data] - Writes the data. Specify no data to delete the mark
; $http.mark(handle) - Reads the data
;
; Signals
; In order to tell via script when something happens (your file is being saved, for example) use
; on *:SIGNAL:http:
; where $1 = Handle name, $2 = Event name, $3- = parameters
; Events:
; COMPLETED <statuscode> - when a request completes
; SAVED <location> - when a save completes
; REDIRECT <location> - when a request is redirected elsewhere
; PROGRESS <bytes> [total size] - When part but not all of the data is downloaded. Total size is not available for chunked transfer
;
;
; Known issues:
; Cookies do not respect attributes such as domain, path, expiration, or secure. They area always sent
; Relative redirects don't work, only absolute
; Redirects from insecure to secure links when you don't have SSL will not be handled well
; Creates a request that when completed is saved to a file
alias http.save {
if ($1 == -f) {
var %force = $true
tokenize 32 $2-
}
else { var %force = $false }
if ($0 < 2) {
echo -atg * /http.save: Use /http.save <http handle> <file>
return
}
var %hashtable = http. $+ $1
if (!$hget(%hashtable)) {
echo -atg * /http.save: No such HTTP handle exists. Use /http.open first
return
}
if ($sock(%hashtable)) {
echo -atg * /http.save: There is a pending request for this HTTP handle already. A connection is open the the remote host. Close it, or wait for it to complete
return
}
var %destination = $2-
if ($exists(%destination)) {
if (%force) {
.remove %destination
}
else {
echo -atg * /http.save: File already exists. Try /http.save -f to force an overwrite
return
}
}
if (&* iswm %destination) {
.hadd %hashtable bvarout %destination
}
else {
; Open file handler stream for writing
.fopen -n %hashtable %destination
if ($ferr) {
echo -atg * /http.save: Could not use file. Error: $ferr
return
}
; Store fstream name in hashtable to indicate that we want to save this once it completes
.hadd %hashtable fstream %hashtable
}
; Set redirect counter to 0
.hadd %hashtable redirects 0
; Start socket
http.sockstart %hashtable
}
alias http.mark {
var %hashtable = http. $+ $1
if ($isid) {
; As an identifier, read the mark
return $hget(%hashtable,mark)
}
else {
; As a command, set the mark
if (!$hget(%hashtable)) {
echo -atg * /http.mark - No such handle $1
}
elseif (!$2) {
.hdel %hashtable mark
}
else {
.hadd %hashtable mark $2-
}
}
}
; Opens socket
alias -l http.sockstart {
if ($hget($1,secure) == $true) {
if ($sock($1) && $sock($1).ssl) {
http.sendrequest $1
}
else {
if ($sock($1)) { .sockclose $1 }
if (!$sslready) {
echo -atg HTTP Error - request $qt($right($1,-5)) would require you to use SSL but you are not SSL ready. Please see http://mirc.com/ssl.html
http.close $right($1,-5)
return
}
sockopen -e $1 $hget($1, host) $hget($1, port)
}
}
else {
if ($sock($1)) {
http.sendrequest $1
}
else {
sockopen $1 $hget($1, host) $hget($1, port)
}
}
}
; Sends the request. Assumes the socket is open and ready
alias -l http.sendrequest {
if (!$sock($1)) { echo -atg HTTP Internal error. Socket not open in /http.sendrequest | return }
var %inname = $1
var %exname = $right($1,-5)
; Cleanup from previous requests
.hdel %inname responseheaders
.hdel %inname body
.hdel %inname contentlength
.hdel %inname chunkleft
; Get POST binvar
var %postBV = $http.postdata(%exname)
; Use GET if there's no post data, POST otherwise
if ($bvar(%postBV,0) == 0) {
sockwrite -n %inname GET $hget(%inname,path) HTTP/1.1
}
else {
sockwrite -n %inname POST $hget(%inname,path) HTTP/1.1
}
; Send the host
sockwrite -n %inname Host: $hget(%inname,host)
; Send the user-agent
sockwrite -n %inname User-agent: $hget(%inname,user-agent)
sockwrite -n %inname Connection: Keep-Alive
; Only plain-text supported
sockwrite -n %inname Accept: text/plain; q=0.5, text/html
; Send cookies
if ($http.cookie(%exname, 0) > 0) {
sockwrite %inname Cookie: $+ $chr(32)
var %i = 1
while ($http.cookie(%exname, %i)) {
sockwrite %inname $http.urlencode($ifmatch) $+ ;
inc %i
}
sockwrite -n %inname
}
; If POST send content type and length
if ($bvar(%postBV,0) > 0) {
sockwrite -n %inname Content-Type: application/x-www-form-urlencoded
sockwrite -n %inname Content-Length: $v1
}
; End request headers with empty line
sockwrite -n %inname
; If POST, send data
if ($bvar(%postBV,0) > 0) {
sockwrite %inname %postBV
; sockwrite -n %inname
}
}
; Just some bookeeping in case we miss it
on *:SOCKCLOSE:http.*: {
if ($fopen($sockname)) { .fclose $sockname }
}
on *:SOCKOPEN:http.*: {
http.sendrequest $sockname
}
on *:SOCKREAD:http.*: {
if ($sockerr > 0) {
echo -atg * HTTP handle $qt($right($sockname,-5)) failed with socket error $sockerr
http.close $right($sockname,-5)
return
}
;Read all the data into &bvTemp
:read
; First, read this buffer
sockread &bvThis
if ($sockbr > 0) {
; If data was read, copy it to the on-going buffer and continue
bcopy &bvTemp $calc($bvar(&bvTemp,0) +1) &bvThis 1 -1
goto read
}
if ($bvar(&bvTemp,0) == 0) { echo -atg HTTP sockread called with no data to read... | return }
; Do we need to parse headers?
; If response headers not set, this call has the headers
if (!$hget($sockname,responseheaders)) {
; Find the response headers
var %end = $bfind(&bvTemp,1, 13 10 13 10)
if (%end == 0) { echo -atg Error: No headers found, but no content length so this can't be a subsequent call | return }
; Increase to include the 3 extra characters
inc %end 3
bcopy &bvResponseHeaders 1 &bvTemp 1 %end
; If there's still non-header data copy it over
if (%end < $bvar(&bvTemp, 0)) {
bcopy -c &bvTemp 1 &bvTemp $calc(%end + 1) -1
}
else { bunset &bvTemp }
; If this is the first header response, save in hash table
if (!$hget($sockname, responseheaders)) {
.hadd -b $sockname responseheaders &bvResponseHeaders
http.OnHeaders $sockname
}
}
; there's no more to read, bail
if (!$bvar(&bvTemp,0)) {
; If that's all this response has to offer, we're done
if ($hget($sockname,contentlength) == 0) {
http.ondone $sockname
}
return
}
; Read body
var %contentlength = $hget($sockname,contentlength)
if (%contentlength == $null || %contentlength == $false) {
var %chunked = $true
}
else {
var %chunked = $false
}
; Set bvBody to the body ready so far
if ($hget($sockname,body)) {
noop $hget($sockname, body, &bvBody)
}
if (%chunked) {
:readChunk
var %chunkleft = $hget($sockname, chunkleft)
if (!%chunkleft) {
; If we've read all of a chunk, or this is the first one, get its size
var %crlf = $bfind(&bvTemp, 1, 13 10)
if (!%crlf) {
echo -atg HTTP internal error. Handle $qt($right($sockname,-5)) is in chunked encoding but no chunk size found in data
return
}
var %chunkleft = $base($bvar(&bvTemp, 1, $calc(%crlf - 1)).text,16,10)
if (%chunkleft !isnum) {
echo -atg HTTP internal error. Handle $qt($right($sockname,-5)) has invalid chunk size: %chunkleft
}
; New chunk
else {
; Save chunk size and remove it (plus its \r\n) from temp
.hadd $sockname chunkleft %chunkleft
.bcopy -c &bvTemp 1 &bvTemp $calc(%crlf +2) -1
if (%chunkLeft == 0) {
; if we just read chunk size 0, that was the end.
.hadd -b $sockname body &bvBody
http.onDone $sockname
return
}
}
}
; read %chunkleft bytes
var %bytesToRead = $iif(%chunkLeft < $bvar(&bvTemp,0),%chunkLeft, $bvar(&bvTemp,0))
.bcopy &bvBody $calc($bvar(&bvBody,0) +1) &bvTemp 1 %bytesToRead
hdec $sockname chunkleft %bytesToRead
.signal http $right($sockname,-5) PROGRESS %bytesToRead
if (%bytesToRead == %chunkLeft) {
; If this is the end of the chunk, consume crlf
inc %bytesToRead 2
; If there's still stuff in this var, go back and read the new chunk
if (%bytesToRead < $bvar(&bvTemp,0)) {
.bcopy -c &bvTemp 1 &bvTemp $calc(%bytesToRead + 1) -1
goto readChunk
}
}
; End of this call, save body in hashtable for future calls
.hadd -b $sockname body &bvBody
}
else {
; Copy everything
.bcopy &bvBody $calc($bvar(&bvBody,0) +1) &bvTemp 1 -1
; Add read-so-far body to hashtable
.hadd -b $sockname body &bvBody
.signal http $right($sockname,-5) PROGRESS $bvar(&bvBody,0) $hget($sockname,contentlength)
; Check if we're done
if ($bvar(&bvBody,0) >= $hget($sockname,contentlength)) {
; We're done
http.onDone $sockname
if ($bvar(&bvBody,0) > $hget($sockname,contentlength)) {
echo -qatg HTTP Warning: Read past content-length.
}
}
}
}
; Internal event called when we get the first header response from the server
alias -l http.OnHeaders {
noop $hget($1,responseheaders, &bvResponseHeaders)
; First header is always the status response
var %end = $bfind(&bvResponseHeaders, 1, 13 10)
if (%end <= 1) {
echo -atg Error: HTTP $qt($right($1,-5)) Server did not respond with HTTP status
goto cleanup
}
var %status = $bvar(&bvResponseHeaders,1,$calc(%end - 1)).text
.hadd $1 responsestatus %status
var %version = $gettok(%status,1,32)
if (%version != HTTP/1.1 && %version != HTTP/1.0) {
echo -atg Error: HTTP $qt($right($1,-5)) Server indicated unknown version: %version
goto cleanup
}
var %statuscode = $gettok(%status,2,32)
if (%statuscode !isnum) {
echo -atg Error: HTTP $qt($right($1,-5)) Server indicated invalid status code: %statuscode
goto cleanup
}
; Check transfer type
if ($http.responseheader($right($1,-5),Content-Length,1) != $null) {
hadd $1 contentlength $v1
}
elseif ($http.responseheader($right($1,-5), Transfer-Encoding, 1) != chunked) {
echo -atg HTTP Handle $qt($right($1,-5)) has no content-length header and is not chunked
echo -atg $bvar(&bvResponseHeaders,1-).text
return
}
; Add any cookies that were set
var %cookie = 1
while ($http.responseheader($right($1,-5), Set-Cookie, %cookie)) {
inc %cookie
var %cookieValue = $gettok($ifmatch,1,$asc(;))
http.addcookie $right($1,-5) %cookieValue
}
; Handle redirects
if (%statuscode == 303 || %statuscode == 302 || %statuscode == 307) {
var %location = $http.responseheader($right($1,-5), Location)
.signal http $right($1,-5) REDIRECT %location
http.seturl $1 %location
hinc $1 redirects
; If the server doesn't promise us this connection is keep-alive, close it and use a new one
if ($http.responseheader($right($1,-5), Connection, 1) != Keep-Alive) {
if ($sock($1)) { .sockclose $1 }
}
if ($hget($1, redirects) > 5) {
echo -atg HTTP Handle $qt($right($1,-5)) redirect loop detected
return
}
http.sockstart $1
}
return
:cleanup
if ($sock($1)) { .sockclose $1 }
}
alias http.addcookie {
var %hashtable = http. $+ $1
if (!$hget(%hashtable)) {
echo -atg * /http.addcookie: No such HTTP handle
return
}
if ($0 < 2) {
echo -atg * /http.addcookie: Usage: /http.addcookie <handle> <value>
return
}
var %i = 1
var %cookieNum = 1
while ($hget(%hashtable,%i).item) {
var %item = $ifmatch
inc %i
if (cookie-* iswm %item) {
var %tmp = $gettok(%item,2,$asc(-))
; If the value is the same, overwrite
if ($2- == $hget(%hashtable,%item)) {
%cookieNum = %tmp
break
}
; Otherwise store max cookie num
elseif (%tmp >= %cookieNum) { %cookieNum = $calc(%tmp + 1) }
}
}
.hadd %hashtable cookie- $+ %cookieNum $+ -value $2-
}
; Gets an HTTP cookie for the given handle
; $http.cookie(<handle>, <index>)
alias http.cookie {
if ($2 !isnum) {
echo -atg * $!http.cookie invalid parameters
return
}
var %hashtable = http. $+ $1
if (!$hget(%hashtable)) {
echo -atg * $!http.cookie no such HTTP handle
return
}
var %i = 1
var %found = 0
while ($hget(%hashtable, %i).item) {
inc %i
var %item = $ifmatch
if (cookie-*-value iswm %item) {
inc %found
var %id = $gettok(%item,2,$asc(-))
if (%found == $2) {
return $hget(%hashtable, cookie- $+ %id $+ -value)
}
}
}
if ($2 == 0) { return %found }
}
; Returns the value of the given response header
; Case sensitive since it is binary variable operation
alias http.responseheader {
if ($0 < 2) {
echo -atg Invalid usage. Use: $http.responseheader(<handle>, <header>[, index])
return
}
; %index is parameter 3 - 1-N or 0 for number
var %index = 1
if ($3 isnum) {
%index = $3
}
; Veriy hash table exists
var %table = http. $+ $1
if (!$hget(%table,responseheaders)) { return $false }
noop $hget(%table,responseheaders, &bvResponseHeaders))
; Set up parameters for the header search
; Offset is where we start searching from in the loop
; thisIndex is the number of matches found so far
var %offset = 1
var %thisIndex = 0
; The main search loop
:search
var %start = $bfind(&bvResponseHeaders, %offset, $2 $+ :).text
; If there isn't another match, either the index was too large or they want the count
if (!%start) {
if (%index == 0) { return %thisIndex }
else { return $false }
}
; Find the end of the header
var %end = $bfind(&bvResponseHeaders, %start, 13 10)
if (%end <= %start) { echo -atg HTTP Internal error ($http.responseheader), header $qt($2) for handle $qt($1) has no CRLF termination | return $false }
inc %thisIndex
; If this not the one they asked for, try again starting from the end of this header
if (%index != %thisIndex) {
var %offset = %end
goto search
}
; Find the colon. If there isn't one we'll return the whole string
if ($calc($bfind(&bvResponseHeaders, %start, $asc(:)) +1) < %end) {
%start = $v1
}
return $bvar(&bvResponseHeaders,%start, $calc(%end - %start)).text
}
; Internal event called when a request is filled. $1 = internal handle name
alias -l http.onDone {
if ($hget($1,responseheaders)) {
noop $hget($1,responseheaders,&bvResponseHeaders)
}
; Write out and close filestream if set
if ($hget($1,fstream)) {
noop $hget($1,body,&bvBody)
if (!$bvar(&bvBody,0)) {
.fclose $hget($1,fstream)
}
else {
.fwrite -b $hget($1,fstream) &bvBody
; Save fname so we can use it in the signal after the close
var %fname = $fopen($hget($1,fstream)).fname
.fclose $hget($1,fstream)
.signal http $right($1,-5) SAVED %fname
}
}
; If socket is still around, close it
if ($sock($1)) { .sockclose $1 }
; Reset redirects for future calls
.hadd $1 redirects 0
.signal HTTP $right($1,-5) COMPLETED $hget($1,responsestatus)
if ($hget($1, bvarout)) {
noop $hget($1,body,&bvBody)
var %bvarout = $ifmatch
bcopy %bvarout 1 &bvBody 1 -1
; Need to use -n so that the binvar is still in scope
; So we need to do this last
.signal -n http $right($1,-5) SAVED %bvarout
}
}
alias http.open {
var %hashtable
; If two parameters are given, $1 is the name, else create a new name
if ($0 > 1) { %hashtable = http. $+ $1 }
else {
var %h = $calc($ticks % $rand(1,1000000))
var %hashtable = http. $+ %h
}
if ($hget(%hashtable)) {
echo -atg * /http.open: HTTP Request $qt($1) already exists
return
}
; Encode the octects of the URL. e.g.: foo bar,pie --> foo%20bar,%2Cpie
var %url = $iif($0 > 1, $2-, $1-)
var %urlEncoded = $http.urlencode(%url)
; Check the URL
if (!$http.urlparse(%urlEncoded)) {
echo -atg * /http.open: Malformed URL. Use /http.open [name] <url>
return
}
if ($http.urlparse(%urlEncoded).secure && !$sslready) {
echo -atg * /http.open: URL is SSL but $!sslready = false. See http://www.mirc.com/ssl.html
return
}
; Everything checks out, let's store the relevent bits in a hashtable
.hmake %hashtable 10
http.seturl %hashtable %url
echo -qatg * /http.open: Opened HTTP request $qt($right(%hashtable,-5))
}
alias -l http.seturl {
if ($0 < 2) { echo -atg HTTP Internal error, seturl called with no url }
var %hashtable = $1
if (!$hget(%hashtable)) { echo -atg HTTP Internal error, seturl called with invalid handle }
var %urlEncoded = $http.urlencode($2-)
.hadd %hashtable host $http.urlparse(%urlEncoded).host
.hadd %hashtable port $http.urlparse(%urlEncoded).port
.hadd %hashtable secure $http.urlparse(%urlEncoded).secure
.hadd %hashtable path $http.urlparse(%urlEncoded).path
.hadd %hashtable user-agent mIRC $version
}
alias http.list {
var %i = 1
var %numFound = 0
while (%i <= $hget(0)) {
var %table = $hget(%i)
inc %i
if (http.* iswm %table) {
inc %numFound
echo -atg * $right(%table,-5) $+ : Host: $hget(%table,host) Port: $hget(%table,port) Path: $hget(%table,path)
}
}
if (%numFound == 0) { echo -atg * No HTTP handles opened }
}
alias http.close {
var %i = 1
var %numFound = 0
while (%i <= $hget(0)) {
var %table = $hget(%i)
if (http. $+ $1 iswm %table) {
; Cleanup resources
if ($sock(%table)) { .sockclose %table }
if ($fopen(%table)) { .fclose %table }
if ($hget(%table $+ .postdata)) { .hfree %table $+ .postdata }
.hfree %table
inc %numFound
echo -qatg * HTTP Closed $right(%table,-5)
}
; Only inc if we didnt find a match
else {
inc %i
}
}
if (%numFound == 0) { echo -qatg * No matching HTTP handles }
}
;
; Takes an encoded URL and returns based on the property
; .secure - true if https
; .host - the URL host
; .port - the port, 80 by default
; .path - The path to download, / by default
; Returns $false is URL is malformed
;
alias http.urlparse {
var %secure
var %host
var %port
var %path
var %pathIndex
var %protocol
var %regex = /^(https?://)?([a-z.0-9\-_]+)(:\d+)?(/.*)?$/i
if ($regex($1, %regex)) {
if (http*:// iswm $regml(1)) {
%protocol = $lower($left($regml(1),-3))
}
%secure = $false
if (%protocol == https) {
%secure = $true
}
if (%protocol) { %host = $regml(2) }
else { %host = $regml(1) }
var %portIndex = $iif(%protocol, 3, 2)
var %portfound = $false
if ($left($regml(%portIndex),1) == : && $right($regml(%portIndex),-1) isnum) {
%port = $right($regml(%portIndex),-1)
%portFound = $true
}
else {
if (%secure) {
%port = 443
}
else {
%port = 80
}
}
%pathIndex = $iif(%portFound, $calc(%portIndex + 1), %portIndex)
if ($regml(0) >= %pathIndex) {
%path = $regml(%pathIndex)
}
else { %path = / }
}
else { return $false }
if ($prop == secure) { return %secure }
if ($prop == host) { return %host }
if ($prop == path) { return %path }
if ($prop == port) { return %port }
return $true
}
alias http.addpost {
if ($0 < 3) {
echo -atg * /http.addpost: Usage: /http.addpost <handle> <variable> <value>
return
}
var %maintable = http. $+ $1
var %posttable = %maintable $+ .postdata
if (!$hget(%maintable)) {
echo -atg * /http.addpost: No such HTTP handle found
return
}
if (!$hget(%posttable)) { .hmake %posttable 10 }
hadd %posttable $2 $3-
echo -qatg Post variable added: $2 $+ = $+ $3-
}
alias http.delpost {
if ($0 < 2) {
echo -atg * /http.delpost: Usage: /http.delpost <handle> <variable>
return
}
var %maintable = http. $+ $1
var %posttable = %maintable $+ .postdata
if (!$hget(%maintable)) {
echo -atg * /http.addpost: No such HTTP handle found
return
}
if (!$hget(%posttable,$2)) {
echo -qatg * /http.addpost: No post variable with that name exists
return
}
hdel %posttable $2
echo -qatg Post variable deleted: $2
}
; Usage: $http.postdata(handle)
; Returns a binvar with a post data style query string (x=y&z=a) or $false
alias http.postdata {
; Post data is stored in INNAME.postdata
var %posttable = http. $+ $1 $+ .postdata
if (!$hget(%posttable,0).item) { return $false }
var %i = 1
while ($hget(%posttable,%i).item) {
var %item = $ifmatch
bset -t &bvPost $calc($bvar(&bvPost,0) +1) $iif(%i > 1,&,) $+ $http.urlencode(%item) $+ = $+ $http.urlencode($hget(%posttable,%item))
inc %i
}
return &bvPost
}
; Replace some commonly touchy URL characters with their hex-octect encoding
alias -l http.urlencode {
return $replacex($1-,$chr(32),% $+ 20, $chr(44), % $+ 2C,+, % $+ 2B, $chr(37), % $+ 25)
}

{{Author|aca20031}}

[[Category:Script Archive]]

MHTTP

2015-05-22T19:46:53Z

Aca20031: +http.close to example

Often times you may want to download a web page from the internet using HTTP, but HTTP can be complicated. This script handles most of the basics for you including
* URL Parsing
* SSL
* Cookies
* Sending POST data
* Following redirects
* Handling CHUNKED encoding

Typical usage simply involves using the /http.open, save and close commands to download a file, and creating a signal event to do something with it once it is done.
== Example ==
alias DownloadGooglesLogo {
http.open google https://www.google.com/images/srpr/logo11w.png
http.save -f google logo.png
}
on *:SIGNAL:http: {
if ($1 == google) {
if ($2 == SAVED) { run $3- | http.close $1 }
if ($2 == PROGRESS) { echo -atg Download progress: $bytes($3).suf $+ / $+ $bytes($4).suf downloaded }
}
}

== Script ==
; Ben's (ben@st0rm.net) HTTP for mIRC script (mHTTP)
; Used to download over HTTP
; Basic usage
; /http.open [name] <URL>
; Opens an HTTP handle for the given URL
; /http.save [-f] <name> <file|bvar>
; Downloads a given HTTP resource to the given file or binvar
; -f forces the file to be overwritten
; /http.close <name>
; Closes and HTTP handle for the given URL
;
; Here are some things you can do after opening a handle, but before saving it
; Manage POST data:
; /http.addpost <handle> <variable> <value>
; /http.delpost <handle> <variable>
; Manage cookies
; /http.addcookie <handle> <value>
; $http.cookie(handle,N) - gets Nth cookie
;
; After a request completes (e.g. after a save) you can get some data:
; $http.responseheader(handle, header, N) - Returns value of given responseheader, or $false. Only useful after a request is made
;
; You can mark a socket with data of your choice (it's a transparent write to a hashtable) similar to sockmark
; /http.mark <handle> [data] - Writes the data. Specify no data to delete the mark
; $http.mark(handle) - Reads the data
;
; Signals
; In order to tell via script when something happens (your file is being saved, for example) use
; on *:SIGNAL:http:
; where $1 = Handle name, $2 = Event name, $3- = parameters
; Events:
; COMPLETED <statuscode> - when a request completes
; SAVED <location> - when a save completes
; REDIRECT <location> - when a request is redirected elsewhere
; PROGRESS <bytes> [total size] - When part but not all of the data is downloaded. Total size is not available for chunked transfer
;
;
; Known issues:
; Cookies do not respect attributes such as domain, path, expiration, or secure. They area always sent
; Relative redirects don't work, only absolute
; Redirects from insecure to secure links when you don't have SSL will not be handled well
; Creates a request that when completed is saved to a file
alias http.save {
if ($1 == -f) {
var %force = $true
tokenize 32 $2-
}
else { var %force = $false }
if ($0 < 2) {
echo -atg * /http.save: Use /http.save <http handle> <file>
return
}
var %hashtable = http. $+ $1
if (!$hget(%hashtable)) {
echo -atg * /http.save: No such HTTP handle exists. Use /http.open first
return
}
if ($sock(%hashtable)) {
echo -atg * /http.save: There is a pending request for this HTTP handle already. A connection is open the the remote host. Close it, or wait for it to complete
return
}
var %destination = $2-
if ($exists(%destination)) {
if (%force) {
.remove %destination
}
else {
echo -atg * /http.save: File already exists. Try /http.save -f to force an overwrite
return
}
}
if (&* iswm %destination) {
.hadd %hashtable bvarout %destination
}
else {
; Open file handler stream for writing
.fopen -n %hashtable %destination
if ($ferr) {
echo -atg * /http.save: Could not use file. Error: $ferr
return
}
; Store fstream name in hashtable to indicate that we want to save this once it completes
.hadd %hashtable fstream %hashtable
}
; Set redirect counter to 0
.hadd %hashtable redirects 0
; Start socket
http.sockstart %hashtable
}
alias http.mark {
var %hashtable = http. $+ $1
if ($isid) {
; As an identifier, read the mark
return $hget(%hashtable,mark)
}
else {
; As a command, set the mark
if (!$hget(%hashtable)) {
echo -atg * /http.mark - No such handle $1
}
elseif (!$2) {
.hdel %hashtable mark
}
else {
.hadd %hashtable mark $2-
}
}
}
; Opens socket
alias -l http.sockstart {
if ($hget($1,secure) == $true) {
if ($sock($1) && $sock($1).ssl) {
http.sendrequest $1
}
else {
if ($sock($1)) { .sockclose $1 }
if (!$sslready) {
echo -atg HTTP Error - request $qt($right($1,-5)) would require you to use SSL but you are not SSL ready. Please see http://mirc.com/ssl.html
http.close $right($1,-5)
return
}
sockopen -e $1 $hget($1, host) $hget($1, port)
}
}
else {
if ($sock($1)) {
http.sendrequest $1
}
else {
sockopen $1 $hget($1, host) $hget($1, port)
}
}
}
; Sends the request. Assumes the socket is open and ready
alias -l http.sendrequest {
if (!$sock($1)) { echo -atg HTTP Internal error. Socket not open in /http.sendrequest | return }
var %inname = $1
var %exname = $right($1,-5)
; Cleanup from previous requests
.hdel %inname responseheaders
.hdel %inname body
.hdel %inname contentlength
.hdel %inname chunkleft
; Get POST binvar
var %postBV = $http.postdata(%inname)
; Use GET if there's no post data, POST otherwise
if ($bvar(%postBV,0) == 0) {
sockwrite -n %inname GET $hget(%inname,path) HTTP/1.1
}
else {
sockwrite -n %inname POST $hget(%inname,path) HTTP/1.1
}
; Send the host
sockwrite -n %inname Host: $hget(%inname,host)
; Send the user-agent
sockwrite -n %inname User-agent: $hget(%inname,user-agent)
sockwrite -n %inname Connection: Keep-Alive
; Only plain-text supported
sockwrite -n %inname Accept: text/plain; q=0.5, text/html
; Send cookies
if ($http.cookie(%exname, 0) > 0) {
sockwrite %inname Cookie: $+ $chr(32)
var %i = 1
while ($http.cookie(%exname, %i)) {
sockwrite %inname $http.urlencode($ifmatch) $+ ;
inc %i
}
sockwrite -n %inname
}
; If POST send content type and length
if ($bvar(%postBV,0) > 0) {
sockwrite -n %inname Content-Type: application/x-www-form-urlencoded
sockwrite -n %inname Content-Length: $v1
}
; End request headers with empty line
sockwrite -n %inname
; If POST, send data
if ($bvar(%postBV,0) > 0) {
sockwrite %inname %postBV
; sockwrite -n %inname
}
}
; Just some bookeeping in case we miss it
on *:SOCKCLOSE:http.*: {
if ($fopen($sockname)) { .fclose $sockname }
}
on *:SOCKOPEN:http.*: {
http.sendrequest $sockname
}
on *:SOCKREAD:http.*: {
if ($sockerr > 0) {
echo -atg * HTTP handle $qt($right($sockname,-5)) failed with socket error $sockerr
http.close $right($sockname,-5)
return
}
;Read all the data into &bvTemp
:read
; First, read this buffer
sockread &bvThis
if ($sockbr > 0) {
; If data was read, copy it to the on-going buffer and continue
bcopy &bvTemp $calc($bvar(&bvTemp,0) +1) &bvThis 1 -1
goto read
}
if ($bvar(&bvTemp,0) == 0) { echo -atg HTTP sockread called with no data to read... | return }
; Do we need to parse headers?
; If response headers not set, this call has the headers
if (!$hget($sockname,responseheaders)) {
; Find the response headers
var %end = $bfind(&bvTemp,1, 13 10 13 10)
if (%end == 0) { echo -atg Error: No headers found, but no content length so this can't be a subsequent call | return }
; Increase to include the 3 extra characters
inc %end 3
bcopy &bvResponseHeaders 1 &bvTemp 1 %end
; If there's still non-header data copy it over
if (%end < $bvar(&bvTemp, 0)) {
bcopy -c &bvTemp 1 &bvTemp $calc(%end + 1) -1
}
else { bunset &bvTemp }
; If this is the first header response, save in hash table
if (!$hget($sockname, responseheaders)) {
.hadd -b $sockname responseheaders &bvResponseHeaders
http.OnHeaders $sockname
}
}
; there's no more to read, bail
if (!$bvar(&bvTemp,0)) {
; If that's all this response has to offer, we're done
if ($hget($sockname,contentlength) == 0) {
http.ondone $sockname
}
return
}
; Read body
var %contentlength = $hget($sockname,contentlength)
if (%contentlength == $null || %contentlength == $false) {
var %chunked = $true
}
else {
var %chunked = $false
}
; Set bvBody to the body ready so far
if ($hget($sockname,body)) {
noop $hget($sockname, body, &bvBody)
}
if (%chunked) {
:readChunk
var %chunkleft = $hget($sockname, chunkleft)
if (!%chunkleft) {
; If we've read all of a chunk, or this is the first one, get its size
var %crlf = $bfind(&bvTemp, 1, 13 10)
if (!%crlf) {
echo -atg HTTP internal error. Handle $qt($right($sockname,-5)) is in chunked encoding but no chunk size found in data
return
}
var %chunkleft = $base($bvar(&bvTemp, 1, $calc(%crlf - 1)).text,16,10)
if (%chunkleft !isnum) {
echo -atg HTTP internal error. Handle $qt($right($sockname,-5)) has invalid chunk size: %chunkleft
}
; New chunk
else {
; Save chunk size and remove it (plus its \r\n) from temp
.hadd $sockname chunkleft %chunkleft
.bcopy -c &bvTemp 1 &bvTemp $calc(%crlf +2) -1
if (%chunkLeft == 0) {
; if we just read chunk size 0, that was the end.
.hadd -b $sockname body &bvBody
http.onDone $sockname
return
}
}
}
; read %chunkleft bytes
var %bytesToRead = $iif(%chunkLeft < $bvar(&bvTemp,0),%chunkLeft, $bvar(&bvTemp,0))
.bcopy &bvBody $calc($bvar(&bvBody,0) +1) &bvTemp 1 %bytesToRead
hdec $sockname chunkleft %bytesToRead
.signal http $right($sockname,-5) PROGRESS %bytesToRead
if (%bytesToRead == %chunkLeft) {
; If this is the end of the chunk, consume crlf
inc %bytesToRead 2
; If there's still stuff in this var, go back and read the new chunk
if (%bytesToRead < $bvar(&bvTemp,0)) {
.bcopy -c &bvTemp 1 &bvTemp $calc(%bytesToRead + 1) -1
goto readChunk
}
}
; End of this call, save body in hashtable for future calls
.hadd -b $sockname body &bvBody
}
else {
; Copy everything
.bcopy &bvBody $calc($bvar(&bvBody,0) +1) &bvTemp 1 -1
; Add read-so-far body to hashtable
.hadd -b $sockname body &bvBody
.signal http $right($sockname,-5) PROGRESS $bvar(&bvBody,0) $hget($sockname,contentlength)
; Check if we're done
if ($bvar(&bvBody,0) >= $hget($sockname,contentlength)) {
; We're done
http.onDone $sockname
if ($bvar(&bvBody,0) > $hget($sockname,contentlength)) {
echo -qatg HTTP Warning: Read past content-length.
}
}
}
}
; Internal event called when we get the first header response from the server
alias -l http.OnHeaders {
noop $hget($1,responseheaders, &bvResponseHeaders)
; First header is always the status response
var %end = $bfind(&bvResponseHeaders, 1, 13 10)
if (%end <= 1) {
echo -atg Error: HTTP $qt($right($1,-5)) Server did not respond with HTTP status
goto cleanup
}
var %status = $bvar(&bvResponseHeaders,1,$calc(%end - 1)).text
.hadd $1 responsestatus %status
var %version = $gettok(%status,1,32)
if (%version != HTTP/1.1 && %version != HTTP/1.0) {
echo -atg Error: HTTP $qt($right($1,-5)) Server indicated unknown version: %version
goto cleanup
}
var %statuscode = $gettok(%status,2,32)
if (%statuscode !isnum) {
echo -atg Error: HTTP $qt($right($1,-5)) Server indicated invalid status code: %statuscode
goto cleanup
}
; Check transfer type
if ($http.responseheader($right($1,-5),Content-Length,1) != $null) {
hadd $1 contentlength $v1
}
elseif ($http.responseheader($right($1,-5), Transfer-Encoding, 1) != chunked) {
echo -atg HTTP Handle $qt($right($1,-5)) has no content-length header and is not chunked
echo -atg $bvar(&bvResponseHeaders,1-).text
return
}
; Add any cookies that were set
var %cookie = 1
while ($http.responseheader($right($1,-5), Set-Cookie, %cookie)) {
inc %cookie
var %cookieValue = $gettok($ifmatch,1,$asc(;))
http.addcookie $right($1,-5) %cookieValue
}
; Handle redirects
if (%statuscode == 303 || %statuscode == 302 || %statuscode == 307) {
var %location = $http.responseheader($right($1,-5), Location)
.signal http $right($1,-5) REDIRECT %location
http.seturl $1 %location
hinc $1 redirects
; If the server doesn't promise us this connection is keep-alive, close it and use a new one
if ($http.responseheader($right($1,-5), Connection, 1) != Keep-Alive) {
if ($sock($1)) { .sockclose $1 }
}
if ($hget($1, redirects) > 5) {
echo -atg HTTP Handle $qt($right($1,-5)) redirect loop detected
return
}
http.sockstart $1
}
return
:cleanup
if ($sock($1)) { .sockclose $1 }
}
alias http.addcookie {
var %hashtable = http. $+ $1
if (!$hget(%hashtable)) {
echo -atg * /http.addcookie: No such HTTP handle
return
}
if ($0 < 2) {
echo -atg * /http.addcookie: Usage: /http.addcookie <handle> <value>
return
}
var %i = 1
var %cookieNum = 1
while ($hget(%hashtable,%i).item) {
var %item = $ifmatch
inc %i
if (cookie-* iswm %item) {
var %tmp = $gettok(%item,2,$asc(-))
; If the value is the same, overwrite
if ($2- == $hget(%hashtable,%item)) {
%cookieNum = %tmp
break
}
; Otherwise store max cookie num
elseif (%tmp >= %cookieNum) { %cookieNum = $calc(%tmp + 1) }
}
}
.hadd %hashtable cookie- $+ %cookieNum $+ -value $2-
}
; Gets an HTTP cookie for the given handle
; $http.cookie(<handle>, <index>)
alias http.cookie {
if ($2 !isnum) {
echo -atg * $!http.cookie invalid parameters
return
}
var %hashtable = http. $+ $1
if (!$hget(%hashtable)) {
echo -atg * $!http.cookie no such HTTP handle
return
}
var %i = 1
var %found = 0
while ($hget(%hashtable, %i).item) {
inc %i
var %item = $ifmatch
if (cookie-*-value iswm %item) {
inc %found
var %id = $gettok(%item,2,$asc(-))
if (%found == $2) {
return $hget(%hashtable, cookie- $+ %id $+ -value)
}
}
}
if ($2 == 0) { return %found }
}
; Returns the value of the given response header
; Case sensitive since it is binary variable operation
alias http.responseheader {
if ($0 < 2) {
echo -atg Invalid usage. Use: $http.responseheader(<handle>, <header>[, index])
return
}
; %index is parameter 3 - 1-N or 0 for number
var %index = 1
if ($3 isnum) {
%index = $3
}
; Veriy hash table exists
var %table = http. $+ $1
if (!$hget(%table,responseheaders)) { return $false }
noop $hget(%table,responseheaders, &bvResponseHeaders))
; Set up parameters for the header search
; Offset is where we start searching from in the loop
; thisIndex is the number of matches found so far
var %offset = 1
var %thisIndex = 0
; The main search loop
:search
var %start = $bfind(&bvResponseHeaders, %offset, $2 $+ :).text
; If there isn't another match, either the index was too large or they want the count
if (!%start) {
if (%index == 0) { return %thisIndex }
else { return $false }
}
; Find the end of the header
var %end = $bfind(&bvResponseHeaders, %start, 13 10)
if (%end <= %start) { echo -atg HTTP Internal error ($http.responseheader), header $qt($2) for handle $qt($1) has no CRLF termination | return $false }
inc %thisIndex
; If this not the one they asked for, try again starting from the end of this header
if (%index != %thisIndex) {
var %offset = %end
goto search
}
; Find the colon. If there isn't one we'll return the whole string
if ($calc($bfind(&bvResponseHeaders, %start, $asc(:)) +1) < %end) {
%start = $v1
}
return $bvar(&bvResponseHeaders,%start, $calc(%end - %start)).text
}
; Internal event called when a request is filled. $1 = internal handle name
alias -l http.onDone {
if ($hget($1,responseheaders)) {
noop $hget($1,responseheaders,&bvResponseHeaders)
}
; Write out and close filestream if set
if ($hget($1,fstream)) {
noop $hget($1,body,&bvBody)
if (!$bvar(&bvBody,0)) {
.fclose $hget($1,fstream)
}
else {
.fwrite -b $hget($1,fstream) &bvBody
; Save fname so we can use it in the signal after the close
var %fname = $fopen($hget($1,fstream)).fname
.fclose $hget($1,fstream)
.signal http $right($1,-5) SAVED %fname
}
}
; If socket is still around, close it
if ($sock($1)) { .sockclose $1 }
; Reset redirects for future calls
.hadd $1 redirects 0
.signal HTTP $right($1,-5) COMPLETED $hget($1,responsestatus)
if ($hget($1, bvarout)) {
noop $hget($1,body,&bvBody)
var %bvarout = $ifmatch
bcopy %bvarout 1 &bvBody 1 -1
; Need to use -n so that the binvar is still in scope
; So we need to do this last
.signal -n http $right($1,-5) SAVED %bvarout
}
}
alias http.open {
var %hashtable
; If two parameters are given, $1 is the name, else create a new name
if ($0 > 1) { %hashtable = http. $+ $1 }
else {
var %h = $calc($ticks % $rand(1,1000000))
var %hashtable = http. $+ %h
}
if ($hget(%hashtable)) {
echo -atg * /http.open: HTTP Request $qt($1) already exists
return
}
; Encode the octects of the URL. e.g.: foo bar,pie --> foo%20bar,%2Cpie
var %url = $iif($0 > 1, $2-, $1-)
var %urlEncoded = $http.urlencode(%url)
; Check the URL
if (!$http.urlparse(%urlEncoded)) {
echo -atg * /http.open: Malformed URL. Use /http.open [name] <url>
return
}
if ($http.urlparse(%urlEncoded).secure && !$sslready) {
echo -atg * /http.open: URL is SSL but $!sslready = false. See http://www.mirc.com/ssl.html
return
}
; Everything checks out, let's store the relevent bits in a hashtable
.hmake %hashtable 10
http.seturl %hashtable %url
echo -qatg * /http.open: Opened HTTP request $qt($right(%hashtable,-5))
}
alias -l http.seturl {
if ($0 < 2) { echo -atg HTTP Internal error, seturl called with no url }
var %hashtable = $1
if (!$hget(%hashtable)) { echo -atg HTTP Internal error, seturl called with invalid handle }
var %urlEncoded = $http.urlencode($2-)
.hadd %hashtable host $http.urlparse(%urlEncoded).host
.hadd %hashtable port $http.urlparse(%urlEncoded).port
.hadd %hashtable secure $http.urlparse(%urlEncoded).secure
.hadd %hashtable path $http.urlparse(%urlEncoded).path
.hadd %hashtable user-agent mIRC $version
}
alias http.list {
var %i = 1
var %numFound = 0
while (%i <= $hget(0)) {
var %table = $hget(%i)
inc %i
if (http.* iswm %table) {
inc %numFound
echo -atg * $right(%table,-5) $+ : Host: $hget(%table,host) Port: $hget(%table,port) Path: $hget(%table,path)
}
}
if (%numFound == 0) { echo -atg * No HTTP handles opened }
}
alias http.close {
var %i = 1
var %numFound = 0
while (%i <= $hget(0)) {
var %table = $hget(%i)
if (http. $+ $1 iswm %table) {
; Cleanup resources
if ($sock(%table)) { .sockclose %table }
if ($fopen(%table)) { .fclose %table }
if ($hget(%table $+ .postdata)) { .hfree %table $+ .postdata }
.hfree %table
inc %numFound
echo -qatg * HTTP Closed $right(%table,-5)
}
; Only inc if we didnt find a match
else {
inc %i
}
}
if (%numFound == 0) { echo -qatg * No matching HTTP handles }
}
;
; Takes an encoded URL and returns based on the property
; .secure - true if https
; .host - the URL host
; .port - the port, 80 by default
; .path - The path to download, / by default
; Returns $false is URL is malformed
;
alias http.urlparse {
var %secure
var %host
var %port
var %path
var %pathIndex
var %protocol
var %regex = /^(https?://)?([a-z.0-9\-_]+)(:\d+)?(/.*)?$/i
if ($regex($1, %regex)) {
if (http*:// iswm $regml(1)) {
%protocol = $lower($left($regml(1),-3))
}
%secure = $false
if (%protocol == https) {
%secure = $true
}
if (%protocol) { %host = $regml(2) }
else { %host = $regml(1) }
var %portIndex = $iif(%protocol, 3, 2)
var %portfound = $false
if ($left($regml(%portIndex),1) == : && $right($regml(%portIndex),-1) isnum) {
%port = $right($regml(%portIndex),-1)
%portFound = $true
}
else {
if (%secure) {
%port = 443
}
else {
%port = 80
}
}
%pathIndex = $iif(%portFound, $calc(%portIndex + 1), %portIndex)
if ($regml(0) >= %pathIndex) {
%path = $regml(%pathIndex)
}
else { %path = / }
}
else { return $false }
if ($prop == secure) { return %secure }
if ($prop == host) { return %host }
if ($prop == path) { return %path }
if ($prop == port) { return %port }
return $true
}
alias http.addpost {
if ($0 < 3) {
echo -atg * /http.addpost: Usage: /http.addpost <handle> <variable> <value>
return
}
var %maintable = http. $+ $1
var %posttable = %maintable $+ .postdata
if (!$hget(%maintable)) {
echo -atg * /http.addpost: No such HTTP handle found
return
}
if (!$hget(%posttable)) { .hmake %posttable 10 }
hadd %posttable $2 $3-
echo -qatg Post variable added: $2 $+ = $+ $3-
}
alias http.delpost {
if ($0 < 2) {
echo -atg * /http.delpost: Usage: /http.delpost <handle> <variable>
return
}
var %maintable = http. $+ $1
var %posttable = %maintable $+ .postdata
if (!$hget(%maintable)) {
echo -atg * /http.addpost: No such HTTP handle found
return
}
if (!$hget(%posttable,$2)) {
echo -qatg * /http.addpost: No post variable with that name exists
return
}
hdel %posttable $2
echo -qatg Post variable deleted: $2
}
; Usage: $http.postdata(handle)
; Returns a binvar with a post data style query string (x=y&z=a) or $false
alias http.postdata {
; Post data is stored in INNAME.postdata
var %posttable = http. $+ $1 $+ .postdata
if (!$hget(%posttable,0).item) { return $false }
var %i = 1
while ($hget(%posttable,%i).item) {
var %item = $ifmatch
bset -t &bvPost $calc($bvar(&bvPost,0) +1) $iif(%i > 1,&,) $+ $http.urlencode(%item) $+ = $+ $http.urlencode($hget(%posttable,%item))
inc %i
}
return &bvPost
}
; Replace some commonly touchy URL characters with their hex-octect encoding
alias -l http.urlencode {
return $replacex($1-,$chr(32),% $+ 20, $chr(44), % $+ 2C,+, % $+ 2B, $chr(37), % $+ 25)
}

{{Author|aca20031}}

[[Category:Script Archive]]

MJSON

2015-05-22T19:31:26Z

Aca20031: line break fix

This script is a 100% native way of parsing JSON with an easy API
The script works in 3 phases
1.) Parsing. $json.parse will return the root object, and it can be quite slow. Try to do this as little as possible and re-use the value.
2.) Querying. $json and $mjson can be used to read the data and is generally very fast, but requires a parsed object.
3.) Deleting. json.freeall can be used to delete a json object. Call it on the root object when you are done to clean up.

==Example==
To use the below example, Save the following JSON in "json-example.txt" in $mircdir

[
{
"name":"Todd",
"IsManager":false,
"Spouse":{"Name":"Marie"},
"Sallary":100000
},
{
"name":"Gena",
"IsManager":true,
"Spouse":null,
"Sallary":157103e-3
}
]

And then run /json-example with the script loaded.

alias json-example {
bread json-example.txt 0 $file(json-example.txt).size &bvar

; Parse top level
var %aEmployees = $json.parse(&bvar)
echo -atg The top level is a(n) $json.type(%aEmployees)

var %cEmployees = $json(%aEmployees).length
echo -atg Number of employees: %cEmployees

var %i = 0
while (%i < %cEmployees) {
var %oEmployee = $json(%aEmployees,%i)
inc %i

echo -atg Name: $json(%oEmployee,name).text
echo -atg IsManager: $json(%oEmployee,ismanager).text
var %spouse = $json(%oEmployee,spouse)
if (%spouse) { echo -atg Spouse: $json(%spouse,name).text }
echo -atg Sallary: $json(%oEmployee,Sallary).text
}

; Free memory
json.freeall %aEmployees
}

$mjson provides a simpler interface for quickly querying data, but it is less powerful than $json. Here is an example of how you can use $mjson to get the name of the first employee

alias json-example-simple {
bread json-example.txt 0 $file(json-example.txt).size &bvar

; Parse top level
var %aEmployees = $json.parse(&bvar)

echo -atg The first employee is: $mjson(%aEmployees,0,name)

json.freeall %aEmployees
}

As you can see, this is a much simpler way to just get information quickly. However this method does not allow you to get meta-information, such as how many employees there are.

==Script==
;$json.parse(&bvar | json string) - Parses a json and returns you a "handle". Use this in the other functions
; If the handle is "ERROR N" then N is an error code
; $json(handle,N/PROPERTY)
; Given a handle (use json.parse first) allows you to index an array or get a handle to a property by its name
; .text - Returns a data property or array index as text, e.g. $json($json.parse({"foo":"bar"}),bar).text
; .bvar - Returns a data property or array index as a binvar
; $json.freeall(handle)
; Frees memory used to parse the given handle
;$json.parse(&bvar | json string) - Parses a json and returns you a "handle". Use this in the other functions
; If the handle is "ERROR N" then N is an error code
alias json.parse {
var %bvar = $false
if (&* iswm $1) {
%bvar = $1
}
else {
%bvar = $json.createbvar
bset -t %bvar 1 $1-
}
return $json.parseany(%bvar)
}
; $json.type(handle) - Returns ARRAY, OBJECT, or Data
alias json.type {
tokenize 32 $1-
if ($1 == 1) { return OBJECT }
elseif ($1 == 2) { return ARRAY }
elseif ($1 == 3) { return DATA }
else return UNKNOWN TYPE $1
}
; $json(handle [,N/PROPERTY])
; Give a handle (use json.parse first) allows you to
; Get a property value
; Index into an array
; Get the Nth property name of an object
; .text - Returns a data property or array index as text, e.g. $json($json.parse({"foo":"bar"}),bar).text
; .bvar - Returns a data property or array index as a binvar
; .length - If the property is an array, or the handle is an array that isn't indexed, returns its length
alias json {
var %type = $gettok($1,1,32)
var %value = $gettok($1,2-,32)
if ($2 isnum && %type == 3) {
; Can't index non array
echo -atg $json Cannot index data type
return
}
; Indexing into an array
if ($2 isnum && %type == 2) {
var %datatable = $gettok(%value,1,32)
var %typetable = $gettok(%value,2,32)
var %thistype = $hget(%typetable,$2)
var %thisdata = $hget(%datatable,$2)
if (!%thistype) { return $null }
if (%thistype == 3 && $prop == bvar) {
var %bv = $json.createbvar
noop $hget(%datatable,$2,%bv)
return %bv
}
elseif (%thistype == 3 && $prop == text) {
return %thisdata
}
elseif (%thistype == 3) {
var %bv = $json.createbvar
noop $hget(%datatable,$2,%bv)
return %thistype %bv
}
elseif (%thistype != 3) {
return %thistype %thisdata
}
}
elseif (%type == 2 && $prop == length) {
; If we're not indexing, but we have an array with the .length property, return its length
; Return length of the data table for the array
return $hget($gettok(%value,1,32),0).item
}
; Getting a property of an object
elseif (%type == 1 && $2 !isnum) {
var %proptype = $json.getproperty(%value,$2).type
var %propvalue = $json.getproperty(%value,$2).value
var %propbv = $json.getproperty(%value,$2).bvar
if (!%proptype) { return $null }
if (%proptype == 3 && $prop == text) {
return %propvalue
}
elseif (%proptype == 3 && $prop == bvar) {
return %propbv
}
elseif (%proptype == 3) {
return %proptype %propbv
}
elseif (%proptype == 2 && $prop == length) {
; Return length of the data table for the array
return $hget($gettok(%propvalue,1,32),0).item
}
else {
return %proptype %propvalue
}
}
elseif (%type == 1 && $2 isnum) {
; Indexing object by index offset
var %thisIndex = 0
var %i = 1
while ($hget(%value,%i).item) {
inc %i
var %item = $ifmatch
var %propName = $gettok(%item,2-,$asc(.))
if (type.* iswm %item) {
inc %thisIndex
}
if (%thisIndex == $2) {
return %propName
}
if ($2 == 0) { return %thisIndex }
return $null
}
}
else {
echo -atg Unknown usage of $!json --> Prop: $prop P1: $1 P2: $2
}
}
; mjson is a very thin wrapper to automatically walk down
; the object chain.
alias mjson {
var %object = $1
var %propertyIndex = 2
while (%propertyIndex < $0) {
var %object = $json(%object,$($ $+ %propertyIndex,2))
inc %propertyIndex
}
; Return value of last object
return $json(%object,$($ $+ %propertyIndex,2)).text
}
; Hash table layout:
; Name: json.<ticks><rand1,4294967295>
; Key: Name of json property
; Value <N> <value>
; N: 1 = pointer to another object, 3 = raw value
; 2 = <pointer to data array> <pointer to assoc array indicating types of data array>
; $json.proxyrecurse(idname, param1, param2)
alias -l json.proxyrecurse2 {
; json.debug Recurse on: return $($+($,$1,$chr(40),$2,$chr(44),$3,$chr(41)),1)
return $($+($,$1,$chr(40),$2,$chr(44),$3,$chr(41)),2)
}
; /json.freeall <type> <value>
alias json.freeall {
if (!$isid) {
noop $json.proxyrecurse2(json.freeall,$1,$2-)
return
}
json.debug ?4freeall $1-
; For binary data, just return
if ($1 == 3) {
return
}
; For arrays, call on each element then hfree tables
elseif ($1 == 2) {
var %datatable = $gettok($2,1,32)
var %typetable = $gettok($2,2,32)
json.debug FreeAll: Freeing array, datatable: %datatable - typetable: %typetable
var %i = 0
while ($hget(%typetable,%i)) {
var %elementType = $ifmatch
if (%elementType == 3) {
inc %i
continue
}
noop $json.proxyrecurse2(json.freeall,%elementType,$hget(%datatable,%i))
inc %i
}
.hfree %datatable
.hfree %typetable
}
; For objects, call on every property then hfree table
elseif ($1 == 1) {
var %i = 1
while ($hget($2,%i).item) {
inc %i
var %item = $ifmatch
if (type.* iswm %item) {
var %membername = $gettok(%item,2-,$asc(.))
noop $json.proxyrecurse2(json.freeall,$hget($2,%item), $hget($2,value. $+ %membername))
}
}
.hfree $2
}
}
; Parses an array, object, string or int, depending on the next character, and returns <type> <value>
; or returns "ERROR <error>
alias -l json.parseany {
; Now, read the value of the property
if ($bvar($1,1) == $json.chars().STRING_START) {
json.debug Parseany detected a string
var %strVal = $json.parsestring($1)
if (%strVal isnum) {
json.debug Error parsing string: %error
return ERROR %strVal
}
json.debug ParseAny: Read string value: $bvar(%strval,1-).text
return 3 %strval
}
elseif ($bvar($1,1) == $json.chars().OBJECT_START) {
json.debug ParseAny: detected an object
var %obj = $json.parseobject($1)
if (%obj isnum) { json.debug ParseAny: Error reading object subvalue ( $+ %obj $+ ) | return ERROR %obj }
json.debug ParseAny: Read object subvalue as %obj
return 1 %obj
}
elseif ($bvar($1,1) == $json.chars().ARRAY_START) {
json.debug Parseany detected an array
var %array = $json.parsearray($1)
if (%array isnum) {
json.debug ParseAny: error reading array subvalue: %array
return ERROR %array
}
json.debug ParseAny: Read array subvalue as %array
return 2 %array
}
elseif ($bvar($1,1,4).text == null) {
json.debug ParseAny found NULL value
json.trimstart $1 4
return 3 $null
}
elseif ($bvar($1,1,5).text == false || $bvar($1,1,4).text == true) {
var %value = $iif($bvar($1,1,5).text == false,$false,$true)
; if true, trim 'true' off the top, otherwise trim 'false'
if (%value) { json.trimstart $1 4 }
else { json.trimstart $1 5 }
json.debug ParseAny found bool value: %value
return 3 %value
}
; Must be an int
else {
var %int = $json.parseint($1)
if (%int isnum) {
json.debug Error reading int subvalue: %int
return ERROR %int
}
if ($bvar(%int,0) == 0) {
return ERROR $json.errors().UNEXPECTED_CHAR
}
json.debug Read int subvalue into var %int as $bvar(%int,1-).text
return 3 %int
}
}
; $json.parseobject(&binvar) - returns object name or error code
alias -l json.parseobject {
if ($bvar($1,1) == $json.chars().OBJECT_START) {
; Trim off {
json.trimstart $1 1
}
var %table = $json.createtable
var %error = 0
:property
noop $json.consumewhitespace($1)
if ($bvar($1,1) != $json.chars().STRING_START) { %error = $json.errors().EXPECTED_START | goto return }
; Property name
var %strPropName = $json.parsestring($1)
if (%strPropName isnum) { json.debug Error reading property name for object $1 }
else {
%strPropName = $bvar(%strPropName,1-).text
json.debug ParseObject: Read property %strPropName
noop $json.consumewhitespace($1)
if ($bvar($1,1) != $json.chars().MAPPING) { %error = $json.errors().EXPECTED_MAPPING | goto return }
; trim the mapping character
json.trimstart $1 1
noop $json.consumewhitespace($1)
var %any = $json.parseany($1)
var %type = $gettok(%any,1,32)
var %value = $gettok(%any,2-,32)
if (%type == ERROR) {
%error = %value
goto return
}
if (%type == 3) {
; rvalue
hadd %table type. $+ %strPropName 3
if (%value == $true || %value == $false) {
json.debug PasrseObject; Found boolean value for %strPropName : %value
hadd %table value. $+ %strPropName %value
}
elseif (!$bvar(%value,0)) {
hadd %table value. $+ %strPropName $null
}
else {
hadd -b %table value. $+ %strPropName %value
}
}
else if (%type == 2) {
; Arrays
json.debug Read array %strPropName as %value for object %table
hadd %table type. $+ %strPropName 2
; Add array hashtable
hadd %table value. $+ %strPropName %value
}
else if (%type == 1) {
hadd %table type. $+ %strPropName 1
; Add object naem to table
hadd %table value. $+ %strPropName %value
}
}
; Check to see if there are more properties
noop $json.consumewhitespace($1)
if ($bvar($1,1) == $json.chars().OBJECT_END) { json.debug Successful object parsing. | json.trimstart $1 1 | goto return }
elseif ($bvar($1,1) == $json.chars().DELIMITER) { json.trimstart $1 1 | goto property }
else { return $json.errors().UNEXPECTED_CHAR }
:return
if (%error) {
json.debug ParseObject Exiting with error %error
json.freeall 1 %table
return %error
}
return %table
}
; $json.parsestring(&binvar) - returns string (binvar) or error code
alias -l json.parsestring {
var %bv = $json.createbvar
if ($bvar($1,1) != $json.chars().STRING_START) { return $json.errors().EXPECTED_START }
json.trimstart $1 1
var %escape = 0
:loop
if ($bvar($1,1) == $json.chars().STRING_ESCAPE) {
if (%escape) {
; If the escape character is escaped, append it
dec %escape
goto append
}
else {
inc %escape
; Skip appending
goto trim
}
}
if (%escape) {
if ($bvar($1,1) == $asc(r)) { bset $1 1 $cr | dec %escape }
if ($bvar($1,1) == $asc(n)) { bset $1 1 $lf | dec %escape }
if ($bvar($1,1) == $asc(t)) { bset $1 1 9 | dec %escape }
if ($bvar($1,1) == $asc(b)) { bset $1 1 8 | dec %escape }
}
:append
; If we're at the end of a string and not escaped, bail out
if ($bvar($1,1) == $json.chars().STRING_END && !%escape) {
json.trimstart $1 1
bset %bv $calc($bvar(%bv,0) +1) 0
return %bv
}
; Add this character to the end
bset %bv $calc($bvar(%bv,0) +1) $bvar($1,1)
if (%escape) { dec %escape }
:trim
; Trim from the start
json.trimstart $1 1
; Make sure we haven't consumed all the input
if ($bvar($1,0)) {
goto loop
}
return %bv
}
; $json.parseint(&binvar) - returns an int or error code
alias -l json.parseint {
var %bv = &json.createbvar
; Lax on the number format since its a string for us anyway
while ($bvar($1,1).text isnum || $bvar($1,1) == $asc(.) || $bvar($1,1) == $asc(-) || $bvar($1,1) == $asc(+) || $bvar($1,1) == $asc(e)) {
bset %bv $calc($bvar(%bv,0) +1) $bvar($1,1)
json.trimstart $1 1
}
return %bv
}
; $json.parsearray - returns array tables (data, types) or error code
alias -l json.parsearray {
if ($bvar($1,1) != $json.chars().ARRAY_START) {
return $json.errors().EXPECTED_START
}
json.trimstart $1 1
; Create a linked list for the data
var %datatable = $json.createtable(1)
; Create a linked list for the types (associative with respect to the data list)
var %typetable = $json.createtable(1)
noop $json.consumewhitespace($1)
if ($bvar($1,1) == $json.chars().ARRAY_END) {
json.debug Parsed empty array successfully
json.trimstart $1 1
return %datatable %typetable
}
:member
noop $json.consumewhitespace($1)
; Parse members
var %any = $json.parseany($1)
var %type = $gettok(%any,1,32)
var %value = $gettok(%any,2-,32)
if (%type == ERROR) {
json.debug Error parsing array member: %value
json.freeall 2 %datatable %typetable
return %value
}
else {
; 0 indexed
var %newindex = $calc($hget(%datatable,0).item)
; Binary data
json.debug ParseArray: Add type %type array index %newindex as %value
if (%type == 3) {
hadd -b %datatable %newindex %value
}
else {
hadd %datatable %newindex %value
}
hadd %typetable %newindex %type
}
noop $json.consumewhitespace($1)
if ($bvar($1,1) == $json.chars().DELIMITER) {
json.trimstart $1 1
goto member
}
elseif ($bvar($1,1) == $json.chars().ARRAY_END) {
json.debug Parsed array successfully
json.trimstart $1 1
return %datatable %typetable
}
:exit
json.debug ParseArray failed with an unknown error. Read characters: $bvar($1,1)
json.freeall 2 %datatable %typetable
return $json.errors().UNEXPECTED_CHAR
}
; $json.consumewhitespace(&binvar) - returns number consumed
alias -l json.consumewhitespace {
while ($bvar($1,0) && ($bvar($1,1) == 32 || $bvar($1,1) == 9 || $bvar($1,1) == 160 || $bvar($1,1) == 10 || $bvar($1,1) == 13)) {
json.trimstart $1 1
}
}
; /json.trimstart &binvar length - trims length characters from the start of $binvar
alias -l json.trimstart {
; json.debug Trimstart: $1 $2 -- Size of bvar: $bvar($1,0)
if ($bvar($1,0) == 1) { bunset $1 }
else { bcopy -c $1 1 $1 $calc($2 +1) -1 }
}
; $json.getpropery(table, property).type - Returns number representing type of property
; $json.getproperty(table, property).value - Returns value of property
; $json.getproperty(table, property).bvar - Returns value of property as bvar
; $json.getproperty(table, property).arraytypetable - If property is array, returns its type table
; $json.getproperty(table, property).arraydatatable - If property is table,r eturns its data table
alias -l json.getproperty {
var %type = $hget($1,type. $+ $2)
var %value = $hget($1,value. $+ $2)
if ($prop == type) { return %type }
if ($prop == bvar) { noop $hget($1, value. $+ $2, &bvReturn) | return &bvReturn }
if ($prop == arraytypetable) { return $gettok(%value,2,32) }
if ($prop == arraydatatable) { return $gettok(%value,1,32) }
return %value
}
; $json.createtable - Creates a hashtable and returns its name
; $json.createtable(N) - gives it size N
alias -l json.createtable {
var %ticks = $ticks
var %rand = $rand(1,4294967295)
var %table = $+(json.,%ticks,.,%rand)
hmake %table $iif($1,$1,10)
return %table
}
; Creates a random binvar name to avoid collisions
alias -l json.createbvar {
var %ticks = $ticks
var %rand = $rand(1,4294967295)
var %bv = $+(&jsonbv.,%ticks,.,%rand)
return %bv
}
alias -l json.chars {
; {
if ($prop == OBJECT_START) { return 123 }
; }
if ($prop == OBJECT_END) { return 125 }
; "
if ($prop == STRING_START || $prop == STRING_END) { return 34 }
if ($prop == STRING_ESCAPE) { return $asc(\) }
if ($prop == ARRAY_START) { return $asc([) }
if ($prop == ARRAY_END) { return $asc(]) }
; ,
if ($prop == DELIMITER) { return 44 }
if ($prop == MAPPING) { return $asc(:) }
}
alias -l json.errors {
if ($prop == EXPECTED_START) { return 1 }
if ($prop == EXPECTED_END) { return 2 }
if ($prop == EXPECTED_DELIMITER) { return 3 }
if ($prop == EXPECTED_MAPPING) { return 4 }
if ($prop == UNEXPECTED_CHAR) { return 5 }
return 255
}
alias -l json.debug {
; echo -atg Debug: $1-
}

MJSON

2015-05-22T19:30:39Z

Aca20031: +mjson

MHTTP

2015-04-02T16:19:48Z

Aca20031: pathIndex should be a local variable

Often times you may want to download a web page from the internet using HTTP, but HTTP can be complicated. This script handles most of the basics for you including
* URL Parsing
* SSL
* Cookies
* Sending POST data
* Following redirects
* Handling CHUNKED encoding

Typical usage simply involves using the /http.open, save and close commands to download a file, and creating a signal event to do something with it once it is done.
== Example ==
alias DownloadGooglesLogo {
http.open google https://www.google.com/images/srpr/logo11w.png
http.save -f google logo.png
}
on *:SIGNAL:http: {
if ($1 == google) {
if ($2 == SAVED) { run $3- }
if ($2 == PROGRESS) { echo -atg Download progress: $bytes($3).suf $+ / $+ $bytes($4).suf downloaded }
}
}

== Script ==
; Ben's (ben@st0rm.net) HTTP for mIRC script (mHTTP)
; Used to download over HTTP
; Basic usage
; /http.open [name] <URL>
; Opens an HTTP handle for the given URL
; /http.save [-f] <name> <file|bvar>
; Downloads a given HTTP resource to the given file or binvar
; -f forces the file to be overwritten
; /http.close <name>
; Closes and HTTP handle for the given URL
;
; Here are some things you can do after opening a handle, but before saving it
; Manage POST data:
; /http.addpost <handle> <variable> <value>
; /http.delpost <handle> <variable>
; Manage cookies
; /http.addcookie <handle> <value>
; $http.cookie(handle,N) - gets Nth cookie
;
; After a request completes (e.g. after a save) you can get some data:
; $http.responseheader(handle, header, N) - Returns value of given responseheader, or $false. Only useful after a request is made
;
; You can mark a socket with data of your choice (it's a transparent write to a hashtable) similar to sockmark
; /http.mark <handle> [data] - Writes the data. Specify no data to delete the mark
; $http.mark(handle) - Reads the data
;
; Signals
; In order to tell via script when something happens (your file is being saved, for example) use
; on *:SIGNAL:http:
; where $1 = Handle name, $2 = Event name, $3- = parameters
; Events:
; COMPLETED <statuscode> - when a request completes
; SAVED <location> - when a save completes
; REDIRECT <location> - when a request is redirected elsewhere
; PROGRESS <bytes> [total size] - When part but not all of the data is downloaded. Total size is not available for chunked transfer
;
;
; Known issues:
; Cookies do not respect attributes such as domain, path, expiration, or secure. They area always sent
; Relative redirects don't work, only absolute
; Redirects from insecure to secure links when you don't have SSL will not be handled well
; Creates a request that when completed is saved to a file
alias http.save {
if ($1 == -f) {
var %force = $true
tokenize 32 $2-
}
else { var %force = $false }
if ($0 < 2) {
echo -atg * /http.save: Use /http.save <http handle> <file>
return
}
var %hashtable = http. $+ $1
if (!$hget(%hashtable)) {
echo -atg * /http.save: No such HTTP handle exists. Use /http.open first
return
}
if ($sock(%hashtable)) {
echo -atg * /http.save: There is a pending request for this HTTP handle already. A connection is open the the remote host. Close it, or wait for it to complete
return
}
var %destination = $2-
if ($exists(%destination)) {
if (%force) {
.remove %destination
}
else {
echo -atg * /http.save: File already exists. Try /http.save -f to force an overwrite
return
}
}
if (&* iswm %destination) {
.hadd %hashtable bvarout %destination
}
else {
; Open file handler stream for writing
.fopen -n %hashtable %destination
if ($ferr) {
echo -atg * /http.save: Could not use file. Error: $ferr
return
}
; Store fstream name in hashtable to indicate that we want to save this once it completes
.hadd %hashtable fstream %hashtable
}
; Set redirect counter to 0
.hadd %hashtable redirects 0
; Start socket
http.sockstart %hashtable
}
alias http.mark {
var %hashtable = http. $+ $1
if ($isid) {
; As an identifier, read the mark
return $hget(%hashtable,mark)
}
else {
; As a command, set the mark
if (!$hget(%hashtable)) {
echo -atg * /http.mark - No such handle $1
}
elseif (!$2) {
.hdel %hashtable mark
}
else {
.hadd %hashtable mark $2-
}
}
}
; Opens socket
alias -l http.sockstart {
if ($hget($1,secure) == $true) {
if ($sock($1) && $sock($1).ssl) {
http.sendrequest $1
}
else {
if ($sock($1)) { .sockclose $1 }
if (!$sslready) {
echo -atg HTTP Error - request $qt($right($1,-5)) would require you to use SSL but you are not SSL ready. Please see http://mirc.com/ssl.html
http.close $right($1,-5)
return
}
sockopen -e $1 $hget($1, host) $hget($1, port)
}
}
else {
if ($sock($1)) {
http.sendrequest $1
}
else {
sockopen $1 $hget($1, host) $hget($1, port)
}
}
}
; Sends the request. Assumes the socket is open and ready
alias -l http.sendrequest {
if (!$sock($1)) { echo -atg HTTP Internal error. Socket not open in /http.sendrequest | return }
var %inname = $1
var %exname = $right($1,-5)
; Cleanup from previous requests
.hdel %inname responseheaders
.hdel %inname body
.hdel %inname contentlength
.hdel %inname chunkleft
; Get POST binvar
var %postBV = $http.postdata(%inname)
; Use GET if there's no post data, POST otherwise
if ($bvar(%postBV,0) == 0) {
sockwrite -n %inname GET $hget(%inname,path) HTTP/1.1
}
else {
sockwrite -n %inname POST $hget(%inname,path) HTTP/1.1
}
; Send the host
sockwrite -n %inname Host: $hget(%inname,host)
; Send the user-agent
sockwrite -n %inname User-agent: $hget(%inname,user-agent)
sockwrite -n %inname Connection: Keep-Alive
; Only plain-text supported
sockwrite -n %inname Accept: text/plain; q=0.5, text/html
; Send cookies
if ($http.cookie(%exname, 0) > 0) {
sockwrite %inname Cookie: $+ $chr(32)
var %i = 1
while ($http.cookie(%exname, %i)) {
sockwrite %inname $http.urlencode($ifmatch) $+ ;
inc %i
}
sockwrite -n %inname
}
; If POST send content type and length
if ($bvar(%postBV,0) > 0) {
sockwrite -n %inname Content-Type: application/x-www-form-urlencoded
sockwrite -n %inname Content-Length: $v1
}
; End request headers with empty line
sockwrite -n %inname
; If POST, send data
if ($bvar(%postBV,0) > 0) {
sockwrite %inname %postBV
; sockwrite -n %inname
}
}
; Just some bookeeping in case we miss it
on *:SOCKCLOSE:http.*: {
if ($fopen($sockname)) { .fclose $sockname }
}
on *:SOCKOPEN:http.*: {
http.sendrequest $sockname
}
on *:SOCKREAD:http.*: {
if ($sockerr > 0) {
echo -atg * HTTP handle $qt($right($sockname,-5)) failed with socket error $sockerr
http.close $right($sockname,-5)
return
}
;Read all the data into &bvTemp
:read
; First, read this buffer
sockread &bvThis
if ($sockbr > 0) {
; If data was read, copy it to the on-going buffer and continue
bcopy &bvTemp $calc($bvar(&bvTemp,0) +1) &bvThis 1 -1
goto read
}
if ($bvar(&bvTemp,0) == 0) { echo -atg HTTP sockread called with no data to read... | return }
; Do we need to parse headers?
; If response headers not set, this call has the headers
if (!$hget($sockname,responseheaders)) {
; Find the response headers
var %end = $bfind(&bvTemp,1, 13 10 13 10)
if (%end == 0) { echo -atg Error: No headers found, but no content length so this can't be a subsequent call | return }
; Increase to include the 3 extra characters
inc %end 3
bcopy &bvResponseHeaders 1 &bvTemp 1 %end
; If there's still non-header data copy it over
if (%end < $bvar(&bvTemp, 0)) {
bcopy -c &bvTemp 1 &bvTemp $calc(%end + 1) -1
}
else { bunset &bvTemp }
; If this is the first header response, save in hash table
if (!$hget($sockname, responseheaders)) {
.hadd -b $sockname responseheaders &bvResponseHeaders
http.OnHeaders $sockname
}
}
; there's no more to read, bail
if (!$bvar(&bvTemp,0)) {
; If that's all this response has to offer, we're done
if ($hget($sockname,contentlength) == 0) {
http.ondone $sockname
}
return
}
; Read body
var %contentlength = $hget($sockname,contentlength)
if (%contentlength == $null || %contentlength == $false) {
var %chunked = $true
}
else {
var %chunked = $false
}
; Set bvBody to the body ready so far
if ($hget($sockname,body)) {
noop $hget($sockname, body, &bvBody)
}
if (%chunked) {
:readChunk
var %chunkleft = $hget($sockname, chunkleft)
if (!%chunkleft) {
; If we've read all of a chunk, or this is the first one, get its size
var %crlf = $bfind(&bvTemp, 1, 13 10)
if (!%crlf) {
echo -atg HTTP internal error. Handle $qt($right($sockname,-5)) is in chunked encoding but no chunk size found in data
return
}
var %chunkleft = $base($bvar(&bvTemp, 1, $calc(%crlf - 1)).text,16,10)
if (%chunkleft !isnum) {
echo -atg HTTP internal error. Handle $qt($right($sockname,-5)) has invalid chunk size: %chunkleft
}
; New chunk
else {
; Save chunk size and remove it (plus its \r\n) from temp
.hadd $sockname chunkleft %chunkleft
.bcopy -c &bvTemp 1 &bvTemp $calc(%crlf +2) -1
if (%chunkLeft == 0) {
; if we just read chunk size 0, that was the end.
.hadd -b $sockname body &bvBody
http.onDone $sockname
return
}
}
}
; read %chunkleft bytes
var %bytesToRead = $iif(%chunkLeft < $bvar(&bvTemp,0),%chunkLeft, $bvar(&bvTemp,0))
.bcopy &bvBody $calc($bvar(&bvBody,0) +1) &bvTemp 1 %bytesToRead
hdec $sockname chunkleft %bytesToRead
.signal http $right($sockname,-5) PROGRESS %bytesToRead
if (%bytesToRead == %chunkLeft) {
; If this is the end of the chunk, consume crlf
inc %bytesToRead 2
; If there's still stuff in this var, go back and read the new chunk
if (%bytesToRead < $bvar(&bvTemp,0)) {
.bcopy -c &bvTemp 1 &bvTemp $calc(%bytesToRead + 1) -1
goto readChunk
}
}
; End of this call, save body in hashtable for future calls
.hadd -b $sockname body &bvBody
}
else {
; Copy everything
.bcopy &bvBody $calc($bvar(&bvBody,0) +1) &bvTemp 1 -1
; Add read-so-far body to hashtable
.hadd -b $sockname body &bvBody
.signal http $right($sockname,-5) PROGRESS $bvar(&bvBody,0) $hget($sockname,contentlength)
; Check if we're done
if ($bvar(&bvBody,0) >= $hget($sockname,contentlength)) {
; We're done
http.onDone $sockname
if ($bvar(&bvBody,0) > $hget($sockname,contentlength)) {
echo -qatg HTTP Warning: Read past content-length.
}
}
}
}
; Internal event called when we get the first header response from the server
alias -l http.OnHeaders {
noop $hget($1,responseheaders, &bvResponseHeaders)
; First header is always the status response
var %end = $bfind(&bvResponseHeaders, 1, 13 10)
if (%end <= 1) {
echo -atg Error: HTTP $qt($right($1,-5)) Server did not respond with HTTP status
goto cleanup
}
var %status = $bvar(&bvResponseHeaders,1,$calc(%end - 1)).text
.hadd $1 responsestatus %status
var %version = $gettok(%status,1,32)
if (%version != HTTP/1.1 && %version != HTTP/1.0) {
echo -atg Error: HTTP $qt($right($1,-5)) Server indicated unknown version: %version
goto cleanup
}
var %statuscode = $gettok(%status,2,32)
if (%statuscode !isnum) {
echo -atg Error: HTTP $qt($right($1,-5)) Server indicated invalid status code: %statuscode
goto cleanup
}
; Check transfer type
if ($http.responseheader($right($1,-5),Content-Length,1) != $null) {
hadd $1 contentlength $v1
}
elseif ($http.responseheader($right($1,-5), Transfer-Encoding, 1) != chunked) {
echo -atg HTTP Handle $qt($right($1,-5)) has no content-length header and is not chunked
echo -atg $bvar(&bvResponseHeaders,1-).text
return
}
; Add any cookies that were set
var %cookie = 1
while ($http.responseheader($right($1,-5), Set-Cookie, %cookie)) {
inc %cookie
var %cookieValue = $gettok($ifmatch,1,$asc(;))
http.addcookie $right($1,-5) %cookieValue
}
; Handle redirects
if (%statuscode == 303 || %statuscode == 302 || %statuscode == 307) {
var %location = $http.responseheader($right($1,-5), Location)
.signal http $right($1,-5) REDIRECT %location
http.seturl $1 %location
hinc $1 redirects
; If the server doesn't promise us this connection is keep-alive, close it and use a new one
if ($http.responseheader($right($1,-5), Connection, 1) != Keep-Alive) {
if ($sock($1)) { .sockclose $1 }
}
if ($hget($1, redirects) > 5) {
echo -atg HTTP Handle $qt($right($1,-5)) redirect loop detected
return
}
http.sockstart $1
}
return
:cleanup
if ($sock($1)) { .sockclose $1 }
}
alias http.addcookie {
var %hashtable = http. $+ $1
if (!$hget(%hashtable)) {
echo -atg * /http.addcookie: No such HTTP handle
return
}
if ($0 < 2) {
echo -atg * /http.addcookie: Usage: /http.addcookie <handle> <value>
return
}
var %i = 1
var %cookieNum = 1
while ($hget(%hashtable,%i).item) {
var %item = $ifmatch
inc %i
if (cookie-* iswm %item) {
var %tmp = $gettok(%item,2,$asc(-))
; If the value is the same, overwrite
if ($2- == $hget(%hashtable,%item)) {
%cookieNum = %tmp
break
}
; Otherwise store max cookie num
elseif (%tmp >= %cookieNum) { %cookieNum = $calc(%tmp + 1) }
}
}
.hadd %hashtable cookie- $+ %cookieNum $+ -value $2-
}
; Gets an HTTP cookie for the given handle
; $http.cookie(<handle>, <index>)
alias http.cookie {
if ($2 !isnum) {
echo -atg * $!http.cookie invalid parameters
return
}
var %hashtable = http. $+ $1
if (!$hget(%hashtable)) {
echo -atg * $!http.cookie no such HTTP handle
return
}
var %i = 1
var %found = 0
while ($hget(%hashtable, %i).item) {
inc %i
var %item = $ifmatch
if (cookie-*-value iswm %item) {
inc %found
var %id = $gettok(%item,2,$asc(-))
if (%found == $2) {
return $hget(%hashtable, cookie- $+ %id $+ -value)
}
}
}
if ($2 == 0) { return %found }
}
; Returns the value of the given response header
; Case sensitive since it is binary variable operation
alias http.responseheader {
if ($0 < 2) {
echo -atg Invalid usage. Use: $http.responseheader(<handle>, <header>[, index])
return
}
; %index is parameter 3 - 1-N or 0 for number
var %index = 1
if ($3 isnum) {
%index = $3
}
; Veriy hash table exists
var %table = http. $+ $1
if (!$hget(%table,responseheaders)) { return $false }
noop $hget(%table,responseheaders, &bvResponseHeaders))
; Set up parameters for the header search
; Offset is where we start searching from in the loop
; thisIndex is the number of matches found so far
var %offset = 1
var %thisIndex = 0
; The main search loop
:search
var %start = $bfind(&bvResponseHeaders, %offset, $2 $+ :).text
; If there isn't another match, either the index was too large or they want the count
if (!%start) {
if (%index == 0) { return %thisIndex }
else { return $false }
}
; Find the end of the header
var %end = $bfind(&bvResponseHeaders, %start, 13 10)
if (%end <= %start) { echo -atg HTTP Internal error ($http.responseheader), header $qt($2) for handle $qt($1) has no CRLF termination | return $false }
inc %thisIndex
; If this not the one they asked for, try again starting from the end of this header
if (%index != %thisIndex) {
var %offset = %end
goto search
}
; Find the colon. If there isn't one we'll return the whole string
if ($calc($bfind(&bvResponseHeaders, %start, $asc(:)) +1) < %end) {
%start = $v1
}
return $bvar(&bvResponseHeaders,%start, $calc(%end - %start)).text
}
; Internal event called when a request is filled. $1 = internal handle name
alias -l http.onDone {
if ($hget($1,responseheaders)) {
noop $hget($1,responseheaders,&bvResponseHeaders)
}
; Write out and close filestream if set
if ($hget($1,fstream)) {
noop $hget($1,body,&bvBody)
if (!$bvar(&bvBody,0)) {
.fclose $hget($1,fstream)
}
else {
.fwrite -b $hget($1,fstream) &bvBody
; Save fname so we can use it in the signal after the close
var %fname = $fopen($hget($1,fstream)).fname
.fclose $hget($1,fstream)
.signal http $right($1,-5) SAVED %fname
}
}
; If socket is still around, close it
if ($sock($1)) { .sockclose $1 }
; Reset redirects for future calls
.hadd $1 redirects 0
.signal HTTP $right($1,-5) COMPLETED $hget($1,responsestatus)
if ($hget($1, bvarout)) {
noop $hget($1,body,&bvBody)
var %bvarout = $ifmatch
bcopy %bvarout 1 &bvBody 1 -1
; Need to use -n so that the binvar is still in scope
; So we need to do this last
.signal -n http $right($1,-5) SAVED %bvarout
}
}
alias http.open {
var %hashtable
; If two parameters are given, $1 is the name, else create a new name
if ($0 > 1) { %hashtable = http. $+ $1 }
else {
var %h = $calc($ticks % $rand(1,1000000))
var %hashtable = http. $+ %h
}
if ($hget(%hashtable)) {
echo -atg * /http.open: HTTP Request $qt($1) already exists
return
}
; Encode the octects of the URL. e.g.: foo bar,pie --> foo%20bar,%2Cpie
var %url = $iif($0 > 1, $2-, $1-)
var %urlEncoded = $http.urlencode(%url)
; Check the URL
if (!$http.urlparse(%urlEncoded)) {
echo -atg * /http.open: Malformed URL. Use /http.open [name] <url>
return
}
if ($http.urlparse(%urlEncoded).secure && !$sslready) {
echo -atg * /http.open: URL is SSL but $!sslready = false. See http://www.mirc.com/ssl.html
return
}
; Everything checks out, let's store the relevent bits in a hashtable
.hmake %hashtable 10
http.seturl %hashtable %url
echo -qatg * /http.open: Opened HTTP request $qt($right(%hashtable,-5))
}
alias -l http.seturl {
if ($0 < 2) { echo -atg HTTP Internal error, seturl called with no url }
var %hashtable = $1
if (!$hget(%hashtable)) { echo -atg HTTP Internal error, seturl called with invalid handle }
var %urlEncoded = $http.urlencode($2-)
.hadd %hashtable host $http.urlparse(%urlEncoded).host
.hadd %hashtable port $http.urlparse(%urlEncoded).port
.hadd %hashtable secure $http.urlparse(%urlEncoded).secure
.hadd %hashtable path $http.urlparse(%urlEncoded).path
.hadd %hashtable user-agent mIRC $version
}
alias http.list {
var %i = 1
var %numFound = 0
while (%i <= $hget(0)) {
var %table = $hget(%i)
inc %i
if (http.* iswm %table) {
inc %numFound
echo -atg * $right(%table,-5) $+ : Host: $hget(%table,host) Port: $hget(%table,port) Path: $hget(%table,path)
}
}
if (%numFound == 0) { echo -atg * No HTTP handles opened }
}
alias http.close {
var %i = 1
var %numFound = 0
while (%i <= $hget(0)) {
var %table = $hget(%i)
if (http. $+ $1 iswm %table) {
; Cleanup resources
if ($sock(%table)) { .sockclose %table }
if ($fopen(%table)) { .fclose %table }
if ($hget(%table $+ .postdata)) { .hfree %table $+ .postdata }
.hfree %table
inc %numFound
echo -qatg * HTTP Closed $right(%table,-5)
}
; Only inc if we didnt find a match
else {
inc %i
}
}
if (%numFound == 0) { echo -qatg * No matching HTTP handles }
}
;
; Takes an encoded URL and returns based on the property
; .secure - true if https
; .host - the URL host
; .port - the port, 80 by default
; .path - The path to download, / by default
; Returns $false is URL is malformed
;
alias http.urlparse {
var %secure
var %host
var %port
var %path
var %pathIndex
var %protocol
var %regex = /^(https?://)?([a-z.0-9\-_]+)(:\d+)?(/.*)?$/i
if ($regex($1, %regex)) {
if (http*:// iswm $regml(1)) {
%protocol = $lower($left($regml(1),-3))
}
%secure = $false
if (%protocol == https) {
%secure = $true
}
if (%protocol) { %host = $regml(2) }
else { %host = $regml(1) }
var %portIndex = $iif(%protocol, 3, 2)
var %portfound = $false
if ($left($regml(%portIndex),1) == : && $right($regml(%portIndex),-1) isnum) {
%port = $right($regml(%portIndex),-1)
%portFound = $true
}
else {
if (%secure) {
%port = 443
}
else {
%port = 80
}
}
%pathIndex = $iif(%portFound, $calc(%portIndex + 1), %portIndex)
if ($regml(0) >= %pathIndex) {
%path = $regml(%pathIndex)
}
else { %path = / }
}
else { return $false }
if ($prop == secure) { return %secure }
if ($prop == host) { return %host }
if ($prop == path) { return %path }
if ($prop == port) { return %port }
return $true
}
alias http.addpost {
if ($0 < 3) {
echo -atg * /http.addpost: Usage: /http.addpost <handle> <variable> <value>
return
}
var %maintable = http. $+ $1
var %posttable = %maintable $+ .postdata
if (!$hget(%maintable)) {
echo -atg * /http.addpost: No such HTTP handle found
return
}
if (!$hget(%posttable)) { .hmake %posttable 10 }
hadd %posttable $2 $3-
echo -qatg Post variable added: $2 $+ = $+ $3-
}
alias http.delpost {
if ($0 < 2) {
echo -atg * /http.delpost: Usage: /http.delpost <handle> <variable>
return
}
var %maintable = http. $+ $1
var %posttable = %maintable $+ .postdata
if (!$hget(%maintable)) {
echo -atg * /http.addpost: No such HTTP handle found
return
}
if (!$hget(%posttable,$2)) {
echo -qatg * /http.addpost: No post variable with that name exists
return
}
hdel %posttable $2
echo -qatg Post variable deleted: $2
}
; Usage: $http.postdata(handle)
; Returns a binvar with a post data style query string (x=y&z=a) or $false
alias http.postdata {
; Post data is stored in INNAME.postdata
var %posttable = http. $+ $1 $+ .postdata
if (!$hget(%posttable,0).item) { return $false }
var %i = 1
while ($hget(%posttable,%i).item) {
var %item = $ifmatch
bset -t &bvPost $calc($bvar(&bvPost,0) +1) $iif(%i > 1,&,) $+ $http.urlencode(%item) $+ = $+ $http.urlencode($hget(%posttable,%item))
inc %i
}
return &bvPost
}
; Replace some commonly touchy URL characters with their hex-octect encoding
alias -l http.urlencode {
return $replacex($1-,$chr(32),% $+ 20, $chr(44), % $+ 2C,+, % $+ 2B, $chr(37), % $+ 25)
}

{{Author|aca20031}}

[[Category:Script Archive]]

MHTTP

2015-02-22T01:17:18Z

Aca20031: - Extra space

Often times you may want to download a web page from the internet using HTTP, but HTTP can be complicated. This script handles most of the basics for you including
* URL Parsing
* SSL
* Cookies
* Sending POST data
* Following redirects
* Handling CHUNKED encoding

Typical usage simply involves using the /http.open, save and close commands to download a file, and creating a signal event to do something with it once it is done.
== Example ==
alias DownloadGooglesLogo {
http.open google https://www.google.com/images/srpr/logo11w.png
http.save -f google logo.png
}
on *:SIGNAL:http: {
if ($1 == google) {
if ($2 == SAVED) { run $3- }
if ($2 == PROGRESS) { echo -atg Download progress: $bytes($3).suf $+ / $+ $bytes($4).suf downloaded }
}
}

== Script ==
; Ben's (ben@st0rm.net) HTTP for mIRC script (mHTTP)
; Used to download over HTTP
; Basic usage
; /http.open [name] <URL>
; Opens an HTTP handle for the given URL
; /http.save [-f] <name> <file|bvar>
; Downloads a given HTTP resource to the given file or binvar
; -f forces the file to be overwritten
; /http.close <name>
; Closes and HTTP handle for the given URL
;
; Here are some things you can do after opening a handle, but before saving it
; Manage POST data:
; /http.addpost <handle> <variable> <value>
; /http.delpost <handle> <variable>
; Manage cookies
; /http.addcookie <handle> <value>
; $http.cookie(handle,N) - gets Nth cookie
;
; After a request completes (e.g. after a save) you can get some data:
; $http.responseheader(handle, header, N) - Returns value of given responseheader, or $false. Only useful after a request is made
;
; You can mark a socket with data of your choice (it's a transparent write to a hashtable) similar to sockmark
; /http.mark <handle> [data] - Writes the data. Specify no data to delete the mark
; $http.mark(handle) - Reads the data
;
; Signals
; In order to tell via script when something happens (your file is being saved, for example) use
; on *:SIGNAL:http:
; where $1 = Handle name, $2 = Event name, $3- = parameters
; Events:
; COMPLETED <statuscode> - when a request completes
; SAVED <location> - when a save completes
; REDIRECT <location> - when a request is redirected elsewhere
; PROGRESS <bytes> [total size] - When part but not all of the data is downloaded. Total size is not available for chunked transfer
;
;
; Known issues:
; Cookies do not respect attributes such as domain, path, expiration, or secure. They area always sent
; Relative redirects don't work, only absolute
; Redirects from insecure to secure links when you don't have SSL will not be handled well
; Creates a request that when completed is saved to a file
alias http.save {
if ($1 == -f) {
var %force = $true
tokenize 32 $2-
}
else { var %force = $false }
if ($0 < 2) {
echo -atg * /http.save: Use /http.save <http handle> <file>
return
}
var %hashtable = http. $+ $1
if (!$hget(%hashtable)) {
echo -atg * /http.save: No such HTTP handle exists. Use /http.open first
return
}
if ($sock(%hashtable)) {
echo -atg * /http.save: There is a pending request for this HTTP handle already. A connection is open the the remote host. Close it, or wait for it to complete
return
}
var %destination = $2-
if ($exists(%destination)) {
if (%force) {
.remove %destination
}
else {
echo -atg * /http.save: File already exists. Try /http.save -f to force an overwrite
return
}
}
if (&* iswm %destination) {
.hadd %hashtable bvarout %destination
}
else {
; Open file handler stream for writing
.fopen -n %hashtable %destination
if ($ferr) {
echo -atg * /http.save: Could not use file. Error: $ferr
return
}
; Store fstream name in hashtable to indicate that we want to save this once it completes
.hadd %hashtable fstream %hashtable
}
; Set redirect counter to 0
.hadd %hashtable redirects 0
; Start socket
http.sockstart %hashtable
}
alias http.mark {
var %hashtable = http. $+ $1
if ($isid) {
; As an identifier, read the mark
return $hget(%hashtable,mark)
}
else {
; As a command, set the mark
if (!$hget(%hashtable)) {
echo -atg * /http.mark - No such handle $1
}
elseif (!$2) {
.hdel %hashtable mark
}
else {
.hadd %hashtable mark $2-
}
}
}
; Opens socket
alias -l http.sockstart {
if ($hget($1,secure) == $true) {
if ($sock($1) && $sock($1).ssl) {
http.sendrequest $1
}
else {
if ($sock($1)) { .sockclose $1 }
if (!$sslready) {
echo -atg HTTP Error - request $qt($right($1,-5)) would require you to use SSL but you are not SSL ready. Please see http://mirc.com/ssl.html
http.close $right($1,-5)
return
}
sockopen -e $1 $hget($1, host) $hget($1, port)
}
}
else {
if ($sock($1)) {
http.sendrequest $1
}
else {
sockopen $1 $hget($1, host) $hget($1, port)
}
}
}
; Sends the request. Assumes the socket is open and ready
alias -l http.sendrequest {
if (!$sock($1)) { echo -atg HTTP Internal error. Socket not open in /http.sendrequest | return }
var %inname = $1
var %exname = $right($1,-5)
; Cleanup from previous requests
.hdel %inname responseheaders
.hdel %inname body
.hdel %inname contentlength
.hdel %inname chunkleft
; Get POST binvar
var %postBV = $http.postdata(%inname)
; Use GET if there's no post data, POST otherwise
if ($bvar(%postBV,0) == 0) {
sockwrite -n %inname GET $hget(%inname,path) HTTP/1.1
}
else {
sockwrite -n %inname POST $hget(%inname,path) HTTP/1.1
}
; Send the host
sockwrite -n %inname Host: $hget(%inname,host)
; Send the user-agent
sockwrite -n %inname User-agent: $hget(%inname,user-agent)
sockwrite -n %inname Connection: Keep-Alive
; Only plain-text supported
sockwrite -n %inname Accept: text/plain; q=0.5, text/html
; Send cookies
if ($http.cookie(%exname, 0) > 0) {
sockwrite %inname Cookie: $+ $chr(32)
var %i = 1
while ($http.cookie(%exname, %i)) {
sockwrite %inname $http.urlencode($ifmatch) $+ ;
inc %i
}
sockwrite -n %inname
}
; If POST send content type and length
if ($bvar(%postBV,0) > 0) {
sockwrite -n %inname Content-Type: application/x-www-form-urlencoded
sockwrite -n %inname Content-Length: $v1
}
; End request headers with empty line
sockwrite -n %inname
; If POST, send data
if ($bvar(%postBV,0) > 0) {
sockwrite %inname %postBV
; sockwrite -n %inname
}
}
; Just some bookeeping in case we miss it
on *:SOCKCLOSE:http.*: {
if ($fopen($sockname)) { .fclose $sockname }
}
on *:SOCKOPEN:http.*: {
http.sendrequest $sockname
}
on *:SOCKREAD:http.*: {
if ($sockerr > 0) {
echo -atg * HTTP handle $qt($right($sockname,-5)) failed with socket error $sockerr
http.close $right($sockname,-5)
return
}
;Read all the data into &bvTemp
:read
; First, read this buffer
sockread &bvThis
if ($sockbr > 0) {
; If data was read, copy it to the on-going buffer and continue
bcopy &bvTemp $calc($bvar(&bvTemp,0) +1) &bvThis 1 -1
goto read
}
if ($bvar(&bvTemp,0) == 0) { echo -atg HTTP sockread called with no data to read... | return }
; Do we need to parse headers?
; If response headers not set, this call has the headers
if (!$hget($sockname,responseheaders)) {
; Find the response headers
var %end = $bfind(&bvTemp,1, 13 10 13 10)
if (%end == 0) { echo -atg Error: No headers found, but no content length so this can't be a subsequent call | return }
; Increase to include the 3 extra characters
inc %end 3
bcopy &bvResponseHeaders 1 &bvTemp 1 %end
; If there's still non-header data copy it over
if (%end < $bvar(&bvTemp, 0)) {
bcopy -c &bvTemp 1 &bvTemp $calc(%end + 1) -1
}
else { bunset &bvTemp }
; If this is the first header response, save in hash table
if (!$hget($sockname, responseheaders)) {
.hadd -b $sockname responseheaders &bvResponseHeaders
http.OnHeaders $sockname
}
}
; there's no more to read, bail
if (!$bvar(&bvTemp,0)) {
; If that's all this response has to offer, we're done
if ($hget($sockname,contentlength) == 0) {
http.ondone $sockname
}
return
}
; Read body
var %contentlength = $hget($sockname,contentlength)
if (%contentlength == $null || %contentlength == $false) {
var %chunked = $true
}
else {
var %chunked = $false
}
; Set bvBody to the body ready so far
if ($hget($sockname,body)) {
noop $hget($sockname, body, &bvBody)
}
if (%chunked) {
:readChunk
var %chunkleft = $hget($sockname, chunkleft)
if (!%chunkleft) {
; If we've read all of a chunk, or this is the first one, get its size
var %crlf = $bfind(&bvTemp, 1, 13 10)
if (!%crlf) {
echo -atg HTTP internal error. Handle $qt($right($sockname,-5)) is in chunked encoding but no chunk size found in data
return
}
var %chunkleft = $base($bvar(&bvTemp, 1, $calc(%crlf - 1)).text,16,10)
if (%chunkleft !isnum) {
echo -atg HTTP internal error. Handle $qt($right($sockname,-5)) has invalid chunk size: %chunkleft
}
; New chunk
else {
; Save chunk size and remove it (plus its \r\n) from temp
.hadd $sockname chunkleft %chunkleft
.bcopy -c &bvTemp 1 &bvTemp $calc(%crlf +2) -1
if (%chunkLeft == 0) {
; if we just read chunk size 0, that was the end.
.hadd -b $sockname body &bvBody
http.onDone $sockname
return
}
}
}
; read %chunkleft bytes
var %bytesToRead = $iif(%chunkLeft < $bvar(&bvTemp,0),%chunkLeft, $bvar(&bvTemp,0))
.bcopy &bvBody $calc($bvar(&bvBody,0) +1) &bvTemp 1 %bytesToRead
hdec $sockname chunkleft %bytesToRead
.signal http $right($sockname,-5) PROGRESS %bytesToRead
if (%bytesToRead == %chunkLeft) {
; If this is the end of the chunk, consume crlf
inc %bytesToRead 2
; If there's still stuff in this var, go back and read the new chunk
if (%bytesToRead < $bvar(&bvTemp,0)) {
.bcopy -c &bvTemp 1 &bvTemp $calc(%bytesToRead + 1) -1
goto readChunk
}
}
; End of this call, save body in hashtable for future calls
.hadd -b $sockname body &bvBody
}
else {
; Copy everything
.bcopy &bvBody $calc($bvar(&bvBody,0) +1) &bvTemp 1 -1
; Add read-so-far body to hashtable
.hadd -b $sockname body &bvBody
.signal http $right($sockname,-5) PROGRESS $bvar(&bvBody,0) $hget($sockname,contentlength)
; Check if we're done
if ($bvar(&bvBody,0) >= $hget($sockname,contentlength)) {
; We're done
http.onDone $sockname
if ($bvar(&bvBody,0) > $hget($sockname,contentlength)) {
echo -qatg HTTP Warning: Read past content-length.
}
}
}
}
; Internal event called when we get the first header response from the server
alias -l http.OnHeaders {
noop $hget($1,responseheaders, &bvResponseHeaders)
; First header is always the status response
var %end = $bfind(&bvResponseHeaders, 1, 13 10)
if (%end <= 1) {
echo -atg Error: HTTP $qt($right($1,-5)) Server did not respond with HTTP status
goto cleanup
}
var %status = $bvar(&bvResponseHeaders,1,$calc(%end - 1)).text
.hadd $1 responsestatus %status
var %version = $gettok(%status,1,32)
if (%version != HTTP/1.1 && %version != HTTP/1.0) {
echo -atg Error: HTTP $qt($right($1,-5)) Server indicated unknown version: %version
goto cleanup
}
var %statuscode = $gettok(%status,2,32)
if (%statuscode !isnum) {
echo -atg Error: HTTP $qt($right($1,-5)) Server indicated invalid status code: %statuscode
goto cleanup
}
; Check transfer type
if ($http.responseheader($right($1,-5),Content-Length,1) != $null) {
hadd $1 contentlength $v1
}
elseif ($http.responseheader($right($1,-5), Transfer-Encoding, 1) != chunked) {
echo -atg HTTP Handle $qt($right($1,-5)) has no content-length header and is not chunked
echo -atg $bvar(&bvResponseHeaders,1-).text
return
}
; Add any cookies that were set
var %cookie = 1
while ($http.responseheader($right($1,-5), Set-Cookie, %cookie)) {
inc %cookie
var %cookieValue = $gettok($ifmatch,1,$asc(;))
http.addcookie $right($1,-5) %cookieValue
}
; Handle redirects
if (%statuscode == 303 || %statuscode == 302 || %statuscode == 307) {
var %location = $http.responseheader($right($1,-5), Location)
.signal http $right($1,-5) REDIRECT %location
http.seturl $1 %location
hinc $1 redirects
; If the server doesn't promise us this connection is keep-alive, close it and use a new one
if ($http.responseheader($right($1,-5), Connection, 1) != Keep-Alive) {
if ($sock($1)) { .sockclose $1 }
}
if ($hget($1, redirects) > 5) {
echo -atg HTTP Handle $qt($right($1,-5)) redirect loop detected
return
}
http.sockstart $1
}
return
:cleanup
if ($sock($1)) { .sockclose $1 }
}
alias http.addcookie {
var %hashtable = http. $+ $1
if (!$hget(%hashtable)) {
echo -atg * /http.addcookie: No such HTTP handle
return
}
if ($0 < 2) {
echo -atg * /http.addcookie: Usage: /http.addcookie <handle> <value>
return
}
var %i = 1
var %cookieNum = 1
while ($hget(%hashtable,%i).item) {
var %item = $ifmatch
inc %i
if (cookie-* iswm %item) {
var %tmp = $gettok(%item,2,$asc(-))
; If the value is the same, overwrite
if ($2- == $hget(%hashtable,%item)) {
%cookieNum = %tmp
break
}
; Otherwise store max cookie num
elseif (%tmp >= %cookieNum) { %cookieNum = $calc(%tmp + 1) }
}
}
.hadd %hashtable cookie- $+ %cookieNum $+ -value $2-
}
; Gets an HTTP cookie for the given handle
; $http.cookie(<handle>, <index>)
alias http.cookie {
if ($2 !isnum) {
echo -atg * $!http.cookie invalid parameters
return
}
var %hashtable = http. $+ $1
if (!$hget(%hashtable)) {
echo -atg * $!http.cookie no such HTTP handle
return
}
var %i = 1
var %found = 0
while ($hget(%hashtable, %i).item) {
inc %i
var %item = $ifmatch
if (cookie-*-value iswm %item) {
inc %found
var %id = $gettok(%item,2,$asc(-))
if (%found == $2) {
return $hget(%hashtable, cookie- $+ %id $+ -value)
}
}
}
if ($2 == 0) { return %found }
}
; Returns the value of the given response header
; Case sensitive since it is binary variable operation
alias http.responseheader {
if ($0 < 2) {
echo -atg Invalid usage. Use: $http.responseheader(<handle>, <header>[, index])
return
}
; %index is parameter 3 - 1-N or 0 for number
var %index = 1
if ($3 isnum) {
%index = $3
}
; Veriy hash table exists
var %table = http. $+ $1
if (!$hget(%table,responseheaders)) { return $false }
noop $hget(%table,responseheaders, &bvResponseHeaders))
; Set up parameters for the header search
; Offset is where we start searching from in the loop
; thisIndex is the number of matches found so far
var %offset = 1
var %thisIndex = 0
; The main search loop
:search
var %start = $bfind(&bvResponseHeaders, %offset, $2 $+ :).text
; If there isn't another match, either the index was too large or they want the count
if (!%start) {
if (%index == 0) { return %thisIndex }
else { return $false }
}
; Find the end of the header
var %end = $bfind(&bvResponseHeaders, %start, 13 10)
if (%end <= %start) { echo -atg HTTP Internal error ($http.responseheader), header $qt($2) for handle $qt($1) has no CRLF termination | return $false }
inc %thisIndex
; If this not the one they asked for, try again starting from the end of this header
if (%index != %thisIndex) {
var %offset = %end
goto search
}
; Find the colon. If there isn't one we'll return the whole string
if ($calc($bfind(&bvResponseHeaders, %start, $asc(:)) +1) < %end) {
%start = $v1
}
return $bvar(&bvResponseHeaders,%start, $calc(%end - %start)).text
}
; Internal event called when a request is filled. $1 = internal handle name
alias -l http.onDone {
if ($hget($1,responseheaders)) {
noop $hget($1,responseheaders,&bvResponseHeaders)
}
; Write out and close filestream if set
if ($hget($1,fstream)) {
noop $hget($1,body,&bvBody)
if (!$bvar(&bvBody,0)) {
.fclose $hget($1,fstream)
}
else {
.fwrite -b $hget($1,fstream) &bvBody
; Save fname so we can use it in the signal after the close
var %fname = $fopen($hget($1,fstream)).fname
.fclose $hget($1,fstream)
.signal http $right($1,-5) SAVED %fname
}
}
; If socket is still around, close it
if ($sock($1)) { .sockclose $1 }
; Reset redirects for future calls
.hadd $1 redirects 0
.signal HTTP $right($1,-5) COMPLETED $hget($1,responsestatus)
if ($hget($1, bvarout)) {
noop $hget($1,body,&bvBody)
var %bvarout = $ifmatch
bcopy %bvarout 1 &bvBody 1 -1
; Need to use -n so that the binvar is still in scope
; So we need to do this last
.signal -n http $right($1,-5) SAVED %bvarout
}
}
alias http.open {
var %hashtable
; If two parameters are given, $1 is the name, else create a new name
if ($0 > 1) { %hashtable = http. $+ $1 }
else {
var %h = $calc($ticks % $rand(1,1000000))
var %hashtable = http. $+ %h
}
if ($hget(%hashtable)) {
echo -atg * /http.open: HTTP Request $qt($1) already exists
return
}
; Encode the octects of the URL. e.g.: foo bar,pie --> foo%20bar,%2Cpie
var %url = $iif($0 > 1, $2-, $1-)
var %urlEncoded = $http.urlencode(%url)
; Check the URL
if (!$http.urlparse(%urlEncoded)) {
echo -atg * /http.open: Malformed URL. Use /http.open [name] <url>
return
}
if ($http.urlparse(%urlEncoded).secure && !$sslready) {
echo -atg * /http.open: URL is SSL but $!sslready = false. See http://www.mirc.com/ssl.html
return
}
; Everything checks out, let's store the relevent bits in a hashtable
.hmake %hashtable 10
http.seturl %hashtable %url
echo -qatg * /http.open: Opened HTTP request $qt($right(%hashtable,-5))
}
alias -l http.seturl {
if ($0 < 2) { echo -atg HTTP Internal error, seturl called with no url }
var %hashtable = $1
if (!$hget(%hashtable)) { echo -atg HTTP Internal error, seturl called with invalid handle }
var %urlEncoded = $http.urlencode($2-)
.hadd %hashtable host $http.urlparse(%urlEncoded).host
.hadd %hashtable port $http.urlparse(%urlEncoded).port
.hadd %hashtable secure $http.urlparse(%urlEncoded).secure
.hadd %hashtable path $http.urlparse(%urlEncoded).path
.hadd %hashtable user-agent mIRC $version
}
alias http.list {
var %i = 1
var %numFound = 0
while (%i <= $hget(0)) {
var %table = $hget(%i)
inc %i
if (http.* iswm %table) {
inc %numFound
echo -atg * $right(%table,-5) $+ : Host: $hget(%table,host) Port: $hget(%table,port) Path: $hget(%table,path)
}
}
if (%numFound == 0) { echo -atg * No HTTP handles opened }
}
alias http.close {
var %i = 1
var %numFound = 0
while (%i <= $hget(0)) {
var %table = $hget(%i)
if (http. $+ $1 iswm %table) {
; Cleanup resources
if ($sock(%table)) { .sockclose %table }
if ($fopen(%table)) { .fclose %table }
if ($hget(%table $+ .postdata)) { .hfree %table $+ .postdata }
.hfree %table
inc %numFound
echo -qatg * HTTP Closed $right(%table,-5)
}
; Only inc if we didnt find a match
else {
inc %i
}
}
if (%numFound == 0) { echo -qatg * No matching HTTP handles }
}
;
; Takes an encoded URL and returns based on the property
; .secure - true if https
; .host - the URL host
; .port - the port, 80 by default
; .path - The path to download, / by default
; Returns $false is URL is malformed
;
alias http.urlparse {
var %secure
var %host
var %port
var %path
var %regex = /^(https?://)?([a-z.0-9\-_]+)(:\d+)?(/.*)?$/i
if ($regex($1, %regex)) {
if (http*:// iswm $regml(1)) {
%protocol = $lower($left($regml(1),-3))
}
%secure = $false
if (%protocol == https) {
%secure = $true
}
if (%protocol) { %host = $regml(2) }
else { %host = $regml(1) }
var %portIndex = $iif(%protocol, 3, 2)
var %portfound = $false
if ($left($regml(%portIndex),1) == : && $right($regml(%portIndex),-1) isnum) {
%port = $right($regml(%portIndex),-1)
%portFound = $true
}
else {
if (%secure) {
%port = 443
}
else {
%port = 80
}
}
%pathIndex = $iif(%portFound, $calc(%portIndex + 1), %portIndex)
if ($regml(0) >= %pathIndex) {
%path = $regml(%pathIndex)
}
else { %path = / }
}
else { return $false }
if ($prop == secure) { return %secure }
if ($prop == host) { return %host }
if ($prop == path) { return %path }
if ($prop == port) { return %port }
return $true
}
alias http.addpost {
if ($0 < 3) {
echo -atg * /http.addpost: Usage: /http.addpost <handle> <variable> <value>
return
}
var %maintable = http. $+ $1
var %posttable = %maintable $+ .postdata
if (!$hget(%maintable)) {
echo -atg * /http.addpost: No such HTTP handle found
return
}
if (!$hget(%posttable)) { .hmake %posttable 10 }
hadd %posttable $2 $3-
echo -qatg Post variable added: $2 $+ = $+ $3-
}
alias http.delpost {
if ($0 < 2) {
echo -atg * /http.delpost: Usage: /http.delpost <handle> <variable>
return
}
var %maintable = http. $+ $1
var %posttable = %maintable $+ .postdata
if (!$hget(%maintable)) {
echo -atg * /http.addpost: No such HTTP handle found
return
}
if (!$hget(%posttable,$2)) {
echo -qatg * /http.addpost: No post variable with that name exists
return
}
hdel %posttable $2
echo -qatg Post variable deleted: $2
}
; Usage: $http.postdata(handle)
; Returns a binvar with a post data style query string (x=y&z=a) or $false
alias http.postdata {
; Post data is stored in INNAME.postdata
var %posttable = http. $+ $1 $+ .postdata
if (!$hget(%posttable,0).item) { return $false }
var %i = 1
while ($hget(%posttable,%i).item) {
var %item = $ifmatch
bset -t &bvPost $calc($bvar(&bvPost,0) +1) $iif(%i > 1,&,) $+ $http.urlencode(%item) $+ = $+ $http.urlencode($hget(%posttable,%item))
inc %i
}
return &bvPost
}
; Replace some commonly touchy URL characters with their hex-octect encoding
alias -l http.urlencode {
return $replacex($1-,$chr(32),% $+ 20, $chr(44), % $+ 2C,+, % $+ 2B, $chr(37), % $+ 25)
}

{{Author|aca20031}}

[[Category:Script Archive]]

MHTTP

2015-02-22T01:15:43Z

Aca20031: http.mark

Often times you may want to download a web page from the internet using HTTP, but HTTP can be complicated. This script handles most of the basics for you including
* URL Parsing
* SSL
* Cookies
* Sending POST data
* Following redirects
* Handling CHUNKED encoding

Typical usage simply involves using the /http.open, save and close commands to download a file, and creating a signal event to do something with it once it is done.
== Example ==
alias DownloadGooglesLogo {
http.open google https://www.google.com/images/srpr/logo11w.png
http.save -f google logo.png
}
on *:SIGNAL:http: {
if ($1 == google) {
if ($2 == SAVED) { run $3- }
if ($2 == PROGRESS) { echo -atg Download progress: $bytes($3).suf $+ / $+ $bytes($4).suf downloaded }
}
}

== Script ==
; Ben's (ben@st0rm.net) HTTP for mIRC script (mHTTP)
; Used to download over HTTP
; Basic usage
; /http.open [name] <URL>
; Opens an HTTP handle for the given URL
; /http.save [-f] <name> <file|bvar>
; Downloads a given HTTP resource to the given file or binvar
; -f forces the file to be overwritten
; /http.close <name>
; Closes and HTTP handle for the given URL
;
; Here are some things you can do after opening a handle, but before saving it
; Manage POST data:
; /http.addpost <handle> <variable> <value>
; /http.delpost <handle> <variable>
; Manage cookies
; /http.addcookie <handle> <value>
; $http.cookie(handle,N) - gets Nth cookie
;
; After a request completes (e.g. after a save) you can get some data:
; $http.responseheader(handle, header, N) - Returns value of given responseheader, or $false. Only useful after a request is made
;
; You can mark a socket with data of your choice (it's a transparent write to a hashtable) similar to sockmark
; /http.mark <handle> [data] - Writes the data. Specify no data to delete the mark
; $http.mark(handle) - Reads the data
;
; Signals
; In order to tell via script when something happens (your file is being saved, for example) use
; on *:SIGNAL:http:
; where $1 = Handle name, $2 = Event name, $3- = parameters
; Events:
; COMPLETED <statuscode> - when a request completes
; SAVED <location> - when a save completes
; REDIRECT <location> - when a request is redirected elsewhere
; PROGRESS <bytes> [total size] - When part but not all of the data is downloaded. Total size is not available for chunked transfer
;
;
; Known issues:
; Cookies do not respect attributes such as domain, path, expiration, or secure. They area always sent
; Relative redirects don't work, only absolute
; Redirects from insecure to secure links when you don't have SSL will not be handled well
; Creates a request that when completed is saved to a file
alias http.save {
if ($1 == -f) {
var %force = $true
tokenize 32 $2-
}
else { var %force = $false }
if ($0 < 2) {
echo -atg * /http.save: Use /http.save <http handle> <file>
return
}
var %hashtable = http. $+ $1
if (!$hget(%hashtable)) {
echo -atg * /http.save: No such HTTP handle exists. Use /http.open first
return
}
if ($sock(%hashtable)) {
echo -atg * /http.save: There is a pending request for this HTTP handle already. A connection is open the the remote host. Close it, or wait for it to complete
return
}
var %destination = $2-
if ($exists(%destination)) {
if (%force) {
.remove %destination
}
else {
echo -atg * /http.save: File already exists. Try /http.save -f to force an overwrite
return
}
}
if (&* iswm %destination) {
.hadd %hashtable bvarout %destination
}
else {
; Open file handler stream for writing
.fopen -n %hashtable %destination
if ($ferr) {
echo -atg * /http.save: Could not use file. Error: $ferr
return
}
; Store fstream name in hashtable to indicate that we want to save this once it completes
.hadd %hashtable fstream %hashtable
}
; Set redirect counter to 0
.hadd %hashtable redirects 0
; Start socket
http.sockstart %hashtable
}
alias http.mark {
var %hashtable = http. $+ $1
if ($isid) {
; As an identifier, read the mark
return $hget(%hashtable,mark)
}
else {
; As a command, set the mark
if (!$hget(%hashtable)) {
echo -atg * /http.mark - No such handle $1
}
elseif (!$2) {
.hdel %hashtable mark
}
else {
.hadd %hashtable mark $2-
}
}
}
; Opens socket
alias -l http.sockstart {
if ($hget($1,secure) == $true) {
if ($sock($1) && $sock($1).ssl) {
http.sendrequest $1
}
else {
if ($sock($1)) { .sockclose $1 }
if (!$sslready) {
echo -atg HTTP Error - request $qt($right($1,-5)) would require you to use SSL but you are not SSL ready. Please see http://mirc.com/ssl.html
http.close $right($1,-5)
return
}
sockopen -e $1 $hget($1, host) $hget($1, port)
}
}
else {
if ($sock($1)) {
http.sendrequest $1
}
else {
sockopen $1 $hget($1, host) $hget($1, port)
}
}
}
; Sends the request. Assumes the socket is open and ready
alias -l http.sendrequest {
if (!$sock($1)) { echo -atg HTTP Internal error. Socket not open in /http.sendrequest | return }
var %inname = $1
var %exname = $right($1,-5)
; Cleanup from previous requests
.hdel %inname responseheaders
.hdel %inname body
.hdel %inname contentlength
.hdel %inname chunkleft
; Get POST binvar
var %postBV = $http.postdata(%inname)
; Use GET if there's no post data, POST otherwise
if ($bvar(%postBV,0) == 0) {
sockwrite -n %inname GET $hget(%inname,path) HTTP/1.1
}
else {
sockwrite -n %inname POST $hget(%inname,path) HTTP/1.1
}
; Send the host
sockwrite -n %inname Host: $hget(%inname,host)
; Send the user-agent
sockwrite -n %inname User-agent: $hget(%inname,user-agent)
sockwrite -n %inname Connection: Keep-Alive
; Only plain-text supported
sockwrite -n %inname Accept: text/plain; q=0.5, text/html
; Send cookies
if ($http.cookie(%exname, 0) > 0) {
sockwrite %inname Cookie: $+ $chr(32)
var %i = 1
while ($http.cookie(%exname, %i)) {
sockwrite %inname $http.urlencode($ifmatch) $+ ;
inc %i
}
sockwrite -n %inname
}
; If POST send content type and length
if ($bvar(%postBV,0) > 0) {
sockwrite -n %inname Content-Type: application/x-www-form-urlencoded
sockwrite -n %inname Content-Length: $v1
}
; End request headers with empty line
sockwrite -n %inname
; If POST, send data
if ($bvar(%postBV,0) > 0) {
sockwrite %inname %postBV
; sockwrite -n %inname
}
}
; Just some bookeeping in case we miss it
on *:SOCKCLOSE:http.*: {
if ($fopen($sockname)) { .fclose $sockname }
}
on *:SOCKOPEN:http.*: {
http.sendrequest $sockname
}
on *:SOCKREAD:http.*: {
if ($sockerr > 0) {
echo -atg * HTTP handle $qt($right($sockname,-5)) failed with socket error $sockerr
http.close $right($sockname,-5)
return
}
;Read all the data into &bvTemp
:read
; First, read this buffer
sockread &bvThis
if ($sockbr > 0) {
; If data was read, copy it to the on-going buffer and continue
bcopy &bvTemp $calc($bvar(&bvTemp,0) +1) &bvThis 1 -1
goto read
}
if ($bvar(&bvTemp,0) == 0) { echo -atg HTTP sockread called with no data to read... | return }
; Do we need to parse headers?
; If response headers not set, this call has the headers
if (!$hget($sockname,responseheaders)) {
; Find the response headers
var %end = $bfind(&bvTemp,1, 13 10 13 10)
if (%end == 0) { echo -atg Error: No headers found, but no content length so this can't be a subsequent call | return }
; Increase to include the 3 extra characters
inc %end 3
bcopy &bvResponseHeaders 1 &bvTemp 1 %end
; If there's still non-header data copy it over
if (%end < $bvar(&bvTemp, 0)) {
bcopy -c &bvTemp 1 &bvTemp $calc(%end + 1) -1
}
else { bunset &bvTemp }
; If this is the first header response, save in hash table
if (!$hget($sockname, responseheaders)) {
.hadd -b $sockname responseheaders &bvResponseHeaders
http.OnHeaders $sockname
}
}
; there's no more to read, bail
if (!$bvar(&bvTemp,0)) {
; If that's all this response has to offer, we're done
if ($hget($sockname,contentlength) == 0) {
http.ondone $sockname
}
return
}
; Read body
var %contentlength = $hget($sockname,contentlength)
if (%contentlength == $null || %contentlength == $false) {
var %chunked = $true
}
else {
var %chunked = $false
}
; Set bvBody to the body ready so far
if ($hget($sockname,body)) {
noop $hget($sockname, body, &bvBody)
}
if (%chunked) {
:readChunk
var %chunkleft = $hget($sockname, chunkleft)
if (!%chunkleft) {
; If we've read all of a chunk, or this is the first one, get its size
var %crlf = $bfind(&bvTemp, 1, 13 10)
if (!%crlf) {
echo -atg HTTP internal error. Handle $qt($right($sockname,-5)) is in chunked encoding but no chunk size found in data
return
}
var %chunkleft = $base($bvar(&bvTemp, 1, $calc(%crlf - 1)).text,16,10)
if (%chunkleft !isnum) {
echo -atg HTTP internal error. Handle $qt($right($sockname,-5)) has invalid chunk size: %chunkleft
}
; New chunk
else {
; Save chunk size and remove it (plus its \r\n) from temp
.hadd $sockname chunkleft %chunkleft
.bcopy -c &bvTemp 1 &bvTemp $calc(%crlf +2) -1
if (%chunkLeft == 0) {
; if we just read chunk size 0, that was the end.
.hadd -b $sockname body &bvBody
http.onDone $sockname
return
}
}
}
; read %chunkleft bytes
var %bytesToRead = $iif(%chunkLeft < $bvar(&bvTemp,0),%chunkLeft, $bvar(&bvTemp,0))
.bcopy &bvBody $calc($bvar(&bvBody,0) +1) &bvTemp 1 %bytesToRead
hdec $sockname chunkleft %bytesToRead
.signal http $right($sockname,-5) PROGRESS %bytesToRead
if (%bytesToRead == %chunkLeft) {
; If this is the end of the chunk, consume crlf
inc %bytesToRead 2
; If there's still stuff in this var, go back and read the new chunk
if (%bytesToRead < $bvar(&bvTemp,0)) {
.bcopy -c &bvTemp 1 &bvTemp $calc(%bytesToRead + 1) -1
goto readChunk
}
}
; End of this call, save body in hashtable for future calls
.hadd -b $sockname body &bvBody
}
else {
; Copy everything
.bcopy &bvBody $calc($bvar(&bvBody,0) +1) &bvTemp 1 -1
; Add read-so-far body to hashtable
.hadd -b $sockname body &bvBody
.signal http $right($sockname,-5) PROGRESS $bvar(&bvBody,0) $hget($sockname,contentlength)
; Check if we're done
if ($bvar(&bvBody,0) >= $hget($sockname,contentlength)) {
; We're done
http.onDone $sockname
if ($bvar(&bvBody,0) > $hget($sockname,contentlength)) {
echo -qatg HTTP Warning: Read past content-length.
}
}
}
}
; Internal event called when we get the first header response from the server
alias -l http.OnHeaders {
noop $hget($1,responseheaders, &bvResponseHeaders)
; First header is always the status response
var %end = $bfind(&bvResponseHeaders, 1, 13 10)
if (%end <= 1) {
echo -atg Error: HTTP $qt($right($1,-5)) Server did not respond with HTTP status
goto cleanup
}
var %status = $bvar(&bvResponseHeaders,1,$calc(%end - 1)).text
.hadd $1 responsestatus %status
var %version = $gettok(%status,1,32)
if (%version != HTTP/1.1 && %version != HTTP/1.0) {
echo -atg Error: HTTP $qt($right($1,-5)) Server indicated unknown version: %version
goto cleanup
}
var %statuscode = $gettok(%status,2,32)
if (%statuscode !isnum) {
echo -atg Error: HTTP $qt($right($1,-5)) Server indicated invalid status code: %statuscode
goto cleanup
}
; Check transfer type
if ($http.responseheader($right($1,-5),Content-Length,1) != $null) {
hadd $1 contentlength $v1
}
elseif ($http.responseheader($right($1,-5), Transfer-Encoding, 1) != chunked) {
echo -atg HTTP Handle $qt($right($1,-5)) has no content-length header and is not chunked
echo -atg $bvar(&bvResponseHeaders,1-).text
return
}
; Add any cookies that were set
var %cookie = 1
while ($http.responseheader($right($1,-5), Set-Cookie, %cookie)) {
inc %cookie
var %cookieValue = $gettok($ifmatch,1,$asc(;))
http.addcookie $right($1,-5) %cookieValue
}
; Handle redirects
if (%statuscode == 303 || %statuscode == 302 || %statuscode == 307) {
var %location = $http.responseheader($right($1,-5), Location)
.signal http $right($1,-5) REDIRECT %location
http.seturl $1 %location
hinc $1 redirects
; If the server doesn't promise us this connection is keep-alive, close it and use a new one
if ($http.responseheader($right($1,-5), Connection, 1) != Keep-Alive) {
if ($sock($1)) { .sockclose $1 }
}
if ($hget($1, redirects) > 5) {
echo -atg HTTP Handle $qt($right($1,-5)) redirect loop detected
return
}
http.sockstart $1
}
return
:cleanup
if ($sock($1)) { .sockclose $1 }
}
alias http.addcookie {
var %hashtable = http. $+ $1
if (!$hget(%hashtable)) {
echo -atg * /http.addcookie: No such HTTP handle
return
}
if ($0 < 2) {
echo -atg * /http.addcookie: Usage: /http.addcookie <handle> <value>
return
}
var %i = 1
var %cookieNum = 1
while ($hget(%hashtable,%i).item) {
var %item = $ifmatch
inc %i
if (cookie-* iswm %item) {
var %tmp = $gettok(%item,2,$asc(-))
; If the value is the same, overwrite
if ($2- == $hget(%hashtable,%item)) {
%cookieNum = %tmp
break
}
; Otherwise store max cookie num
elseif (%tmp >= %cookieNum) { %cookieNum = $calc(%tmp + 1) }
}
}
.hadd %hashtable cookie- $+ %cookieNum $+ -value $2-
}
; Gets an HTTP cookie for the given handle
; $http.cookie(<handle>, <index>)
alias http.cookie {
if ($2 !isnum) {
echo -atg * $!http.cookie invalid parameters
return
}
var %hashtable = http. $+ $1
if (!$hget(%hashtable)) {
echo -atg * $!http.cookie no such HTTP handle
return
}
var %i = 1
var %found = 0
while ($hget(%hashtable, %i).item) {
inc %i
var %item = $ifmatch
if (cookie-*-value iswm %item) {
inc %found
var %id = $gettok(%item,2,$asc(-))
if (%found == $2) {
return $hget(%hashtable, cookie- $+ %id $+ -value)
}
}
}
if ($2 == 0) { return %found }
}
; Returns the value of the given response header
; Case sensitive since it is binary variable operation
alias http.responseheader {
if ($0 < 2) {
echo -atg Invalid usage. Use: $http.responseheader(<handle>, <header>[, index])
return
}
; %index is parameter 3 - 1-N or 0 for number
var %index = 1
if ($3 isnum) {
%index = $3
}
; Veriy hash table exists
var %table = http. $+ $1
if (!$hget(%table,responseheaders)) { return $false }
noop $hget(%table,responseheaders, &bvResponseHeaders))
; Set up parameters for the header search
; Offset is where we start searching from in the loop
; thisIndex is the number of matches found so far
var %offset = 1
var %thisIndex = 0
; The main search loop
:search
var %start = $bfind(&bvResponseHeaders, %offset, $2 $+ :).text
; If there isn't another match, either the index was too large or they want the count
if (!%start) {
if (%index == 0) { return %thisIndex }
else { return $false }
}
; Find the end of the header
var %end = $bfind(&bvResponseHeaders, %start, 13 10)
if (%end <= %start) { echo -atg HTTP Internal error ($http.responseheader), header $qt($2) for handle $qt($1) has no CRLF termination | return $false }
inc %thisIndex
; If this not the one they asked for, try again starting from the end of this header
if (%index != %thisIndex) {
var %offset = %end
goto search
}
; Find the colon. If there isn't one we'll return the whole string
if ($calc($bfind(&bvResponseHeaders, %start, $asc(:)) +1) < %end) {
%start = $v1
}
return $bvar(&bvResponseHeaders,%start, $calc(%end - %start)).text
}
; Internal event called when a request is filled. $1 = internal handle name
alias -l http.onDone {
if ($hget($1,responseheaders)) {
noop $hget($1,responseheaders,&bvResponseHeaders)
}
; Write out and close filestream if set
if ($hget($1,fstream)) {
noop $hget($1,body,&bvBody)
if (!$bvar(&bvBody,0)) {
.fclose $hget($1,fstream)
}
else {
.fwrite -b $hget($1,fstream) &bvBody
; Save fname so we can use it in the signal after the close
var %fname = $fopen($hget($1,fstream)).fname
.fclose $hget($1,fstream)
.signal http $right($1,-5) SAVED %fname
}
}
; If socket is still around, close it
if ($sock($1)) { .sockclose $1 }
; Reset redirects for future calls
.hadd $1 redirects 0
.signal HTTP $right($1,-5) COMPLETED $hget($1,responsestatus)
if ($hget($1, bvarout)) {
noop $hget($1,body,&bvBody)
var %bvarout = $ifmatch
bcopy %bvarout 1 &bvBody 1 -1
; Need to use -n so that the binvar is still in scope
; So we need to do this last
.signal -n http $right($1,-5) SAVED %bvarout
}
}
alias http.open {
var %hashtable
; If two parameters are given, $1 is the name, else create a new name
if ($0 > 1) { %hashtable = http. $+ $1 }
else {
var %h = $calc($ticks % $rand(1,1000000))
var %hashtable = http. $+ %h
}
if ($hget(%hashtable)) {
echo -atg * /http.open: HTTP Request $qt($1) already exists
return
}
; Encode the octects of the URL. e.g.: foo bar,pie --> foo%20bar,%2Cpie
var %url = $iif($0 > 1, $2-, $1-)
var %urlEncoded = $http.urlencode(%url)
; Check the URL
if (!$http.urlparse(%urlEncoded)) {
echo -atg * /http.open: Malformed URL. Use /http.open [name] <url>
return
}
if ($http.urlparse(%urlEncoded).secure && !$sslready) {
echo -atg * /http.open: URL is SSL but $!sslready = false. See http://www.mirc.com/ssl.html
return
}
; Everything checks out, let's store the relevent bits in a hashtable
.hmake %hashtable 10
http.seturl %hashtable %url
echo -qatg * /http.open: Opened HTTP request $qt($right(%hashtable,-5))
}
alias -l http.seturl {
if ($0 < 2) { echo -atg HTTP Internal error, seturl called with no url }
var %hashtable = $1
if (!$hget(%hashtable)) { echo -atg HTTP Internal error, seturl called with invalid handle }
var %urlEncoded = $http.urlencode($2-)
.hadd %hashtable host $http.urlparse(%urlEncoded).host
.hadd %hashtable port $http.urlparse(%urlEncoded).port
.hadd %hashtable secure $http.urlparse(%urlEncoded).secure
.hadd %hashtable path $http.urlparse(%urlEncoded).path
.hadd %hashtable user-agent mIRC $version
}
alias http.list {
var %i = 1
var %numFound = 0
while (%i <= $hget(0)) {
var %table = $hget(%i)
inc %i
if (http.* iswm %table) {
inc %numFound
echo -atg * $right(%table,-5) $+ : Host: $hget(%table,host) Port: $hget(%table,port) Path: $hget(%table,path)
}
}
if (%numFound == 0) { echo -atg * No HTTP handles opened }
}
alias http.close {
var %i = 1
var %numFound = 0
while (%i <= $hget(0)) {
var %table = $hget(%i)
if (http. $+ $1 iswm %table) {
; Cleanup resources
if ($sock(%table)) { .sockclose %table }
if ($fopen(%table)) { .fclose %table }
if ($hget(%table $+ .postdata)) { .hfree %table $+ .postdata }
.hfree %table
inc %numFound
echo -qatg * HTTP Closed $right(%table,-5)
}
; Only inc if we didnt find a match
else {
inc %i
}
}
if (%numFound == 0) { echo -qatg * No matching HTTP handles }
}
;
; Takes an encoded URL and returns based on the property
; .secure - true if https
; .host - the URL host
; .port - the port, 80 by default
; .path - The path to download, / by default
; Returns $false is URL is malformed
;
alias http.urlparse {
var %secure
var %host
var %port
var %path
var %regex = /^(https?://)?([a-z.0-9\-_]+)(:\d+)?(/.*)?$/i
if ($regex($1, %regex)) {
if (http*:// iswm $regml(1)) {
%protocol = $lower($left($regml(1),-3))
}
%secure = $false
if (%protocol == https) {
%secure = $true
}
if (%protocol) { %host = $regml(2) }
else { %host = $regml(1) }
var %portIndex = $iif(%protocol, 3, 2)
var %portfound = $false
if ($left($regml(%portIndex),1) == : && $right($regml(%portIndex),-1) isnum) {
%port = $right($regml(%portIndex),-1)
%portFound = $true
}
else {
if (%secure) {
%port = 443
}
else {
%port = 80
}
}
%pathIndex = $iif(%portFound, $calc(%portIndex + 1), %portIndex)
if ($regml(0) >= %pathIndex) {
%path = $regml(%pathIndex)
}
else { %path = / }
}
else { return $false }
if ($prop == secure) { return %secure }
if ($prop == host) { return %host }
if ($prop == path) { return %path }
if ($prop == port) { return %port }
return $true
}
alias http.addpost {
if ($0 < 3) {
echo -atg * /http.addpost: Usage: /http.addpost <handle> <variable> <value>
return
}
var %maintable = http. $+ $1
var %posttable = %maintable $+ .postdata
if (!$hget(%maintable)) {
echo -atg * /http.addpost: No such HTTP handle found
return
}
if (!$hget(%posttable)) { .hmake %posttable 10 }
hadd %posttable $2 $3-
echo -qatg Post variable added: $2 $+ = $+ $3-
}
alias http.delpost {
if ($0 < 2) {
echo -atg * /http.delpost: Usage: /http.delpost <handle> <variable>
return
}
var %maintable = http. $+ $1
var %posttable = %maintable $+ .postdata
if (!$hget(%maintable)) {
echo -atg * /http.addpost: No such HTTP handle found
return
}
if (!$hget(%posttable,$2)) {
echo -qatg * /http.addpost: No post variable with that name exists
return
}
hdel %posttable $2
echo -qatg Post variable deleted: $2
}
; Usage: $http.postdata(handle)
; Returns a binvar with a post data style query string (x=y&z=a) or $false
alias http.postdata {
; Post data is stored in INNAME.postdata
var %posttable = http. $+ $1 $+ .postdata
if (!$hget(%posttable,0).item) { return $false }
var %i = 1
while ($hget(%posttable,%i).item) {
var %item = $ifmatch
bset -t &bvPost $calc($bvar(&bvPost,0) +1) $iif(%i > 1,&,) $+ $http.urlencode(%item) $+ = $+ $http.urlencode($hget(%posttable,%item))
inc %i
}
return &bvPost
}
; Replace some commonly touchy URL characters with their hex-octect encoding
alias -l http.urlencode {
return $replacex($1-,$chr(32),% $+ 20, $chr(44), % $+ 2C,+, % $+ 2B, $chr(37), % $+ 25)
}

{{Author|aca20031}}

[[Category:Script Archive]]

MHTTP

2015-02-22T00:44:05Z

Aca20031: + http.save to &bvar

Often times you may want to download a web page from the internet using HTTP, but HTTP can be complicated. This script handles most of the basics for you including
* URL Parsing
* SSL
* Cookies
* Sending POST data
* Following redirects
* Handling CHUNKED encoding

Typical usage simply involves using the /http.open, save and close commands to download a file, and creating a signal event to do something with it once it is done.
== Example ==
alias DownloadGooglesLogo {
http.open google https://www.google.com/images/srpr/logo11w.png
http.save -f google logo.png
}
on *:SIGNAL:http: {
if ($1 == google) {
if ($2 == SAVED) { run $3- }
if ($2 == PROGRESS) { echo -atg Download progress: $bytes($3).suf $+ / $+ $bytes($4).suf downloaded }
}
}

== Script ==
; Ben's (ben@st0rm.net) HTTP for mIRC script (mHTTP)
; Used to download over HTTP
; Basic usage
; /http.open [name] <URL>
; Opens an HTTP handle for the given URL
; /http.save [-f] <name> <file|bvar>
; Downloads a given HTTP resource to the given file or binvar
; -f forces the file to be overwritten
; /http.close <name>
; Closes and HTTP handle for the given URL
;
; Here are some things you can do after opening a handle, but before saving it
; Manage POST data:
; /http.addpost <handle> <variable> <value>
; /http.delpost <handle> <variable>
; Manage cookies
; /http.addcookie <handle> <value>
; $http.cookie(handle,N) - gets Nth cookie
;
; After a request completes (e.g. after a save) you can get some data:
; $http.responseheader(handle, header, N) - Returns value of given responseheader, or $false. Only useful after a request is made
;
; Signals
; In order to tell via script when something happens (your file is being saved, for example) use
; on *:SIGNAL:http:
; where $1 = Handle name, $2 = Event name, $3- = parameters
; Events:
; COMPLETED <statuscode> - when a request completes
; SAVED <location> - when a save completes
; REDIRECT <location> - when a request is redirected elsewhere
; PROGRESS <bytes> [total size] - When part but not all of the data is downloaded. Total size is not available for chunked transfer
;
;
; Known issues:
; Cookies do not respect attributes such as domain, path, expiration, or secure. They area always sent
; Relative redirects don't work, only absolute
; Redirects from insecure to secure links when you don't have SSL will not be handled well
; Creates a request that when completed is saved to a file
alias http.save {
if ($1 == -f) {
var %force = $true
tokenize 32 $2-
}
else { var %force = $false }
if ($0 < 2) {
echo -atg * /http.save: Use /http.save <http handle> <file>
return
}
var %hashtable = http. $+ $1
if (!$hget(%hashtable)) {
echo -atg * /http.save: No such HTTP handle exists. Use /http.open first
return
}
if ($sock(%hashtable)) {
echo -atg * /http.save: There is a pending request for this HTTP handle already. A connection is open the the remote host. Close it, or wait for it to complete
return
}
var %destination = $2-
if ($exists(%destination)) {
if (%force) {
.remove %destination
}
else {
echo -atg * /http.save: File already exists. Try /http.save -f to force an overwrite
return
}
}
if (&* iswm %destination) {
.hadd %hashtable bvarout %destination
}
else {
; Open file handler stream for writing
.fopen -n %hashtable %destination
if ($ferr) {
echo -atg * /http.save: Could not use file. Error: $ferr
return
}
; Store fstream name in hashtable to indicate that we want to save this once it completes
.hadd %hashtable fstream %hashtable
}
; Set redirect counter to 0
.hadd %hashtable redirects 0
; Start socket
http.sockstart %hashtable
}
; Opens socket
alias -l http.sockstart {
if ($hget($1,secure) == $true) {
if ($sock($1) && $sock($1).ssl) {
http.sendrequest $1
}
else {
if ($sock($1)) { .sockclose $1 }
if (!$sslready) {
echo -atg HTTP Error - request $qt($right($1,-5)) would require you to use SSL but you are not SSL ready. Please see http://mirc.com/ssl.html
http.close $right($1,-5)
return
}
sockopen -e $1 $hget($1, host) $hget($1, port)
}
}
else {
if ($sock($1)) {
http.sendrequest $1
}
else {
sockopen $1 $hget($1, host) $hget($1, port)
}
}
}
; Sends the request. Assumes the socket is open and ready
alias -l http.sendrequest {
if (!$sock($1)) { echo -atg HTTP Internal error. Socket not open in /http.sendrequest | return }
var %inname = $1
var %exname = $right($1,-5)
; Cleanup from previous requests
.hdel %inname responseheaders
.hdel %inname body
.hdel %inname contentlength
.hdel %inname chunkleft
; Get POST binvar
var %postBV = $http.postdata(%inname)
; Use GET if there's no post data, POST otherwise
if ($bvar(%postBV,0) == 0) {
sockwrite -n %inname GET $hget(%inname,path) HTTP/1.1
}
else {
sockwrite -n %inname POST $hget(%inname,path) HTTP/1.1
}
; Send the host
sockwrite -n %inname Host: $hget(%inname,host)
; Send the user-agent
sockwrite -n %inname User-agent: $hget(%inname,user-agent)
sockwrite -n %inname Connection: Keep-Alive
; Only plain-text supported
sockwrite -n %inname Accept: text/plain; q=0.5, text/html
; Send cookies
if ($http.cookie(%exname, 0) > 0) {
sockwrite %inname Cookie: $+ $chr(32)
var %i = 1
while ($http.cookie(%exname, %i)) {
sockwrite %inname $http.urlencode($ifmatch) $+ ;
inc %i
}
sockwrite -n %inname
}
; If POST send content type and length
if ($bvar(%postBV,0) > 0) {
sockwrite -n %inname Content-Type: application/x-www-form-urlencoded
sockwrite -n %inname Content-Length: $v1
}
; End request headers with empty line
sockwrite -n %inname
; If POST, send data
if ($bvar(%postBV,0) > 0) {
sockwrite %inname %postBV
; sockwrite -n %inname
}
}
; Just some bookeeping in case we miss it
on *:SOCKCLOSE:http.*: {
if ($fopen($sockname)) { .fclose $sockname }
}
on *:SOCKOPEN:http.*: {
http.sendrequest $sockname
}
on *:SOCKREAD:http.*: {
if ($sockerr > 0) {
echo -atg * HTTP handle $qt($right($sockname,-5)) failed with socket error $sockerr
http.close $right($sockname,-5)
return
}
;Read all the data into &bvTemp
:read
; First, read this buffer
sockread &bvThis
if ($sockbr > 0) {
; If data was read, copy it to the on-going buffer and continue
bcopy &bvTemp $calc($bvar(&bvTemp,0) +1) &bvThis 1 -1
goto read
}
if ($bvar(&bvTemp,0) == 0) { echo -atg HTTP sockread called with no data to read... | return }
; Do we need to parse headers?
; If response headers not set, this call has the headers
if (!$hget($sockname,responseheaders)) {
; Find the response headers
var %end = $bfind(&bvTemp,1, 13 10 13 10)
if (%end == 0) { echo -atg Error: No headers found, but no content length so this can't be a subsequent call | return }
; Increase to include the 3 extra characters
inc %end 3
bcopy &bvResponseHeaders 1 &bvTemp 1 %end
; If there's still non-header data copy it over
if (%end < $bvar(&bvTemp, 0)) {
bcopy -c &bvTemp 1 &bvTemp $calc(%end + 1) -1
}
else { bunset &bvTemp }
; If this is the first header response, save in hash table
if (!$hget($sockname, responseheaders)) {
.hadd -b $sockname responseheaders &bvResponseHeaders
http.OnHeaders $sockname
}
}
; there's no more to read, bail
if (!$bvar(&bvTemp,0)) {
; If that's all this response has to offer, we're done
if ($hget($sockname,contentlength) == 0) {
http.ondone $sockname
}
return
}
; Read body
var %contentlength = $hget($sockname,contentlength)
if (%contentlength == $null || %contentlength == $false) {
var %chunked = $true
}
else {
var %chunked = $false
}
; Set bvBody to the body ready so far
if ($hget($sockname,body)) {
noop $hget($sockname, body, &bvBody)
}
if (%chunked) {
:readChunk
var %chunkleft = $hget($sockname, chunkleft)
if (!%chunkleft) {
; If we've read all of a chunk, or this is the first one, get its size
var %crlf = $bfind(&bvTemp, 1, 13 10)
if (!%crlf) {
echo -atg HTTP internal error. Handle $qt($right($sockname,-5)) is in chunked encoding but no chunk size found in data
return
}
var %chunkleft = $base($bvar(&bvTemp, 1, $calc(%crlf - 1)).text,16,10)
if (%chunkleft !isnum) {
echo -atg HTTP internal error. Handle $qt($right($sockname,-5)) has invalid chunk size: %chunkleft
}
; New chunk
else {
; Save chunk size and remove it (plus its \r\n) from temp
.hadd $sockname chunkleft %chunkleft
.bcopy -c &bvTemp 1 &bvTemp $calc(%crlf +2) -1
if (%chunkLeft == 0) {
; if we just read chunk size 0, that was the end.
.hadd -b $sockname body &bvBody
http.onDone $sockname
return
}
}
}
; read %chunkleft bytes
var %bytesToRead = $iif(%chunkLeft < $bvar(&bvTemp,0),%chunkLeft, $bvar(&bvTemp,0))
.bcopy &bvBody $calc($bvar(&bvBody,0) +1) &bvTemp 1 %bytesToRead
hdec $sockname chunkleft %bytesToRead
.signal http $right($sockname,-5) PROGRESS %bytesToRead
if (%bytesToRead == %chunkLeft) {
; If this is the end of the chunk, consume crlf
inc %bytesToRead 2
; If there's still stuff in this var, go back and read the new chunk
if (%bytesToRead < $bvar(&bvTemp,0)) {
.bcopy -c &bvTemp 1 &bvTemp $calc(%bytesToRead + 1) -1
goto readChunk
}
}
; End of this call, save body in hashtable for future calls
.hadd -b $sockname body &bvBody
}
else {
; Copy everything
.bcopy &bvBody $calc($bvar(&bvBody,0) +1) &bvTemp 1 -1
; Add read-so-far body to hashtable
.hadd -b $sockname body &bvBody
.signal http $right($sockname,-5) PROGRESS $bvar(&bvBody,0) $hget($sockname,contentlength)
; Check if we're done
if ($bvar(&bvBody,0) >= $hget($sockname,contentlength)) {
; We're done
http.onDone $sockname
if ($bvar(&bvBody,0) > $hget($sockname,contentlength)) {
echo -qatg HTTP Warning: Read past content-length.
}
}
}
}
; Internal event called when we get the first header response from the server
alias -l http.OnHeaders {
noop $hget($1,responseheaders, &bvResponseHeaders)
; First header is always the status response
var %end = $bfind(&bvResponseHeaders, 1, 13 10)
if (%end <= 1) {
echo -atg Error: HTTP $qt($right($1,-5)) Server did not respond with HTTP status
goto cleanup
}
var %status = $bvar(&bvResponseHeaders,1,$calc(%end - 1)).text
.hadd $1 responsestatus %status
var %version = $gettok(%status,1,32)
if (%version != HTTP/1.1 && %version != HTTP/1.0) {
echo -atg Error: HTTP $qt($right($1,-5)) Server indicated unknown version: %version
goto cleanup
}
var %statuscode = $gettok(%status,2,32)
if (%statuscode !isnum) {
echo -atg Error: HTTP $qt($right($1,-5)) Server indicated invalid status code: %statuscode
goto cleanup
}
; Check transfer type
if ($http.responseheader($right($1,-5),Content-Length,1) != $null) {
hadd $1 contentlength $v1
}
elseif ($http.responseheader($right($1,-5), Transfer-Encoding, 1) != chunked) {
echo -atg HTTP Handle $qt($right($1,-5)) has no content-length header and is not chunked
echo -atg $bvar(&bvResponseHeaders,1-).text
return
}
; Add any cookies that were set
var %cookie = 1
while ($http.responseheader($right($1,-5), Set-Cookie, %cookie)) {
inc %cookie
var %cookieValue = $gettok($ifmatch,1,$asc(;))
http.addcookie $right($1,-5) %cookieValue
}
; Handle redirects
if (%statuscode == 303 || %statuscode == 302 || %statuscode == 307) {
var %location = $http.responseheader($right($1,-5), Location)
.signal http $right($1,-5) REDIRECT %location
http.seturl $1 %location
hinc $1 redirects
; If the server doesn't promise us this connection is keep-alive, close it and use a new one
if ($http.responseheader($right($1,-5), Connection, 1) != Keep-Alive) {
if ($sock($1)) { .sockclose $1 }
}
if ($hget($1, redirects) > 5) {
echo -atg HTTP Handle $qt($right($1,-5)) redirect loop detected
return
}
http.sockstart $1
}
return
:cleanup
if ($sock($1)) { .sockclose $1 }
}
alias http.addcookie {
var %hashtable = http. $+ $1
if (!$hget(%hashtable)) {
echo -atg * /http.addcookie: No such HTTP handle
return
}
if ($0 < 2) {
echo -atg * /http.addcookie: Usage: /http.addcookie <handle> <value>
return
}
var %i = 1
var %cookieNum = 1
while ($hget(%hashtable,%i).item) {
var %item = $ifmatch
inc %i
if (cookie-* iswm %item) {
var %tmp = $gettok(%item,2,$asc(-))
; If the value is the same, overwrite
if ($2- == $hget(%hashtable,%item)) {
%cookieNum = %tmp
break
}
; Otherwise store max cookie num
elseif (%tmp >= %cookieNum) { %cookieNum = $calc(%tmp + 1) }
}
}
.hadd %hashtable cookie- $+ %cookieNum $+ -value $2-
}
; Gets an HTTP cookie for the given handle
; $http.cookie(<handle>, <index>)
alias http.cookie {
if ($2 !isnum) {
echo -atg * $!http.cookie invalid parameters
return
}
var %hashtable = http. $+ $1
if (!$hget(%hashtable)) {
echo -atg * $!http.cookie no such HTTP handle
return
}
var %i = 1
var %found = 0
while ($hget(%hashtable, %i).item) {
inc %i
var %item = $ifmatch
if (cookie-*-value iswm %item) {
inc %found
var %id = $gettok(%item,2,$asc(-))
if (%found == $2) {
return $hget(%hashtable, cookie- $+ %id $+ -value)
}
}
}
if ($2 == 0) { return %found }
}
; Returns the value of the given response header
; Case sensitive since it is binary variable operation
alias http.responseheader {
if ($0 < 2) {
echo -atg Invalid usage. Use: $http.responseheader(<handle>, <header>[, index])
return
}
; %index is parameter 3 - 1-N or 0 for number
var %index = 1
if ($3 isnum) {
%index = $3
}
; Veriy hash table exists
var %table = http. $+ $1
if (!$hget(%table,responseheaders)) { return $false }
noop $hget(%table,responseheaders, &bvResponseHeaders))
; Set up parameters for the header search
; Offset is where we start searching from in the loop
; thisIndex is the number of matches found so far
var %offset = 1
var %thisIndex = 0
; The main search loop
:search
var %start = $bfind(&bvResponseHeaders, %offset, $2 $+ :).text
; If there isn't another match, either the index was too large or they want the count
if (!%start) {
if (%index == 0) { return %thisIndex }
else { return $false }
}
; Find the end of the header
var %end = $bfind(&bvResponseHeaders, %start, 13 10)
if (%end <= %start) { echo -atg HTTP Internal error ($http.responseheader), header $qt($2) for handle $qt($1) has no CRLF termination | return $false }
inc %thisIndex
; If this not the one they asked for, try again starting from the end of this header
if (%index != %thisIndex) {
var %offset = %end
goto search
}
; Find the colon. If there isn't one we'll return the whole string
if ($calc($bfind(&bvResponseHeaders, %start, $asc(:)) +1) < %end) {
%start = $v1
}
return $bvar(&bvResponseHeaders,%start, $calc(%end - %start)).text
}
; Internal event called when a request is filled. $1 = internal handle name
alias -l http.onDone {
if ($hget($1,responseheaders)) {
noop $hget($1,responseheaders,&bvResponseHeaders)
}
; Write out and close filestream if set
if ($hget($1,fstream)) {
noop $hget($1,body,&bvBody)
if (!$bvar(&bvBody,0)) {
.fclose $hget($1,fstream)
}
else {
.fwrite -b $hget($1,fstream) &bvBody
; Save fname so we can use it in the signal after the close
var %fname = $fopen($hget($1,fstream)).fname
.fclose $hget($1,fstream)
.signal http $right($1,-5) SAVED %fname
}
}
; If socket is still around, close it
if ($sock($1)) { .sockclose $1 }
; Reset redirects for future calls
.hadd $1 redirects 0
.signal HTTP $right($1,-5) COMPLETED $hget($1,responsestatus)
if ($hget($1, bvarout)) {
noop $hget($1,body,&bvBody)
var %bvarout = $ifmatch
bcopy %bvarout 1 &bvBody 1 -1
; Need to use -n so that the binvar is still in scope
; So we need to do this last
.signal -n http $right($1,-5) SAVED %bvarout
}
}
alias http.open {
var %hashtable
; If two parameters are given, $1 is the name, else create a new name
if ($0 > 1) { %hashtable = http. $+ $1 }
else {
var %h = $calc($ticks % $rand(1,1000000))
var %hashtable = http. $+ %h
}
if ($hget(%hashtable)) {
echo -atg * /http.open: HTTP Request $qt($1) already exists
return
}
; Encode the octects of the URL. e.g.: foo bar,pie --> foo%20bar,%2Cpie
var %url = $iif($0 > 1, $2-, $1-)
var %urlEncoded = $http.urlencode(%url)
; Check the URL
if (!$http.urlparse(%urlEncoded)) {
echo -atg * /http.open: Malformed URL. Use /http.open [name] <url>
return
}
if ($http.urlparse(%urlEncoded).secure && !$sslready) {
echo -atg * /http.open: URL is SSL but $!sslready = false. See http://www.mirc.com/ssl.html
return
}
; Everything checks out, let's store the relevent bits in a hashtable
.hmake %hashtable 10
http.seturl %hashtable %url
echo -qatg * /http.open: Opened HTTP request $qt($right(%hashtable,-5))
}
alias -l http.seturl {
if ($0 < 2) { echo -atg HTTP Internal error, seturl called with no url }
var %hashtable = $1
if (!$hget(%hashtable)) { echo -atg HTTP Internal error, seturl called with invalid handle }
var %urlEncoded = $http.urlencode($2-)
.hadd %hashtable host $http.urlparse(%urlEncoded).host
.hadd %hashtable port $http.urlparse(%urlEncoded).port
.hadd %hashtable secure $http.urlparse(%urlEncoded).secure
.hadd %hashtable path $http.urlparse(%urlEncoded).path
.hadd %hashtable user-agent mIRC $version
}
alias http.list {
var %i = 1
var %numFound = 0
while (%i <= $hget(0)) {
var %table = $hget(%i)
inc %i
if (http.* iswm %table) {
inc %numFound
echo -atg * $right(%table,-5) $+ : Host: $hget(%table,host) Port: $hget(%table,port) Path: $hget(%table,path)
}
}
if (%numFound == 0) { echo -atg * No HTTP handles opened }
}
alias http.close {
var %i = 1
var %numFound = 0
while (%i <= $hget(0)) {
var %table = $hget(%i)
if (http. $+ $1 iswm %table) {
; Cleanup resources
if ($sock(%table)) { .sockclose %table }
if ($fopen(%table)) { .fclose %table }
if ($hget(%table $+ .postdata)) { .hfree %table $+ .postdata }
.hfree %table
inc %numFound
echo -qatg * HTTP Closed $right(%table,-5)
}
; Only inc if we didnt find a match
else {
inc %i
}
}
if (%numFound == 0) { echo -qatg * No matching HTTP handles }
}
;
; Takes an encoded URL and returns based on the property
; .secure - true if https
; .host - the URL host
; .port - the port, 80 by default
; .path - The path to download, / by default
; Returns $false is URL is malformed
;
alias http.urlparse {
var %secure
var %host
var %port
var %path
var %regex = /^(https?://)?([a-z.0-9\-_]+)(:\d+)?(/.*)?$/i
if ($regex($1, %regex)) {
if (http*:// iswm $regml(1)) {
%protocol = $lower($left($regml(1),-3))
}
%secure = $false
if (%protocol == https) {
%secure = $true
}
if (%protocol) { %host = $regml(2) }
else { %host = $regml(1) }
var %portIndex = $iif(%protocol, 3, 2)
var %portfound = $false
if ($left($regml(%portIndex),1) == : && $right($regml(%portIndex),-1) isnum) {
%port = $right($regml(%portIndex),-1)
%portFound = $true
}
else {
if (%secure) {
%port = 443
}
else {
%port = 80
}
}
%pathIndex = $iif(%portFound, $calc(%portIndex + 1), %portIndex)
if ($regml(0) >= %pathIndex) {
%path = $regml(%pathIndex)
}
else { %path = / }
}
else { return $false }
if ($prop == secure) { return %secure }
if ($prop == host) { return %host }
if ($prop == path) { return %path }
if ($prop == port) { return %port }
return $true
}
alias http.addpost {
if ($0 < 3) {
echo -atg * /http.addpost: Usage: /http.addpost <handle> <variable> <value>
return
}
var %maintable = http. $+ $1
var %posttable = %maintable $+ .postdata
if (!$hget(%maintable)) {
echo -atg * /http.addpost: No such HTTP handle found
return
}
if (!$hget(%posttable)) { .hmake %posttable 10 }
hadd %posttable $2 $3-
echo -qatg Post variable added: $2 $+ = $+ $3-
}
alias http.delpost {
if ($0 < 2) {
echo -atg * /http.delpost: Usage: /http.delpost <handle> <variable>
return
}
var %maintable = http. $+ $1
var %posttable = %maintable $+ .postdata
if (!$hget(%maintable)) {
echo -atg * /http.addpost: No such HTTP handle found
return
}
if (!$hget(%posttable,$2)) {
echo -qatg * /http.addpost: No post variable with that name exists
return
}
hdel %posttable $2
echo -qatg Post variable deleted: $2
}
; Usage: $http.postdata(handle)
; Returns a binvar with a post data style query string (x=y&z=a) or $false
alias http.postdata {
; Post data is stored in INNAME.postdata
var %posttable = http. $+ $1 $+ .postdata
if (!$hget(%posttable,0).item) { return $false }
var %i = 1
while ($hget(%posttable,%i).item) {
var %item = $ifmatch
bset -t &bvPost $calc($bvar(&bvPost,0) +1) $iif(%i > 1,&,) $+ $http.urlencode(%item) $+ = $+ $http.urlencode($hget(%posttable,%item))
inc %i
}
return &bvPost
}
; Replace some commonly touchy URL characters with their hex-octect encoding
alias -l http.urlencode {
return $replacex($1-,$chr(32),% $+ 20, $chr(44), % $+ 2C,+, % $+ 2B, $chr(37), % $+ 25)
}

{{Author|aca20031}}

[[Category:Script Archive]]

MJSON

2015-01-23T06:29:16Z

Aca20031: /* Script */

This script is a 100% native way of parsing JSON with an easy API

==Example==
To use the below example, Save the following JSON in "json-example.txt" in $mircdir

[
{
"name":"Todd",
"IsManager":false,
"Spouse":{"Name":"Marie"},
"Sallary":100000
},
{
"name":"Gena",
"IsManager":true,
"Spouse":null,
"Sallary":157103e-3
}
]

And then run /json-example with the script loaded.

alias json-example {
bread json-example.txt 0 $file(json-example.txt).size &bvar

; Parse top level
var %aEmployees = $json.parse(&bvar)
echo -atg The top level is a(n) $json.type(%aEmployees)

var %cEmployees = $json(%aEmployees).length
echo -atg Number of employees: %cEmployees

var %i = 0
while (%i < %cEmployees) {
var %oEmployee = $json(%aEmployees,%i)
inc %i

echo -atg Name: $json(%oEmployee,name).text
echo -atg IsManager: $json(%oEmployee,ismanager).text
var %spouse = $json(%oEmployee,spouse)
if (%spouse) { echo -atg Spouse: $json(%spouse,name).text }
echo -atg Sallary: $json(%oEmployee,Sallary).text
}

; Free memory
json.freeall %aEmployees
}

==Script==
;$json.parse(&bvar | json string) - Parses a json and returns you a "handle". Use this in the other functions
; If the handle is "ERROR N" then N is an error code
; $json(handle,N/PROPERTY)
; Given a handle (use json.parse first) allows you to index an array or get a handle to a property by its name
; .text - Returns a data property or array index as text, e.g. $json($json.parse({"foo":"bar"}),bar).text
; .bvar - Returns a data property or array index as a binvar
; $json.freeall(handle)
; Frees memory used to parse the given handle
;$json.parse(&bvar | json string) - Parses a json and returns you a "handle". Use this in the other functions
; If the handle is "ERROR N" then N is an error code
alias json.parse {
var %bvar = $false
if (&* iswm $1) {
%bvar = $1
}
else {
%bvar = $json.createbvar
bset -t %bvar 1 $1-
}
return $json.parseany(%bvar)
}
; $json.type(handle) - Returns ARRAY, OBJECT, or Data
alias json.type {
tokenize 32 $1-
if ($1 == 1) { return OBJECT }
elseif ($1 == 2) { return ARRAY }
elseif ($1 == 3) { return DATA }
else return UNKNOWN TYPE $1
}
; $json(handle [,N/PROPERTY])
; Give a handle (use json.parse first) allows you to
; Get a property value
; Index into an array
; Get the Nth property name of an object
; .text - Returns a data property or array index as text, e.g. $json($json.parse({"foo":"bar"}),bar).text
; .bvar - Returns a data property or array index as a binvar
; .length - If the property is an array, or the handle is an array that isn't indexed, returns its length
alias json {
var %type = $gettok($1,1,32)
var %value = $gettok($1,2-,32)
if ($2 isnum && %type == 3) {
; Can't index non array
echo -atg $json Cannot index data type
return
}
; Indexing into an array
if ($2 isnum && %type == 2) {
var %datatable = $gettok(%value,1,32)
var %typetable = $gettok(%value,2,32)
var %thistype = $hget(%typetable,$2)
var %thisdata = $hget(%datatable,$2)
if (!%thistype) { return $null }
if (%thistype == 3 && $prop == bvar) {
var %bv = $json.createbvar
noop $hget(%datatable,$2,%bv)
return %bv
}
elseif (%thistype == 3 && $prop == text) {
return %thisdata
}
elseif (%thistype == 3) {
var %bv = $json.createbvar
noop $hget(%datatable,$2,%bv)
return %thistype %bv
}
elseif (%thistype != 3) {
return %thistype %thisdata
}
}
elseif (%type == 2 && $prop == length) {
; If we're not indexing, but we have an array with the .length property, return its length
; Return length of the data table for the array
return $hget($gettok(%value,1,32),0).item
}
; Getting a property of an object
elseif (%type == 1 && $2 !isnum) {
var %proptype = $json.getproperty(%value,$2).type
var %propvalue = $json.getproperty(%value,$2).value
var %propbv = $json.getproperty(%value,$2).bvar
if (!%proptype) { return $null }
if (%proptype == 3 && $prop == text) {
return %propvalue
}
elseif (%proptype == 3 && $prop == bvar) {
return %propbv
}
elseif (%proptype == 3) {
return %proptype %propbv
}
elseif (%proptype == 2 && $prop == length) {
; Return length of the data table for the array
return $hget($gettok(%propvalue,1,32),0).item
}
else {
return %proptype %propvalue
}
}
elseif (%type == 1 && $2 isnum) {
; Indexing object by index offset
var %thisIndex = 0
var %i = 1
while ($hget(%value,%i).item) {
inc %i
var %item = $ifmatch
var %propName = $gettok(%item,2-,$asc(.))
if (type.* iswm %item) {
inc %thisIndex
}
if (%thisIndex == $2) {
return %propName
}
if ($2 == 0) { return %thisIndex }
return $null
}
}
else {
echo -atg Unknown usage of $!json --> Prop: $prop P1: $1 P2: $2
}
}
; Hash table layout:
; Name: json.<ticks><rand1,4294967295>
; Key: Name of json property
; Value <N> <value>
; N: 1 = pointer to another object, 3 = raw value
; 2 = <pointer to data array> <pointer to assoc array indicating types of data array>
; $json.proxyrecurse(idname, param1, param2)
alias -l json.proxyrecurse2 {
; json.debug Recurse on: return $($+($,$1,$chr(40),$2,$chr(44),$3,$chr(41)),1)
return $($+($,$1,$chr(40),$2,$chr(44),$3,$chr(41)),2)
}
; /json.freeall <type> <value>
alias json.freeall {
if (!$isid) {
noop $json.proxyrecurse2(json.freeall,$1,$2-)
return
}
json.debug ?4freeall $1-
; For binary data, just return
if ($1 == 3) {
return
}
; For arrays, call on each element then hfree tables
elseif ($1 == 2) {
var %datatable = $gettok($2,1,32)
var %typetable = $gettok($2,2,32)
json.debug FreeAll: Freeing array, datatable: %datatable - typetable: %typetable
var %i = 0
while ($hget(%typetable,%i)) {
var %elementType = $ifmatch
if (%elementType == 3) {
inc %i
continue
}
noop $json.proxyrecurse2(json.freeall,%elementType,$hget(%datatable,%i))
inc %i
}
.hfree %datatable
.hfree %typetable
}
; For objects, call on every property then hfree table
elseif ($1 == 1) {
var %i = 1
while ($hget($2,%i).item) {
inc %i
var %item = $ifmatch
if (type.* iswm %item) {
var %membername = $gettok(%item,2-,$asc(.))
noop $json.proxyrecurse2(json.freeall,$hget($2,%item), $hget($2,value. $+ %membername))
}
}
.hfree $2
}
}
; Parses an array, object, string or int, depending on the next character, and returns <type> <value>
; or returns "ERROR <error>
alias -l json.parseany {
; Now, read the value of the property
if ($bvar($1,1) == $json.chars().STRING_START) {
json.debug Parseany detected a string
var %strVal = $json.parsestring($1)
if (%strVal isnum) {
json.debug Error parsing string: %error
return ERROR %strVal
}
json.debug ParseAny: Read string value: $bvar(%strval,1-).text
return 3 %strval
}
elseif ($bvar($1,1) == $json.chars().OBJECT_START) {
json.debug ParseAny: detected an object
var %obj = $json.parseobject($1)
if (%obj isnum) { json.debug ParseAny: Error reading object subvalue ( $+ %obj $+ ) | return ERROR %obj }
json.debug ParseAny: Read object subvalue as %obj
return 1 %obj
}
elseif ($bvar($1,1) == $json.chars().ARRAY_START) {
json.debug Parseany detected an array
var %array = $json.parsearray($1)
if (%array isnum) {
json.debug ParseAny: error reading array subvalue: %array
return ERROR %array
}
json.debug ParseAny: Read array subvalue as %array
return 2 %array
}
elseif ($bvar($1,1,4).text == null) {
json.debug ParseAny found NULL value
json.trimstart $1 4
return 3 $null
}
elseif ($bvar($1,1,5).text == false || $bvar($1,1,4).text == true) {
var %value = $iif($bvar($1,1,5).text == false,$false,$true)
; if true, trim 'true' off the top, otherwise trim 'false'
if (%value) { json.trimstart $1 4 }
else { json.trimstart $1 5 }
json.debug ParseAny found bool value: %value
return 3 %value
}
; Must be an int
else {
var %int = $json.parseint($1)
if (%int isnum) {
json.debug Error reading int subvalue: %int
return ERROR %int
}
if ($bvar(%int,0) == 0) {
return ERROR $json.errors().UNEXPECTED_CHAR
}
json.debug Read int subvalue into var %int as $bvar(%int,1-).text
return 3 %int
}
}
; $json.parseobject(&binvar) - returns object name or error code
alias -l json.parseobject {
if ($bvar($1,1) == $json.chars().OBJECT_START) {
; Trim off {
json.trimstart $1 1
}
var %table = $json.createtable
var %error = 0
:property
noop $json.consumewhitespace($1)
if ($bvar($1,1) != $json.chars().STRING_START) { %error = $json.errors().EXPECTED_START | goto return }
; Property name
var %strPropName = $json.parsestring($1)
if (%strPropName isnum) { json.debug Error reading property name for object $1 }
else {
%strPropName = $bvar(%strPropName,1-).text
json.debug ParseObject: Read property %strPropName
noop $json.consumewhitespace($1)
if ($bvar($1,1) != $json.chars().MAPPING) { %error = $json.errors().EXPECTED_MAPPING | goto return }
; trim the mapping character
json.trimstart $1 1
noop $json.consumewhitespace($1)
var %any = $json.parseany($1)
var %type = $gettok(%any,1,32)
var %value = $gettok(%any,2-,32)
if (%type == ERROR) {
%error = %value
goto return
}
if (%type == 3) {
; rvalue
hadd %table type. $+ %strPropName 3
if (%value == $true || %value == $false) {
json.debug PasrseObject; Found boolean value for %strPropName : %value
hadd %table value. $+ %strPropName %value
}
elseif (!$bvar(%value,0)) {
hadd %table value. $+ %strPropName $null
}
else {
hadd -b %table value. $+ %strPropName %value
}
}
else if (%type == 2) {
; Arrays
json.debug Read array %strPropName as %value for object %table
hadd %table type. $+ %strPropName 2
; Add array hashtable
hadd %table value. $+ %strPropName %value
}
else if (%type == 1) {
hadd %table type. $+ %strPropName 1
; Add object naem to table
hadd %table value. $+ %strPropName %value
}
}
; Check to see if there are more properties
noop $json.consumewhitespace($1)
if ($bvar($1,1) == $json.chars().OBJECT_END) { json.debug Successful object parsing. | json.trimstart $1 1 | goto return }
elseif ($bvar($1,1) == $json.chars().DELIMITER) { json.trimstart $1 1 | goto property }
else { return $json.errors().UNEXPECTED_CHAR }
:return
if (%error) {
json.debug ParseObject Exiting with error %error
json.freeall 1 %table
return %error
}
return %table
}
; $json.parsestring(&binvar) - returns string (binvar) or error code
alias -l json.parsestring {
var %bv = $json.createbvar
if ($bvar($1,1) != $json.chars().STRING_START) { return $json.errors().EXPECTED_START }
json.trimstart $1 1
var %escape = 0
:loop
if ($bvar($1,1) == $json.chars().STRING_ESCAPE) {
if (%escape) {
; If the escape character is escaped, append it
dec %escape
goto append
}
else {
inc %escape
; Skip appending
goto trim
}
}
if (%escape) {
if ($bvar($1,1) == $asc(r)) { bset $1 1 $cr | dec %escape }
if ($bvar($1,1) == $asc(n)) { bset $1 1 $lf | dec %escape }
if ($bvar($1,1) == $asc(t)) { bset $1 1 9 | dec %escape }
if ($bvar($1,1) == $asc(b)) { bset $1 1 8 | dec %escape }
}
:append
; If we're at the end of a string and not escaped, bail out
if ($bvar($1,1) == $json.chars().STRING_END && !%escape) {
json.trimstart $1 1
bset %bv $calc($bvar(%bv,0) +1) 0
return %bv
}
; Add this character to the end
bset %bv $calc($bvar(%bv,0) +1) $bvar($1,1)
if (%escape) { dec %escape }
:trim
; Trim from the start
json.trimstart $1 1
; Make sure we haven't consumed all the input
if ($bvar($1,0)) {
goto loop
}
return %bv
}
; $json.parseint(&binvar) - returns an int or error code
alias -l json.parseint {
var %bv = &json.createbvar
; Lax on the number format since its a string for us anyway
while ($bvar($1,1).text isnum || $bvar($1,1) == $asc(.) || $bvar($1,1) == $asc(-) || $bvar($1,1) == $asc(+) || $bvar($1,1) == $asc(e)) {
bset %bv $calc($bvar(%bv,0) +1) $bvar($1,1)
json.trimstart $1 1
}
return %bv
}
; $json.parsearray - returns array tables (data, types) or error code
alias -l json.parsearray {
if ($bvar($1,1) != $json.chars().ARRAY_START) {
return $json.errors().EXPECTED_START
}
json.trimstart $1 1
; Create a linked list for the data
var %datatable = $json.createtable(1)
; Create a linked list for the types (associative with respect to the data list)
var %typetable = $json.createtable(1)
noop $json.consumewhitespace($1)
if ($bvar($1,1) == $json.chars().ARRAY_END) {
json.debug Parsed empty array successfully
json.trimstart $1 1
return %datatable %typetable
}
:member
noop $json.consumewhitespace($1)
; Parse members
var %any = $json.parseany($1)
var %type = $gettok(%any,1,32)
var %value = $gettok(%any,2-,32)
if (%type == ERROR) {
json.debug Error parsing array member: %value
json.freeall 2 %datatable %typetable
return %value
}
else {
; 0 indexed
var %newindex = $calc($hget(%datatable,0).item)
; Binary data
json.debug ParseArray: Add type %type array index %newindex as %value
if (%type == 3) {
hadd -b %datatable %newindex %value
}
else {
hadd %datatable %newindex %value
}
hadd %typetable %newindex %type
}
noop $json.consumewhitespace($1)
if ($bvar($1,1) == $json.chars().DELIMITER) {
json.trimstart $1 1
goto member
}
elseif ($bvar($1,1) == $json.chars().ARRAY_END) {
json.debug Parsed array successfully
json.trimstart $1 1
return %datatable %typetable
}
:exit
json.debug ParseArray failed with an unknown error. Read characters: $bvar($1,1)
json.freeall 2 %datatable %typetable
return $json.errors().UNEXPECTED_CHAR
}
; $json.consumewhitespace(&binvar) - returns number consumed
alias -l json.consumewhitespace {
while ($bvar($1,0) && ($bvar($1,1) == 32 || $bvar($1,1) == 9 || $bvar($1,1) == 160 || $bvar($1,1) == 10 || $bvar($1,1) == 13)) {
json.trimstart $1 1
}
}
; /json.trimstart &binvar length - trims length characters from the start of $binvar
alias -l json.trimstart {
; json.debug Trimstart: $1 $2 -- Size of bvar: $bvar($1,0)
if ($bvar($1,0) == 1) { bunset $1 }
else { bcopy -c $1 1 $1 $calc($2 +1) -1 }
}
; $json.getpropery(table, property).type - Returns number representing type of property
; $json.getproperty(table, property).value - Returns value of property
; $json.getproperty(table, property).bvar - Returns value of property as bvar
; $json.getproperty(table, property).arraytypetable - If property is array, returns its type table
; $json.getproperty(table, property).arraydatatable - If property is table,r eturns its data table
alias -l json.getproperty {
var %type = $hget($1,type. $+ $2)
var %value = $hget($1,value. $+ $2)
if ($prop == type) { return %type }
if ($prop == bvar) { noop $hget($1, value. $+ $2, &bvReturn) | return &bvReturn }
if ($prop == arraytypetable) { return $gettok(%value,2,32) }
if ($prop == arraydatatable) { return $gettok(%value,1,32) }
return %value
}
; $json.createtable - Creates a hashtable and returns its name
; $json.createtable(N) - gives it size N
alias -l json.createtable {
var %ticks = $ticks
var %rand = $rand(1,4294967295)
var %table = $+(json.,%ticks,.,%rand)
hmake %table $iif($1,$1,10)
return %table
}
; Creates a random binvar name to avoid collisions
alias -l json.createbvar {
var %ticks = $ticks
var %rand = $rand(1,4294967295)
var %bv = $+(&jsonbv.,%ticks,.,%rand)
return %bv
}
alias -l json.chars {
; {
if ($prop == OBJECT_START) { return 123 }
; }
if ($prop == OBJECT_END) { return 125 }
; "
if ($prop == STRING_START || $prop == STRING_END) { return 34 }
if ($prop == STRING_ESCAPE) { return $asc(\) }
if ($prop == ARRAY_START) { return $asc([) }
if ($prop == ARRAY_END) { return $asc(]) }
; ,
if ($prop == DELIMITER) { return 44 }
if ($prop == MAPPING) { return $asc(:) }
}
alias -l json.errors {
if ($prop == EXPECTED_START) { return 1 }
if ($prop == EXPECTED_END) { return 2 }
if ($prop == EXPECTED_DELIMITER) { return 3 }
if ($prop == EXPECTED_MAPPING) { return 4 }
if ($prop == UNEXPECTED_CHAR) { return 5 }
return 255
}
alias -l json.debug {
; echo -atg Debug: $1-
}

MJSON

2015-01-23T06:07:39Z

Aca20031:

This script is a 100% native way of parsing JSON with an easy API

==Example==
To use the below example, Save the following JSON in "json-example.txt" in $mircdir

[
{
"name":"Todd",
"IsManager":false,
"Spouse":{"Name":"Marie"},
"Sallary":100000
},
{
"name":"Gena",
"IsManager":true,
"Spouse":null,
"Sallary":157103e-3
}
]

And then run /json-example with the script loaded.

alias json-example {
bread json-example.txt 0 $file(json-example.txt).size &bvar

; Parse top level
var %aEmployees = $json.parse(&bvar)
echo -atg The top level is a(n) $json.type(%aEmployees)

var %cEmployees = $json(%aEmployees).length
echo -atg Number of employees: %cEmployees

var %i = 0
while (%i < %cEmployees) {
var %oEmployee = $json(%aEmployees,%i)
inc %i

echo -atg Name: $json(%oEmployee,name).text
echo -atg IsManager: $json(%oEmployee,ismanager).text
var %spouse = $json(%oEmployee,spouse)
if (%spouse) { echo -atg Spouse: $json(%spouse,name).text }
echo -atg Sallary: $json(%oEmployee,Sallary).text
}

; Free memory
json.freeall %aEmployees
}

==Script==
;$json.parse(&bvar | json string) - Parses a json and returns you a "handle". Use this in the other functions
; If the handle is "ERROR N" then N is an error code
; $json(handle,N/PROPERTY)
; Given a handle (use json.parse first) allows you to index an array or get a handle to a property by its name
; .text - Returns a data property or array index as text, e.g. $json($json.parse({"foo":"bar"}),bar).text
; .bvar - Returns a data property or array index as a binvar
; $json.freeall(handle)
; Frees memory used to parse the given handle
;$json.parse(&bvar | json string) - Parses a json and returns you a "handle". Use this in the other functions
; If the handle is "ERROR N" then N is an error code
alias json.parse {
var %bvar = $false
if (&* iswm $1) {
%bvar = $1
}
else {
%bvar = $json.createbvar
bset -t %bvar 1 $1-
}
return $json.parseany(%bvar)
}
; $json.type(handle) - Returns ARRAY, OBJECT, or Data
alias json.type {
tokenize 32 $1-
if ($1 == 1) { return OBJECT }
elseif ($1 == 2) { return ARRAY }
elseif ($1 == 3) { return DATA }
else return UNKNOWN TYPE $1
}
; $json(handle [,N/PROPERTY])
; Give a handle (use json.parse first) allows you to
; Get a property value
; Index into an array
; Get the Nth property name of an object
; .text - Returns a data property or array index as text, e.g. $json($json.parse({"foo":"bar"}),bar).text
; .bvar - Returns a data property or array index as a binvar
; .length - If the property is an array, or the handle is an array that isn't indexed, returns its length
alias json {
var %type = $gettok($1,1,32)
var %value = $gettok($1,2-,32)
if ($2 isnum && %type == 3) {
; Can't index non array
echo -atg $json Cannot index data type
return
}
; Indexing into an array
if ($2 isnum && %type == 2) {
var %datatable = $gettok(%value,1,32)
var %typetable = $gettok(%value,2,32)
var %thistype = $hget(%typetable,$2)
var %thisdata = $hget(%datatable,$2)
if (!%thistype) { return $null }
if (%thistype == 3 && $prop == bvar) {
var %bv = $json.createbvar
noop $hget(%datatable,$2,%bv)
return %bv
}
elseif (%thistype == 3 && $prop == text) {
return %thisdata
}
elseif (%thistype == 3) {
var %bv = $json.createbvar
noop $hget(%datatable,$2,%bv)
return %thistype %bv
}
elseif (%thistype != 3) {
return %thistype %thisdata
}
}
elseif (%type == 2 && $prop == length) {
; If we're not indexing, but we have an array with the .length property, return its length
; Return length of the data table for the array
return $hget($gettok(%value,1,32),0).item
}
; Getting a property of an object
elseif (%type == 1 && $2 !isnum) {
var %proptype = $json.getproperty(%value,$2).type
var %propvalue = $json.getproperty(%value,$2).value
var %propbv = $json.getproperty(%value,$2).bvar
if (!%proptype) { return $null }
if (%proptype == 3 && $prop == text) {
return %propvalue
}
elseif (%proptype == 3 && $prop == bvar) {
return %propbv
}
elseif (%proptype == 3) {
return %proptype %propbv
}
elseif (%proptype == 2 && $prop == length) {
; Return length of the data table for the array
return $hget($gettok(%propvalue,1,32),0).item
}
else {
return %proptype %propvalue
}
}
elseif (%type == 1 && $2 isnum) {
; Indexing object by index offset
var %thisIndex = 0
var %i = 1
while ($hget(%value,%i).item) {
inc %i
var %item = $ifmatch
var %propName = $gettok(%item,2-,$asc(.))
if (type.* iswm %item) {
inc %thisIndex
}
if (%thisIndex == $2) {
return %propName
}
if ($2 == 0) { return %thisIndex }
return $null
}
}
else {
echo -atg Unknown usage of $!json --> Prop: $prop P1: $1 P2: $2
}
}
; Hash table layout:
; Name: json.<ticks><rand1,4294967295>
; Key: Name of json property
; Value <N> <value>
; N: 1 = pointer to another object, 3 = raw value
; 2 = <pointer to data array> <pointer to assoc array indicating types of data array>
; $json.proxyrecurse(idname, param1, param2)
alias -l json.proxyrecurse2 {
; json.debug Recurse on: return $($+($,$1,$chr(40),$2,$chr(44),$3,$chr(41)),1)
return $($+($,$1,$chr(40),$2,$chr(44),$3,$chr(41)),2)
}
; /json.freeall <type> <value>
alias json.freeall {
if (!$isid) {
noop $json.proxyrecurse2(json.freeall,$1,$2-)
return
}
json.debug ?4freeall $1-
; For binary data, just return
if ($1 == 3) {
return
}
; For arrays, call on each element then hfree tables
elseif ($1 == 2) {
var %datatable = $gettok($2,1,32)
var %typetable = $gettok($2,2,32)
json.debug FreeAll: Freeing array, datatable: %datatable - typetable: %typetable
var %i = 0
while ($hget(%typetable,%i)) {
var %elementType = $ifmatch
if (%elementType == 3) {
inc %i
continue
}
noop $json.proxyrecurse2(json.freeall,%elementType,$hget(%datatable,%i))
inc %i
}
.hfree %datatable
.hfree %typetable
}
; For objects, call on every property then hfree table
elseif ($1 == 1) {
var %i = 1
while ($hget($2,%i).item) {
inc %i
var %item = $ifmatch
if (type.* iswm %item) {
var %membername = $gettok(%item,2-,$asc(.))
noop $json.proxyrecurse2(json.freeall,$hget($2,%item), $hget($2,value. $+ %membername))
}
}
.hfree $2
}
}
; Parses an array, object, string or int, depending on the next character, and returns <type> <value>
; or returns "ERROR <error>
alias -l json.parseany {
; Now, read the value of the property
if ($bvar($1,1) == $json.chars().STRING_START) {
json.debug Parseany detected a string
var %strVal = $json.parsestring($1)
if (%strVal isnum) {
json.debug Error parsing string: %error
return ERROR %strVal
}
json.debug ParseAny: Read string value: $bvar(%strval,1-).text
return 3 %strval
}
elseif ($bvar($1,1) == $json.chars().OBJECT_START) {
json.debug ParseAny: detected an object
var %obj = $json.parseobject($1)
if (%obj isnum) { json.debug ParseAny: Error reading object subvalue ( $+ %obj $+ ) | return ERROR %obj }
json.debug ParseAny: Read object subvalue as %obj
return 1 %obj
}
elseif ($bvar($1,1) == $json.chars().ARRAY_START) {
json.debug Parseany detected an array
var %array = $json.parsearray($1)
if (%array isnum) {
json.debug ParseAny: error reading array subvalue: %array
return ERROR %array
}
json.debug ParseAny: Read array subvalue as %array
return 2 %array
}
elseif ($bvar($1,1,4).text == null) {
json.debug ParseAny found NULL value
json.trimstart $1 4
return 3 $null
}
elseif ($bvar($1,1,5).text == false || $bvar($1,1,4).text == true) {
var %value = $iif($bvar($1,1,5).text == false,$false,$true)
; if true, trim 'true' off the top, otherwise trim 'false'
if (%value) { json.trimstart $1 4 }
else { json.trimstart $1 5 }
json.debug ParseAny found bool value: %value
return 3 %value
}
; Must be an int
else {
var %int = $json.parseint($1)
if (%int isnum) {
json.debug Error reading int subvalue: %int
return ERROR %int
}
if ($bvar(%int,0) == 0) {
return ERROR $json.errors().UNEXPECTED_CHAR
}
json.debug Read int subvalue into var %int as $bvar(%int,1-).text
return 3 %int
}
}
; $json.parseobject(&binvar) - returns object name or error code
alias -l json.parseobject {
if ($bvar($1,1) == $json.chars().OBJECT_START) {
; Trim off {
json.trimstart $1 1
}
var %table = $json.createtable
var %error = 0
:property
noop $json.consumewhitespace($1)
if ($bvar($1,1) != $json.chars().STRING_START) { %error = $json.errors().EXPECTED_START | goto return }
; Property name
var %strPropName = $json.parsestring($1)
if (%strPropName isnum) { json.debug Error reading property name for object $1 }
else {
%strPropName = $bvar(%strPropName,1-).text
json.debug ParseObject: Read property %strPropName
noop $json.consumewhitespace($1)
if ($bvar($1,1) != $json.chars().MAPPING) { %error = $json.errors().EXPECTED_MAPPING | goto return }
; trim the mapping character
json.trimstart $1 1
noop $json.consumewhitespace($1)
var %any = $json.parseany($1)
var %type = $gettok(%any,1,32)
var %value = $gettok(%any,2-,32)
if (%type == ERROR) {
%error = %value
goto return
}
if (%type == 3) {
; rvalue
hadd %table type. $+ %strPropName 3
if (%value == $true || %value == $false) {
json.debug PasrseObject; Found boolean value for %strPropName : %value
hadd %table value. $+ %strPropName %value
}
elseif (!$bvar(%value,0)) {
hadd %table value. $+ %strPropName $null
}
else {
hadd -b %table value. $+ %strPropName %value
}
}
else if (%type == 2) {
; Arrays
json.debug Read array %strPropName as %value for object %table
hadd %table type. $+ %strPropName 2
; Add array hashtable
hadd %table value. $+ %strPropName %value
}
else if (%type == 1) {
hadd %table type. $+ %strPropName 1
; Add object naem to table
hadd %table value. $+ %strPropName %value
}
}
; Check to see if there are more properties
noop $json.consumewhitespace($1)
if ($bvar($1,1) == $json.chars().OBJECT_END) { json.debug Successful object parsing. | json.trimstart $1 1 | goto return }
elseif ($bvar($1,1) == $json.chars().DELIMITER) { json.trimstart $1 1 | goto property }
else { return $json.errors().UNEXPECTED_CHAR }
:return
if (%error) {
json.debug ParseObject Exiting with error %error
json.freeall 1 %table
return %error
}
return %table
}
; $json.parsestring(&binvar) - returns string (binvar) or error code
alias -l json.parsestring {
var %bv = $json.createbvar
if ($bvar($1,1) != $json.chars().STRING_START) { return $json.errors().EXPECTED_START }
json.trimstart $1 1
var %escape = 0
:loop
if ($bvar($1,1) == $json.chars().STRING_ESCAPE) {
if (%escape) {
; If the escape character is escaped, append it
dec %escape
goto append
}
else {
inc %escape
; Skip appending
goto trim
}
}
if (%escape) {
if ($bvar($1,1) == $asc(r)) { bset $1 1 $cr | dec %escape }
if ($bvar($1,1) == $asc(n)) { bset $1 1 $lf | dec %escape }
if ($bvar($1,1) == $asc(t)) { bset $1 1 9 | dec %escape }
if ($bvar($1,1) == $asc(b)) { bset $1 1 8 | dec %escape }
}
:append
; If we're at the end of a string and not escaped, bail out
if ($bvar($1,1) == $json.chars().STRING_END && !%escape) {
json.trimstart $1 1
bset %bv $calc($bvar(%bv,0) +1) 0
return %bv
}
; Add this character to the end
bset %bv $calc($bvar(%bv,0) +1) $bvar($1,1)
if (%escape) { dec %escape }
:trim
; Trim from the start
json.trimstart $1 1
; Make sure we haven't consumed all the input
if ($bvar($1,0)) {
goto loop
}
return %bv
}
; $json.parseint(&binvar) - returns an int or error code
alias -l json.parseint {
var %bv = &json.createbvar
; Lax on the number format since its a string for us anyway
while ($bvar($1,1).text isnum || $bvar($1,1) == $asc(.) || $bvar($1,1) == $asc(-) || $bvar($1,1) == $asc(+) || $bvar($1,1) == $asc(e)) {
bset %bv $calc($bvar(%bv,0) +1) $bvar($1,1)
json.trimstart $1 1
}
return %bv
}
$json.parsearray - returns array tables (data, types) or error code
alias -l json.parsearray {
if ($bvar($1,1) != $json.chars().ARRAY_START) {
return $json.errors().EXPECTED_START
}
json.trimstart $1 1
; Create a linked list for the data
var %datatable = $json.createtable(1)
; Create a linked list for the types (associative with respect to the data list)
var %typetable = $json.createtable(1)
:member
noop $json.consumewhitespace($1)
; Parse members
var %any = $json.parseany($1)
var %type = $gettok(%any,1,32)
var %value = $gettok(%any,2-,32)
if (%type == ERROR) {
json.debug Error parsing array member: %value
json.freeall 2 %datatable %typetable
return %value
}
else {
; 0 indexed
var %newindex = $calc($hget(%datatable,0).item)
; Binary data
json.debug ParseArray: Add type %type array index %newindex as %value
if (%type == 3) {
hadd -b %datatable %newindex %value
}
else {
hadd %datatable %newindex %value
}
hadd %typetable %newindex %type
}
noop $json.consumewhitespace($1)
if ($bvar($1,1) == $json.chars().DELIMITER) {
json.trimstart $1 1
goto member
}
elseif ($bvar($1,1) == $json.chars().ARRAY_END) {
json.debug Parsed array successfully
json.trimstart $1 1
return %datatable %typetable
}
json.debug ParseArray failed with an unknown error. Read characters: $bvar($1,1)
json.freeall 2 %datatable %typetable
return $json.errors().UNEXPECTED_CHAR
}
; $json.consumewhitespace(&binvar) - returns number consumed
alias -l json.consumewhitespace {
while ($bvar($1,0) && ($bvar($1,1) == 32 || $bvar($1,1) == 9 || $bvar($1,1) == 160 || $bvar($1,1) == 10 || $bvar($1,1) == 13)) {
json.trimstart $1 1
}
}
; /json.trimstart &binvar length - trims length characters from the start of $binvar
alias -l json.trimstart {
; json.debug Trimstart: $1 $2 -- Size of bvar: $bvar($1,0)
if ($bvar($1,0) == 1) { bunset $1 }
else { bcopy -c $1 1 $1 $calc($2 +1) -1 }
}
; $json.getpropery(table, property).type - Returns number representing type of property
; $json.getproperty(table, property).value - Returns value of property
; $json.getproperty(table, property).bvar - Returns value of property as bvar
; $json.getproperty(table, property).arraytypetable - If property is array, returns its type table
; $json.getproperty(table, property).arraydatatable - If property is table,r eturns its data table
alias -l json.getproperty {
var %type = $hget($1,type. $+ $2)
var %value = $hget($1,value. $+ $2)
if ($prop == type) { return %type }
if ($prop == bvar) { noop $hget($1, value. $+ $2, &bvReturn) | return &bvReturn }
if ($prop == arraytypetable) { return $gettok(%value,2,32) }
if ($prop == arraydatatable) { return $gettok(%value,1,32) }
return %value
}
; $json.createtable - Creates a hashtable and returns its name
; $json.createtable(N) - gives it size N
alias -l json.createtable {
var %ticks = $ticks
var %rand = $rand(1,4294967295)
var %table = $+(json.,%ticks,.,%rand)
hmake %table $iif($1,$1,10)
return %table
}
; Creates a random binvar name to avoid collisions
alias -l json.createbvar {
var %ticks = $ticks
var %rand = $rand(1,4294967295)
var %bv = $+(&jsonbv.,%ticks,.,%rand)
return %bv
}
alias -l json.chars {
; {
if ($prop == OBJECT_START) { return 123 }
; }
if ($prop == OBJECT_END) { return 125 }
; "
if ($prop == STRING_START || $prop == STRING_END) { return 34 }
if ($prop == STRING_ESCAPE) { return $asc(\) }
if ($prop == ARRAY_START) { return $asc([) }
if ($prop == ARRAY_END) { return $asc(]) }
; ,
if ($prop == DELIMITER) { return 44 }
if ($prop == MAPPING) { return $asc(:) }
}
alias -l json.errors {
if ($prop == EXPECTED_START) { return 1 }
if ($prop == EXPECTED_END) { return 2 }
if ($prop == EXPECTED_DELIMITER) { return 3 }
if ($prop == EXPECTED_MAPPING) { return 4 }
if ($prop == UNEXPECTED_CHAR) { return 5 }
return 255
}
alias -l json.debug {
; echo -atg Debug: $1-
}

MJSON

2015-01-23T02:31:38Z

Aca20031: /* Script */

This script is a 100% native way of parsing JSON with an easy API

==Example==
To use the below example, Save the following JSON in "json-example.txt" in $mircdir

[
{
"name":"Todd",
"IsManager":false,
"Spouse":{"Name":"Marie"},
"Sallary":100000
},
{
"name":"Gena",
"IsManager":true,
"Spouse":null,
"Sallary":157103e-3
}
]

And then run /json-example with the script loaded.

alias json-example {
bread json-example.txt 0 $file(json-example.txt).size &bvar

; Parse top level
var %aEmployees = $json.parse(&bvar)
echo -atg The top level is a(n) $json.type(%aEmployees)

var %cEmployees = $json(%aEmployees).length
echo -atg Number of employees: %cEmployees

var %i = 0
while (%i < %cEmployees) {
var %oEmployee = $json(%aEmployees,%i)
inc %i

echo -atg Name: $json(%oEmployee,name).text
echo -atg IsManager: $json(%oEmployee,ismanager).text
var %spouse = $json(%oEmployee,spouse)
if (%spouse) { echo -atg Spouse: $json(%spouse,name).text }
echo -atg Sallary: $json(%oEmployee,Sallary).text
}

; Free memory
json.freeall %aEmployees
}

==Script==
;$json.parse(&bvar | json string) - Parses a json and returns you a "handle". Use this in the other functions
; If the handle is "ERROR N" then N is an error code
; $json(handle,N/PROPERTY)
; Given a handle (use json.parse first) allows you to index an array or get a handle to a property by its name
; .text - Returns a data property or array index as text, e.g. $json($json.parse({"foo":"bar"}),bar).text
; .bvar - Returns a data property or array index as a binvar
; $json.freeall(handle)
; Frees memory used to parse the given handle
;$json.parse(&bvar | json string) - Parses a json and returns you a "handle". Use this in the other functions
; If the handle is "ERROR N" then N is an error code
alias json.parse {
var %bvar = $false
if (&* iswm $1) {
%bvar = $1
}
else {
%bvar = $json.createbvar
bset -t %bvar 1 $1-
}
return $json.parseany(%bvar)
}
; $json.type(handle) - Returns ARRAY, OBJECT, or Data
alias json.type {
tokenize 32 $1-
if ($1 == 1) { return OBJECT }
elseif ($1 == 2) { return ARRAY }
elseif ($1 == 3) { return DATA }
else return UNKNOWN TYPE $1
}
; $json(handle [,N/PROPERTY])
; Give a handle (use json.parse first) allows you to
; Get a property value
; Index into an array
; Get the Nth property name of an object
; .text - Returns a data property or array index as text, e.g. $json($json.parse({"foo":"bar"}),bar).text
; .bvar - Returns a data property or array index as a binvar
; .length - If the property is an array, or the handle is an array that isn't indexed, returns its length
alias json {
var %type = $gettok($1,1,32)
var %value = $gettok($1,2-,32)
if ($2 isnum && %type == 3) {
; Can't index non array
echo -atg $json Cannot index data type
return
}
; Indexing into an array
if ($2 isnum && %type == 2) {
var %datatable = $gettok(%value,1,32)
var %typetable = $gettok(%value,2,32)
var %thistype = $hget(%typetable,$2)
var %thisdata = $hget(%datatable,$2)
if (!%thistype) { return $null }
if (%thistype == 3 && $prop == bvar) {
var %bv = $json.createbvar
noop $hget(%datatable,$2,%bv)
return %bv
}
elseif (%thistype == 3 && $prop == text) {
return %thisdata
}
elseif (%thistype == 3) {
var %bv = $json.createbvar
noop $hget(%datatable,$2,%bv)
return %thistype %bv
}
elseif (%thistype != 3) {
return %thistype %thisdata
}
}
elseif (%type == 2 && $prop == length) {
; If we're not indexing, but we have an array with the .length property, return its length
; Return length of the data table for the array
return $hget($gettok(%value,1,32),0).item
}
; Getting a property of an object
elseif (%type == 1 && $2 !isnum) {
var %proptype = $json.getproperty(%value,$2).type
var %propvalue = $json.getproperty(%value,$2).value
var %propbv = $json.getproperty(%value,$2).bvar
if (!%proptype) { return $null }
if (%proptype == 3 && $prop == text) {
return %propvalue
}
elseif (%proptype == 3 && $prop == bvar) {
return %propbv
}
elseif (%proptype == 3) {
return %proptype %propbv
}
elseif (%proptype == 2 && $prop == length) {
; Return length of the data table for the array
return $hget($gettok(%propvalue,1,32),0).item
}
else {
return %proptype %propvalue
}
}
elseif (%type == 1 && $2 isnum) {
; Indexing object by index offset
var %thisIndex = 0
var %i = 1
while ($hget(%value,%i).item) {
inc %i
var %item = $ifmatch
var %propName = $gettok(%item,2-,$asc(.))
if (type.* iswm %item) {
inc %thisIndex
}
if (%thisIndex == $2) {
return %propName
}
if ($2 == 0) { return %thisIndex }
return $null
}
}
else {
echo -atg Unknown usage of $!json --> Prop: $prop P1: $1 P2: $2
}
}
; Hash table layout:
; Name: json.<ticks><rand1,4294967295>
; Key: Name of json property
; Value <N> <value>
; N: 1 = pointer to another object, 3 = raw value
; 2 = <pointer to data array> <pointer to assoc array indicating types of data array>
; $json.proxyrecurse(idname, param1, param2)
alias -l json.proxyrecurse2 {
; json.debug Recurse on: return $($+($,$1,$chr(40),$2,$chr(44),$3,$chr(41)),1)
return $($+($,$1,$chr(40),$2,$chr(44),$3,$chr(41)),2)
}
; /json.freeall <type> <value>
alias json.freeall {
if (!$isid) {
noop $json.proxyrecurse2(json.freeall,$1,$2-)
return
}
json.debug ?4freeall $1-
; For binary data, just return
if ($1 == 3) {
return
}
; For arrays, call on each element then hfree tables
elseif ($1 == 2) {
var %datatable = $gettok($2,1,32)
var %typetable = $gettok($2,2,32)
json.debug FreeAll: Freeing array, datatable: %datatable - typetable: %typetable
var %i = 0
while ($hget(%typetable,%i)) {
var %elementType = $ifmatch
if (%elementType == 3) {
inc %i
continue
}
noop $json.proxyrecurse2(json.freeall,%elementType,$hget(%datatable,%i))
inc %i
}
.hfree %datatable
.hfree %typetable
}
; For objects, call on every property then hfree table
elseif ($1 == 1) {
var %i = 1
while ($hget($2,%i).item) {
inc %i
var %item = $ifmatch
if (type.* iswm %item) {
var %membername = $gettok(%item,2-,$asc(.))
noop $json.proxyrecurse2(json.freeall,$hget($2,%item), $hget($2,value. $+ %membername))
}
}
.hfree $2
}
}
; Parses an array, object, string or int, depending on the next character, and returns <type> <value>
; or returns "ERROR <error>
alias -l json.parseany {
; Now, read the value of the property
if ($bvar($1,1) == $json.chars().STRING_START) {
json.debug Parseany detected a string
var %strVal = $json.parsestring($1)
if (%strVal isnum) {
json.debug Error parsing string: %error
return ERROR %strVal
}
json.debug ParseAny: Read string value: $bvar(%strval,1-).text
return 3 %strval
}
elseif ($bvar($1,1) == $json.chars().OBJECT_START) {
json.debug ParseAny: detected an object
var %obj = $json.parseobject($1)
if (%obj isnum) { json.debug ParseAny: Error reading object subvalue ( $+ %obj $+ ) | return ERROR %obj }
json.debug ParseAny: Read object subvalue as %obj
return 1 %obj
}
elseif ($bvar($1,1) == $json.chars().ARRAY_START) {
json.debug Parseany detected an array
var %array = $json.parsearray($1)
if (%array isnum) {
json.debug ParseAny: error reading array subvalue: %array
return ERROR %array
}
json.debug ParseAny: Read array subvalue as %array
return 2 %array
}
elseif ($bvar($1,1,4).text == null) {
json.debug ParseAny found NULL value
json.trimstart $1 4
return 3 $null
}
elseif ($bvar($1,1,5).text == false || $bvar($1,1,4).text == true) {
var %value = $iif($bvar($1,1,5).text == false,$false,$true)
; if true, trim 'true' off the top, otherwise trim 'false'
if (%value) { json.trimstart $1 4 }
else { json.trimstart $1 5 }
json.debug ParseAny found bool value: %value
return 3 %value
}
; Must be an int
else {
var %int = $json.parseint($1)
if (%int isnum) {
json.debug Error reading int subvalue: %int
return ERROR %int
}
if ($bvar(%int,0) == 0) {
return ERROR $json.errors().UNEXPECTED_CHAR
}
json.debug Read int subvalue into var %int as $bvar(%int,1-).text
return 3 %int
}
}
; $json.parseobject(&binvar) - returns object name or error code
alias -l json.parseobject {
if ($bvar($1,1) == $json.chars().OBJECT_START) {
; Trim off {
json.trimstart $1 1
}
var %table = $json.createtable
var %error = 0
:property
noop $json.consumewhitespace($1)
if ($bvar($1,1) != $json.chars().STRING_START) { %error = $json.errors().EXPECTED_START | goto return }
; Property name
var %strPropName = $json.parsestring($1)
if (%strPropName isnum) { json.debug Error reading property name for object $1 }
else {
%strPropName = $bvar(%strPropName,1-).text
json.debug ParseObject: Read property %strPropName
noop $json.consumewhitespace($1)
if ($bvar($1,1) != $json.chars().MAPPING) { %error = $json.errors().EXPECTED_MAPPING | goto return }
; trim the mapping character
json.trimstart $1 1
noop $json.consumewhitespace($1)
var %any = $json.parseany($1)
var %type = $gettok(%any,1,32)
var %value = $gettok(%any,2-,32)
if (%type == ERROR) {
%error = %value
goto return
}
if (%type == 3) {
; rvalue
hadd %table type. $+ %strPropName 3
if (%value == $true || %value == $false) {
json.debug PasrseObject; Found boolean value for %strPropName : %value
hadd %table value. $+ %strPropName %value
}
elseif (!$bvar(%value,0)) {
hadd %table value. $+ %strPropName $null
}
else {
hadd -b %table value. $+ %strPropName %value
}
}
else if (%type == 2) {
; Arrays
json.debug Read array %strPropName as %value for object %table
hadd %table type. $+ %strPropName 2
; Add array hashtable
hadd %table value. $+ %strPropName %value
}
else if (%type == 1) {
hadd %table type. $+ %strPropName 1
; Add object naem to table
hadd %table value. $+ %strPropName %value
}
}
; Check to see if there are more properties
noop $json.consumewhitespace($1)
if ($bvar($1,1) == $json.chars().OBJECT_END) { json.debug Successful object parsing. | json.trimstart $1 1 | goto return }
elseif ($bvar($1,1) == $json.chars().DELIMITER) { json.trimstart $1 1 | goto property }
else { return $json.errors().UNEXPECTED_CHAR }
:return
if (%error) {
json.debug ParseObject Exiting with error %error
json.freeall 1 %table
return %error
}
return %table
}
; $json.parsestring(&binvar) - returns string (binvar) or error code
alias -l json.parsestring {
var %bv = $json.createbvar
if ($bvar($1,1) != $json.chars().STRING_START) { return $json.errors().EXPECTED_START }
json.trimstart $1 1
var %escape = 0
:loop
if ($bvar($1,1) == $json.chars().STRING_ESCAPE) {
if (%escape) {
; If the escape character is escaped, append it
dec %escape
goto append
}
else {
inc %escape
; Skip appending
goto trim
}
}
if (%escape) {
if ($bvar($1,1) == $asc(r)) { bset $1 1 $cr | dec %escape }
if ($bvar($1,1) == $asc(n)) { bset $1 1 $lf | dec %escape }
if ($bvar($1,1) == $asc(t)) { bset $1 1 9 | dec %escape }
if ($bvar($1,1) == $asc(b)) { bset $1 1 8 | dec %escape }
}
:append
; If we're at the end of a string and not escaped, bail out
if ($bvar($1,1) == $json.chars().STRING_END && !%escape) {
json.trimstart $1 1
bset %bv $calc($bvar(%bv,0) +1) 0
return %bv
}
; Add this character to the end
bset %bv $calc($bvar(%bv,0) +1) $bvar($1,1)
:trim
; Trim from the start
json.trimstart $1 1
; Make sure we haven't consumed all the input
if ($bvar($1,0)) {
goto loop
}
return %bv
}
; $json.parseint(&binvar) - returns an int or error code
alias -l json.parseint {
var %bv = &json.createbvar
; Lax on the number format since its a string for us anyway
while ($bvar($1,1).text isnum || $bvar($1,1) == $asc(.) || $bvar($1,1) == $asc(-) || $bvar($1,1) == $asc(+) || $bvar($1,1) == $asc(e)) {
bset %bv $calc($bvar(%bv,0) +1) $bvar($1,1)
json.trimstart $1 1
}
return %bv
}
$json.parsearray - returns array tables (data, types) or error code
alias -l json.parsearray {
if ($bvar($1,1) != $json.chars().ARRAY_START) {
return $json.errors().EXPECTED_START
}
json.trimstart $1 1
; Create a linked list for the data
var %datatable = $json.createtable(1)
; Create a linked list for the types (associative with respect to the data list)
var %typetable = $json.createtable(1)
:member
noop $json.consumewhitespace($1)
; Parse members
var %any = $json.parseany($1)
var %type = $gettok(%any,1,32)
var %value = $gettok(%any,2-,32)
if (%type == ERROR) {
json.debug Error parsing array member: %value
json.freeall 2 %datatable %typetable
return %value
}
else {
; 0 indexed
var %newindex = $calc($hget(%datatable,0).item)
; Binary data
json.debug ParseArray: Add type %type array index %newindex as %value
if (%type == 3) {
hadd -b %datatable %newindex %value
}
else {
hadd %datatable %newindex %value
}
hadd %typetable %newindex %type
}
noop $json.consumewhitespace($1)
if ($bvar($1,1) == $json.chars().DELIMITER) {
json.trimstart $1 1
goto member
}
elseif ($bvar($1,1) == $json.chars().ARRAY_END) {
json.debug Parsed array successfully
json.trimstart $1 1
return %datatable %typetable
}
json.debug ParseArray failed with an unknown error. Read characters: $bvar($1,1)
json.freeall 2 %datatable %typetable
return $json.errors().UNEXPECTED_CHAR
}
; $json.consumewhitespace(&binvar) - returns number consumed
alias -l json.consumewhitespace {
while ($bvar($1,0) && ($bvar($1,1) == 32 || $bvar($1,1) == 9 || $bvar($1,1) == 160 || $bvar($1,1) == 10 || $bvar($1,1) == 13)) {
json.trimstart $1 1
}
}
; /json.trimstart &binvar length - trims length characters from the start of $binvar
alias -l json.trimstart {
; json.debug Trimstart: $1 $2 -- Size of bvar: $bvar($1,0)
if ($bvar($1,0) == 1) { bunset $1 }
else { bcopy -c $1 1 $1 $calc($2 +1) -1 }
}
; $json.getpropery(table, property).type - Returns number representing type of property
; $json.getproperty(table, property).value - Returns value of property
; $json.getproperty(table, property).bvar - Returns value of property as bvar
; $json.getproperty(table, property).arraytypetable - If property is array, returns its type table
; $json.getproperty(table, property).arraydatatable - If property is table,r eturns its data table
alias -l json.getproperty {
var %type = $hget($1,type. $+ $2)
var %value = $hget($1,value. $+ $2)
if ($prop == type) { return %type }
if ($prop == bvar) { noop $hget($1, value. $+ $2, &bvReturn) | return &bvReturn }
if ($prop == arraytypetable) { return $gettok(%value,2,32) }
if ($prop == arraydatatable) { return $gettok(%value,1,32) }
return %value
}
; $json.createtable - Creates a hashtable and returns its name
; $json.createtable(N) - gives it size N
alias -l json.createtable {
var %ticks = $ticks
var %rand = $rand(1,4294967295)
var %table = $+(json.,%ticks,.,%rand)
hmake %table $iif($1,$1,10)
return %table
}
; Creates a random binvar name to avoid collisions
alias -l json.createbvar {
var %ticks = $ticks
var %rand = $rand(1,4294967295)
var %bv = $+(&jsonbv.,%ticks,.,%rand)
return %bv
}
alias -l json.chars {
; {
if ($prop == OBJECT_START) { return 123 }
; }
if ($prop == OBJECT_END) { return 125 }
; "
if ($prop == STRING_START || $prop == STRING_END) { return 34 }
if ($prop == STRING_ESCAPE) { return $asc(\) }
if ($prop == ARRAY_START) { return $asc([) }
if ($prop == ARRAY_END) { return $asc(]) }
; ,
if ($prop == DELIMITER) { return 44 }
if ($prop == MAPPING) { return $asc(:) }
}
alias -l json.errors {
if ($prop == EXPECTED_START) { return 1 }
if ($prop == EXPECTED_END) { return 2 }
if ($prop == EXPECTED_DELIMITER) { return 3 }
if ($prop == EXPECTED_MAPPING) { return 4 }
if ($prop == UNEXPECTED_CHAR) { return 5 }
return 255
}
alias -l json.debug {
; echo -atg Debug: $1-
}

MJSON

2015-01-23T02:24:01Z

Aca20031: Parse string puts a null terminates and reads empty strings correctly now

This script is a 100% native way of parsing JSON with an easy API

==Example==
To use the below example, Save the following JSON in "json-example.txt" in $mircdir

[
{
"name":"Todd",
"IsManager":false,
"Spouse":{"Name":"Marie"},
"Sallary":100000
},
{
"name":"Gena",
"IsManager":true,
"Spouse":null,
"Sallary":157103e-3
}
]

And then run /json-example with the script loaded.

alias json-example {
bread json-example.txt 0 $file(json-example.txt).size &bvar

; Parse top level
var %aEmployees = $json.parse(&bvar)
echo -atg The top level is a(n) $json.type(%aEmployees)

var %cEmployees = $json(%aEmployees).length
echo -atg Number of employees: %cEmployees

var %i = 0
while (%i < %cEmployees) {
var %oEmployee = $json(%aEmployees,%i)
inc %i

echo -atg Name: $json(%oEmployee,name).text
echo -atg IsManager: $json(%oEmployee,ismanager).text
var %spouse = $json(%oEmployee,spouse)
if (%spouse) { echo -atg Spouse: $json(%spouse,name).text }
echo -atg Sallary: $json(%oEmployee,Sallary).text
}

; Free memory
json.freeall %aEmployees
}

==Script==
;$json.parse(&bvar | json string) - Parses a json and returns you a "handle". Use this in the other functions
; If the handle is "ERROR N" then N is an error code
; $json(handle,N/PROPERTY)
; Given a handle (use json.parse first) allows you to index an array or get a handle to a property by its name
; .text - Returns a data property or array index as text, e.g. $json($json.parse({"foo":"bar"}),bar).text
; .bvar - Returns a data property or array index as a binvar
; $json.freeall(handle)
; Frees memory used to parse the given handle
;$json.parse(&bvar | json string) - Parses a json and returns you a "handle". Use this in the other functions
; If the handle is "ERROR N" then N is an error code
alias json.parse {
var %bvar = $false
if (&* iswm $1) {
%bvar = $1
}
else {
%bvar = $json.createbvar
bset -t %bvar 1 $1-
}
return $json.parseany(%bvar)
}
; $json.type(handle) - Returns ARRAY, OBJECT, or Data
alias json.type {
tokenize 32 $1-
if ($1 == 1) { return OBJECT }
elseif ($1 == 2) { return ARRAY }
elseif ($1 == 3) { return DATA }
else return UNKNOWN TYPE $1
}
; $json(handle [,N/PROPERTY])
; Give a handle (use json.parse first) allows you to
; Get a property value
; Index into an array
; Get the Nth property name of an object
; .text - Returns a data property or array index as text, e.g. $json($json.parse({"foo":"bar"}),bar).text
; .bvar - Returns a data property or array index as a binvar
; .length - If the property is an array, or the handle is an array that isn't indexed, returns its length
alias json {
var %type = $gettok($1,1,32)
var %value = $gettok($1,2-,32)
if ($2 isnum && %type == 3) {
; Can't index non array
echo -atg $json Cannot index data type
return
}
; Indexing into an array
if ($2 isnum && %type == 2) {
var %datatable = $gettok(%value,1,32)
var %typetable = $gettok(%value,2,32)
var %thistype = $hget(%typetable,$2)
var %thisdata = $hget(%datatable,$2)
if (!%thistype) { return $null }
if (%thistype == 3 && $prop == bvar) {
var %bv = $json.createbvar
noop $hget(%datatable,$2,%bv)
return %bv
}
elseif (%thistype == 3 && $prop == text) {
return %thisdata
}
elseif (%thistype == 3) {
var %bv = $json.createbvar
noop $hget(%datatable,$2,%bv)
return %thistype %bv
}
elseif (%thistype != 3) {
return %thistype %thisdata
}
}
elseif (%type == 2 && $prop == length) {
; If we're not indexing, but we have an array with the .length property, return its length
; Return length of the data table for the array
return $hget($gettok(%value,1,32),0).item
}
; Getting a property of an object
elseif (%type == 1 && $2 !isnum) {
var %proptype = $json.getproperty(%value,$2).type
var %propvalue = $json.getproperty(%value,$2).value
var %propbv = $json.getproperty(%value,$2).bvar
if (!%proptype) { return $null }
if (%proptype == 3 && $prop == text) {
return %propvalue
}
elseif (%proptype == 3 && $prop == bvar) {
return %propbv
}
elseif (%proptype == 3) {
return %proptype %propbv
}
elseif (%proptype == 2 && $prop == length) {
; Return length of the data table for the array
return $hget($gettok(%propvalue,1,32),0).item
}
else {
return %proptype %propvalue
}
}
elseif (%type == 1 && $2 isnum) {
; Indexing object by index offset
var %thisIndex = 0
var %i = 1
while ($hget(%value,%i).item) {
inc %i
var %item = $ifmatch
var %propName = $gettok(%item,2-,$asc(.))
if (type.* iswm %item) {
inc %thisIndex
}
if (%thisIndex == $2) {
return %propName
}
if ($2 == 0) { return %thisIndex }
return $null
}
}
else {
echo -atg Unknown usage of $!json --> Prop: $prop P1: $1 P2: $2
}
}
; Hash table layout:
; Name: json.<ticks><rand1,4294967295>
; Key: Name of json property
; Value <N> <value>
; N: 1 = pointer to another object, 3 = raw value
; 2 = <pointer to data array> <pointer to assoc array indicating types of data array>
; $json.proxyrecurse(idname, param1, param2)
alias -l json.proxyrecurse2 {
; json.debug Recurse on: return $($+($,$1,$chr(40),$2,$chr(44),$3,$chr(41)),1)
return $($+($,$1,$chr(40),$2,$chr(44),$3,$chr(41)),2)
}
; /json.freeall <type> <value>
alias json.freeall {
if (!$isid) {
noop $json.proxyrecurse2(json.freeall,$1,$2-)
return
}
json.debug ?4freeall $1-
; For binary data, just return
if ($1 == 3) {
return
}
; For arrays, call on each element then hfree tables
elseif ($1 == 2) {
var %datatable = $gettok($2,1,32)
var %typetable = $gettok($2,2,32)
json.debug FreeAll: Freeing array, datatable: %datatable - typetable: %typetable
var %i = 0
while ($hget(%typetable,%i)) {
var %elementType = $ifmatch
if (%elementType == 3) {
inc %i
continue
}
noop $json.proxyrecurse2(json.freeall,%elementType,$hget(%datatable,%i))
inc %i
}
.hfree %datatable
.hfree %typetable
}
; For objects, call on every property then hfree table
elseif ($1 == 1) {
var %i = 1
while ($hget($2,%i).item) {
inc %i
var %item = $ifmatch
if (type.* iswm %item) {
var %membername = $gettok(%item,2-,$asc(.))
noop $json.proxyrecurse2(json.freeall,$hget($2,%item), $hget($2,value. $+ %membername))
}
}
.hfree $2
}
}
; Parses an array, object, string or int, depending on the next character, and returns <type> <value>
; or returns "ERROR <error>
alias -l json.parseany {
; Now, read the value of the property
if ($bvar($1,1) == $json.chars().STRING_START) {
json.debug Parseany detected a string
var %strVal = $json.parsestring($1)
if (%strVal isnum) {
json.debug Error parsing string: %error
return ERROR %strVal
}
json.debug ParseAny: Read string value: $bvar(%strval,1-).text
return 3 %strval
}
elseif ($bvar($1,1) == $json.chars().OBJECT_START) {
json.debug ParseAny: detected an object
var %obj = $json.parseobject($1)
if (%obj isnum) { json.debug ParseAny: Error reading object subvalue ( $+ %obj $+ ) | return ERROR %obj }
json.debug ParseAny: Read object subvalue as %obj
return 1 %obj
}
elseif ($bvar($1,1) == $json.chars().ARRAY_START) {
json.debug Parseany detected an array
var %array = $json.parsearray($1)
if (%array isnum) {
json.debug ParseAny: error reading array subvalue: %array
return ERROR %array
}
json.debug ParseAny: Read array subvalue as %array
return 2 %array
}
elseif ($bvar($1,1,4).text == null) {
json.debug ParseAny found NULL value
json.trimstart $1 4
return 3 $null
}
elseif ($bvar($1,1,5).text == false || $bvar($1,1,4).text == true) {
var %value = $iif($bvar($1,1,5).text == false,$false,$true)
; if true, trim 'true' off the top, otherwise trim 'false'
if (%value) { json.trimstart $1 4 }
else { json.trimstart $1 5 }
json.debug ParseAny found bool value: %value
return 3 %value
}
; Must be an int
else {
var %int = $json.parseint($1)
if (%int isnum) {
json.debug Error reading int subvalue: %int
return ERROR %int
}
if ($bvar(%int,0) == 0) {
return ERROR $json.errors().UNEXPECTED_CHAR
}
json.debug Read int subvalue into var %int as $bvar(%int,1-).text
return 3 %int
}
}
; $json.parseobject(&binvar) - returns object name or error code
alias -l json.parseobject {
if ($bvar($1,1) == $json.chars().OBJECT_START) {
; Trim off {
json.trimstart $1 1
}
var %table = $json.createtable
var %error = 0
:property
noop $json.consumewhitespace($1)
if ($bvar($1,1) != $json.chars().STRING_START) { %error = $json.errors().EXPECTED_START | goto return }
; Property name
var %strPropName = $json.parsestring($1)
if (%strPropName isnum) { json.debug Error reading property name for object $1 }
else {
%strPropName = $bvar(%strPropName,1-).text
json.debug ParseObject: Read property %strPropName
noop $json.consumewhitespace($1)
if ($bvar($1,1) != $json.chars().MAPPING) { %error = $json.errors().EXPECTED_MAPPING | goto return }
; trim the mapping character
json.trimstart $1 1
noop $json.consumewhitespace($1)
var %any = $json.parseany($1)
var %type = $gettok(%any,1,32)
var %value = $gettok(%any,2-,32)
if (%type == ERROR) {
%error = %value
goto return
}
if (%type == 3) {
; rvalue
hadd %table type. $+ %strPropName 3
if (%value == $true || %value == $false) {
json.debug PasrseObject; Found boolean value for %strPropName : %value
hadd %table value. $+ %strPropName %value
}
elseif (!$bvar(%value,0)) {
hadd %table value. $+ %strPropName $null
}
else {
hadd -b %table value. $+ %strPropName %value
}
}
else if (%type == 2) {
; Arrays
json.debug Read array %strPropName as %value for object %table
hadd %table type. $+ %strPropName 2
; Add array hashtable
hadd %table value. $+ %strPropName %value
}
else if (%type == 1) {
hadd %table type. $+ %strPropName 1
; Add object naem to table
hadd %table value. $+ %strPropName %value
}
}
; Check to see if there are more properties
noop $json.consumewhitespace($1)
if ($bvar($1,1) == $json.chars().OBJECT_END) { json.debug Successful object parsing. | json.trimstart $1 1 | goto return }
elseif ($bvar($1,1) == $json.chars().DELIMITER) { json.trimstart $1 1 | goto property }
else { return $json.errors().UNEXPECTED_CHAR }
:return
if (%error) {
json.debug ParseObject Exiting with error %error
json.freeall 1 %table
return %error
}
return %table
}
; $json.parsestring(&binvar) - returns string (binvar) or error code
alias -l json.parsestring {
var %bv = $json.createbvar
if ($bvar($1,1) != $json.chars().STRING_START) { return $json.errors().EXPECTED_START }
json.trimstart $1 1

var %escape = 0
:loop
if ($bvar($1,1) == $json.chars().STRING_ESCAPE) {
if (%escape) {
; If the escape character is escaped, append it
dec %escape
goto append
}
else {
inc %escape
; Skip appending
goto trim
}
}

if (%escape) {
if ($bvar($1,1) == $asc(r)) { bset $1 1 $cr | dec %escape }
if ($bvar($1,1) == $asc(n)) { bset $1 1 $lf | dec %escape }
if ($bvar($1,1) == $asc(t)) { bset $1 1 9 | dec %escape }
if ($bvar($1,1) == $asc(b)) { bset $1 1 8 | dec %escape }
}

:append
; If we're at the end of a string and not escaped, bail out
if ($bvar($1,1) == $json.chars().STRING_END && !%escape) {
json.trimstart $1 1
bset %bv $calc($bvar(%bv,0) +1) 0
return %bv
}
; Add this character to the end
bset %bv $calc($bvar(%bv,0) +1) $bvar($1,1)
:trim
; Trim from the start
json.trimstart $1 1

; Make sure we haven't consumed all the input
if ($bvar($1,0)) {
goto loop
}
return %bv
}

; $json.parseint(&binvar) - returns an int or error code
alias -l json.parseint {
var %bv = &json.createbvar
; Lax on the number format since its a string for us anyway
while ($bvar($1,1).text isnum || $bvar($1,1) == $asc(.) || $bvar($1,1) == $asc(-) || $bvar($1,1) == $asc(+) || $bvar($1,1) == $asc(e)) {
bset %bv $calc($bvar(%bv,0) +1) $bvar($1,1)
json.trimstart $1 1
}
return %bv
}
$json.parsearray - returns array tables (data, types) or error code
alias -l json.parsearray {
if ($bvar($1,1) != $json.chars().ARRAY_START) {
return $json.errors().EXPECTED_START
}
json.trimstart $1 1
; Create a linked list for the data
var %datatable = $json.createtable(1)
; Create a linked list for the types (associative with respect to the data list)
var %typetable = $json.createtable(1)
:member
noop $json.consumewhitespace($1)
; Parse members
var %any = $json.parseany($1)
var %type = $gettok(%any,1,32)
var %value = $gettok(%any,2-,32)
if (%type == ERROR) {
json.debug Error parsing array member: %value
json.freeall 2 %datatable %typetable
return %value
}
else {
; 0 indexed
var %newindex = $calc($hget(%datatable,0).item)
; Binary data
json.debug ParseArray: Add type %type array index %newindex as %value
if (%type == 3) {
hadd -b %datatable %newindex %value
}
else {
hadd %datatable %newindex %value
}
hadd %typetable %newindex %type
}
noop $json.consumewhitespace($1)
if ($bvar($1,1) == $json.chars().DELIMITER) {
json.trimstart $1 1
goto member
}
elseif ($bvar($1,1) == $json.chars().ARRAY_END) {
json.debug Parsed array successfully
json.trimstart $1 1
return %datatable %typetable
}
json.debug ParseArray failed with an unknown error. Read characters: $bvar($1,1)
json.freeall 2 %datatable %typetable
return $json.errors().UNEXPECTED_CHAR
}
; $json.consumewhitespace(&binvar) - returns number consumed
alias -l json.consumewhitespace {
while ($bvar($1,0) && ($bvar($1,1) == 32 || $bvar($1,1) == 9 || $bvar($1,1) == 160 || $bvar($1,1) == 10 || $bvar($1,1) == 13)) {
json.trimstart $1 1
}
}
; /json.trimstart &binvar length - trims length characters from the start of $binvar
alias -l json.trimstart {
; json.debug Trimstart: $1 $2 -- Size of bvar: $bvar($1,0)
if ($bvar($1,0) == 1) { bunset $1 }
else { bcopy -c $1 1 $1 $calc($2 +1) -1 }
}
; $json.getpropery(table, property).type - Returns number representing type of property
; $json.getproperty(table, property).value - Returns value of property
; $json.getproperty(table, property).bvar - Returns value of property as bvar
; $json.getproperty(table, property).arraytypetable - If property is array, returns its type table
; $json.getproperty(table, property).arraydatatable - If property is table,r eturns its data table
alias -l json.getproperty {
var %type = $hget($1,type. $+ $2)
var %value = $hget($1,value. $+ $2)
if ($prop == type) { return %type }
if ($prop == bvar) { noop $hget($1, value. $+ $2, &bvReturn) | return &bvReturn }
if ($prop == arraytypetable) { return $gettok(%value,2,32) }
if ($prop == arraydatatable) { return $gettok(%value,1,32) }
return %value
}
; $json.createtable - Creates a hashtable and returns its name
; $json.createtable(N) - gives it size N
alias -l json.createtable {
var %ticks = $ticks
var %rand = $rand(1,4294967295)
var %table = $+(json.,%ticks,.,%rand)
hmake %table $iif($1,$1,10)
return %table
}
; Creates a random binvar name to avoid collisions
alias -l json.createbvar {
var %ticks = $ticks
var %rand = $rand(1,4294967295)
var %bv = $+(&jsonbv.,%ticks,.,%rand)
return %bv
}
alias -l json.chars {
; {
if ($prop == OBJECT_START) { return 123 }
; }
if ($prop == OBJECT_END) { return 125 }
; "
if ($prop == STRING_START || $prop == STRING_END) { return 34 }
if ($prop == STRING_ESCAPE) { return $asc(\) }
if ($prop == ARRAY_START) { return $asc([) }
if ($prop == ARRAY_END) { return $asc(]) }
; ,
if ($prop == DELIMITER) { return 44 }
if ($prop == MAPPING) { return $asc(:) }
}
alias -l json.errors {
if ($prop == EXPECTED_START) { return 1 }
if ($prop == EXPECTED_END) { return 2 }
if ($prop == EXPECTED_DELIMITER) { return 3 }
if ($prop == EXPECTED_MAPPING) { return 4 }
if ($prop == UNEXPECTED_CHAR) { return 5 }
return 255
}
alias -l json.debug {
; echo -atg Debug: $1-
}

MJSON

2014-12-12T17:29:56Z

Aca20031: Indexing into objects to get property count and name

This script is a 100% native way of parsing JSON with an easy API

==Example==
To use the below example, Save the following JSON in "json-example.txt" in $mircdir

[
{
"name":"Todd",
"IsManager":false,
"Spouse":{"Name":"Marie"},
"Sallary":100000
},
{
"name":"Gena",
"IsManager":true,
"Spouse":null,
"Sallary":157103e-3
}
]

And then run /json-example with the script loaded.

alias json-example {
bread json-example.txt 0 $file(json-example.txt).size &bvar

; Parse top level
var %aEmployees = $json.parse(&bvar)
echo -atg The top level is a(n) $json.type(%aEmployees)

var %cEmployees = $json(%aEmployees).length
echo -atg Number of employees: %cEmployees

var %i = 0
while (%i < %cEmployees) {
var %oEmployee = $json(%aEmployees,%i)
inc %i

echo -atg Name: $json(%oEmployee,name).text
echo -atg IsManager: $json(%oEmployee,ismanager).text
var %spouse = $json(%oEmployee,spouse)
if (%spouse) { echo -atg Spouse: $json(%spouse,name).text }
echo -atg Sallary: $json(%oEmployee,Sallary).text
}

; Free memory
json.freeall %aEmployees
}

==Script==
;$json.parse(&bvar | json string) - Parses a json and returns you a "handle". Use this in the other functions
; If the handle is "ERROR N" then N is an error code
; $json(handle,N/PROPERTY)
; Given a handle (use json.parse first) allows you to index an array or get a handle to a property by its name
; .text - Returns a data property or array index as text, e.g. $json($json.parse({"foo":"bar"}),bar).text
; .bvar - Returns a data property or array index as a binvar
; $json.freeall(handle)
; Frees memory used to parse the given handle
;$json.parse(&bvar | json string) - Parses a json and returns you a "handle". Use this in the other functions
; If the handle is "ERROR N" then N is an error code
alias json.parse {
var %bvar = $false
if (&* iswm $1) {
%bvar = $1
}
else {
%bvar = $json.createbvar
bset -t %bvar 1 $1-
}
return $json.parseany(%bvar)
}
; $json.type(handle) - Returns ARRAY, OBJECT, or Data
alias json.type {
tokenize 32 $1-
if ($1 == 1) { return OBJECT }
elseif ($1 == 2) { return ARRAY }
elseif ($1 == 3) { return DATA }
else return UNKNOWN TYPE $1
}
; $json(handle [,N/PROPERTY])
; Give a handle (use json.parse first) allows you to
; Get a property value
; Index into an array
; Get the Nth property name of an object
; .text - Returns a data property or array index as text, e.g. $json($json.parse({"foo":"bar"}),bar).text
; .bvar - Returns a data property or array index as a binvar
; .length - If the property is an array, or the handle is an array that isn't indexed, returns its length
alias json {
var %type = $gettok($1,1,32)
var %value = $gettok($1,2-,32)
if ($2 isnum && %type == 3) {
; Can't index non array
echo -atg $json Cannot index data type
return
}
; Indexing into an array
if ($2 isnum && %type == 2) {
var %datatable = $gettok(%value,1,32)
var %typetable = $gettok(%value,2,32)
var %thistype = $hget(%typetable,$2)
var %thisdata = $hget(%datatable,$2)
if (!%thistype) { return $null }
if (%thistype == 3 && $prop == bvar) {
var %bv = $json.createbvar
noop $hget(%datatable,$2,%bv)
return %bv
}
elseif (%thistype == 3 && $prop == text) {
return %thisdata
}
elseif (%thistype == 3) {
var %bv = $json.createbvar
noop $hget(%datatable,$2,%bv)
return %thistype %bv
}
elseif (%thistype != 3) {
return %thistype %thisdata
}
}
elseif (%type == 2 && $prop == length) {
; If we're not indexing, but we have an array with the .length property, return its length
; Return length of the data table for the array
return $hget($gettok(%value,1,32),0).item
}
; Getting a property of an object
elseif (%type == 1 && $2 !isnum) {
var %proptype = $json.getproperty(%value,$2).type
var %propvalue = $json.getproperty(%value,$2).value
var %propbv = $json.getproperty(%value,$2).bvar
if (!%proptype) { return $null }
if (%proptype == 3 && $prop == text) {
return %propvalue
}
elseif (%proptype == 3 && $prop == bvar) {
return %propbv
}
elseif (%proptype == 3) {
return %proptype %propbv
}
elseif (%proptype == 2 && $prop == length) {
; Return length of the data table for the array
return $hget($gettok(%propvalue,1,32),0).item
}
else {
return %proptype %propvalue
}
}
elseif (%type == 1 && $2 isnum) {
; Indexing object by index offset
var %thisIndex = 0
var %i = 1
while ($hget(%value,%i).item) {
inc %i
var %item = $ifmatch
var %propName = $gettok(%item,2-,$asc(.))
if (type.* iswm %item) {
inc %thisIndex
}
if (%thisIndex == $2) {
return %propName
}
if ($2 == 0) { return %thisIndex }
return $null
}
}
else {
echo -atg Unknown usage of $!json --> Prop: $prop P1: $1 P2: $2
}
}
; Hash table layout:
; Name: json.<ticks><rand1,4294967295>
; Key: Name of json property
; Value <N> <value>
; N: 1 = pointer to another object, 3 = raw value
; 2 = <pointer to data array> <pointer to assoc array indicating types of data array>
; $json.proxyrecurse(idname, param1, param2)
alias -l json.proxyrecurse2 {
; json.debug Recurse on: return $($+($,$1,$chr(40),$2,$chr(44),$3,$chr(41)),1)
return $($+($,$1,$chr(40),$2,$chr(44),$3,$chr(41)),2)
}
; /json.freeall <type> <value>
alias json.freeall {
if (!$isid) {
noop $json.proxyrecurse2(json.freeall,$1,$2-)
return
}
json.debug ?4freeall $1-
; For binary data, just return
if ($1 == 3) {
return
}
; For arrays, call on each element then hfree tables
elseif ($1 == 2) {
var %datatable = $gettok($2,1,32)
var %typetable = $gettok($2,2,32)
json.debug FreeAll: Freeing array, datatable: %datatable - typetable: %typetable
var %i = 0
while ($hget(%typetable,%i)) {
var %elementType = $ifmatch
if (%elementType == 3) {
inc %i
continue
}
noop $json.proxyrecurse2(json.freeall,%elementType,$hget(%datatable,%i))
inc %i
}
.hfree %datatable
.hfree %typetable
}
; For objects, call on every property then hfree table
elseif ($1 == 1) {
var %i = 1
while ($hget($2,%i).item) {
inc %i
var %item = $ifmatch
if (type.* iswm %item) {
var %membername = $gettok(%item,2-,$asc(.))
noop $json.proxyrecurse2(json.freeall,$hget($2,%item), $hget($2,value. $+ %membername))
}
}
.hfree $2
}
}
; Parses an array, object, string or int, depending on the next character, and returns <type> <value>
; or returns "ERROR <error>
alias -l json.parseany {
; Now, read the value of the property
if ($bvar($1,1) == $json.chars().STRING_START) {
json.debug Parseany detected a string
var %strVal = $json.parsestring($1)
if (%strVal isnum) {
json.debug Error parsing string: %error
return ERROR %strVal
}
json.debug ParseAny: Read string value: $bvar(%strval,1-).text
return 3 %strval
}
elseif ($bvar($1,1) == $json.chars().OBJECT_START) {
json.debug ParseAny: detected an object
var %obj = $json.parseobject($1)
if (%obj isnum) { json.debug ParseAny: Error reading object subvalue ( $+ %obj $+ ) | return ERROR %obj }
json.debug ParseAny: Read object subvalue as %obj
return 1 %obj
}
elseif ($bvar($1,1) == $json.chars().ARRAY_START) {
json.debug Parseany detected an array
var %array = $json.parsearray($1)
if (%array isnum) {
json.debug ParseAny: error reading array subvalue: %array
return ERROR %array
}
json.debug ParseAny: Read array subvalue as %array
return 2 %array
}
elseif ($bvar($1,1,4).text == null) {
json.debug ParseAny found NULL value
json.trimstart $1 4
return 3 $null
}
elseif ($bvar($1,1,5).text == false || $bvar($1,1,4).text == true) {
var %value = $iif($bvar($1,1,5).text == false,$false,$true)
; if true, trim 'true' off the top, otherwise trim 'false'
if (%value) { json.trimstart $1 4 }
else { json.trimstart $1 5 }
json.debug ParseAny found bool value: %value
return 3 %value
}
; Must be an int
else {
var %int = $json.parseint($1)
if (%int isnum) {
json.debug Error reading int subvalue: %int
return ERROR %int
}
if ($bvar(%int,0) == 0) {
return ERROR $json.errors().UNEXPECTED_CHAR
}
json.debug Read int subvalue into var %int as $bvar(%int,1-).text
return 3 %int
}
}
; $json.parseobject(&binvar) - returns object name or error code
alias -l json.parseobject {
if ($bvar($1,1) == $json.chars().OBJECT_START) {
; Trim off {
json.trimstart $1 1
}
var %table = $json.createtable
var %error = 0
:property
noop $json.consumewhitespace($1)
if ($bvar($1,1) != $json.chars().STRING_START) { %error = $json.errors().EXPECTED_START | goto return }
; Property name
var %strPropName = $json.parsestring($1)
if (%strPropName isnum) { json.debug Error reading property name for object $1 }
else {
%strPropName = $bvar(%strPropName,1-).text
json.debug ParseObject: Read property %strPropName
noop $json.consumewhitespace($1)
if ($bvar($1,1) != $json.chars().MAPPING) { %error = $json.errors().EXPECTED_MAPPING | goto return }
; trim the mapping character
json.trimstart $1 1
noop $json.consumewhitespace($1)
var %any = $json.parseany($1)
var %type = $gettok(%any,1,32)
var %value = $gettok(%any,2-,32)
if (%type == ERROR) {
%error = %value
goto return
}
if (%type == 3) {
; rvalue
hadd %table type. $+ %strPropName 3
if (%value == $true || %value == $false) {
json.debug PasrseObject; Found boolean value for %strPropName : %value
hadd %table value. $+ %strPropName %value
}
elseif (!$bvar(%value,0)) {
hadd %table value. $+ %strPropName $null
}
else {
hadd -b %table value. $+ %strPropName %value
}
}
else if (%type == 2) {
; Arrays
json.debug Read array %strPropName as %value for object %table
hadd %table type. $+ %strPropName 2
; Add array hashtable
hadd %table value. $+ %strPropName %value
}
else if (%type == 1) {
hadd %table type. $+ %strPropName 1
; Add object naem to table
hadd %table value. $+ %strPropName %value
}
}
; Check to see if there are more properties
noop $json.consumewhitespace($1)
if ($bvar($1,1) == $json.chars().OBJECT_END) { json.debug Successful object parsing. | json.trimstart $1 1 | goto return }
elseif ($bvar($1,1) == $json.chars().DELIMITER) { json.trimstart $1 1 | goto property }
else { return $json.errors().UNEXPECTED_CHAR }
:return
if (%error) {
json.debug ParseObject Exiting with error %error
json.freeall 1 %table
return %error
}
return %table
}
; $json.parsestring(&binvar) - returns string (binvar) or error code
alias -l json.parsestring {
var %bv = $json.createbvar
if ($bvar($1,1) != $json.chars().STRING_START) { return $json.errors().EXPECTED_START }
json.trimstart $1 1
var %escape = 0
:loop
if ($bvar($1,1) == $json.chars().STRING_ESCAPE) {
if (%escape) {
; If the escape character is escaped, append it
dec %escape
goto append
}
else {
inc %escape
; Skip appending
goto trim
}
}
if (%escape) {
if ($bvar($1,1) == $asc(r)) { bset $1 1 $cr | dec %escape }
if ($bvar($1,1) == $asc(n)) { bset $1 1 $lf | dec %escape }
if ($bvar($1,1) == $asc(t)) { bset $1 1 9 | dec %escape }
if ($bvar($1,1) == $asc(b)) { bset $1 1 8 | dec %escape }
}
:append
; Add this character to the end
bset %bv $calc($bvar(%bv,0) +1) $bvar($1,1)
:trim
; Trim from the start
json.trimstart $1 1
; If we're at the end of a string and not escaped, bail out
if ($bvar($1,1) == $json.chars().STRING_END && !%escape) {
json.trimstart $1 1
return %bv
}
; Make sure we haven't consumed all the input
if ($bvar($1,0)) {
goto loop
}
return %bv
}
; $json.parseint(&binvar) - returns an int or error code
alias -l json.parseint {
var %bv = &json.createbvar
; Lax on the number format since its a string for us anyway
while ($bvar($1,1).text isnum || $bvar($1,1) == $asc(.) || $bvar($1,1) == $asc(-) || $bvar($1,1) == $asc(+) || $bvar($1,1) == $asc(e)) {
bset %bv $calc($bvar(%bv,0) +1) $bvar($1,1)
json.trimstart $1 1
}
return %bv
}
$json.parsearray - returns array tables (data, types) or error code
alias -l json.parsearray {
if ($bvar($1,1) != $json.chars().ARRAY_START) {
return $json.errors().EXPECTED_START
}
json.trimstart $1 1
; Create a linked list for the data
var %datatable = $json.createtable(1)
; Create a linked list for the types (associative with respect to the data list)
var %typetable = $json.createtable(1)
:member
noop $json.consumewhitespace($1)
; Parse members
var %any = $json.parseany($1)
var %type = $gettok(%any,1,32)
var %value = $gettok(%any,2-,32)
if (%type == ERROR) {
json.debug Error parsing array member: %value
json.freeall 2 %datatable %typetable
return %value
}
else {
; 0 indexed
var %newindex = $calc($hget(%datatable,0).item)
; Binary data
json.debug ParseArray: Add type %type array index %newindex as %value
if (%type == 3) {
hadd -b %datatable %newindex %value
}
else {
hadd %datatable %newindex %value
}
hadd %typetable %newindex %type
}
noop $json.consumewhitespace($1)
if ($bvar($1,1) == $json.chars().DELIMITER) {
json.trimstart $1 1
goto member
}
elseif ($bvar($1,1) == $json.chars().ARRAY_END) {
json.debug Parsed array successfully
json.trimstart $1 1
return %datatable %typetable
}
json.debug ParseArray failed with an unknown error. Read characters: $bvar($1,1)
json.freeall 2 %datatable %typetable
return $json.errors().UNEXPECTED_CHAR
}
; $json.consumewhitespace(&binvar) - returns number consumed
alias -l json.consumewhitespace {
while ($bvar($1,0) && ($bvar($1,1) == 32 || $bvar($1,1) == 9 || $bvar($1,1) == 160 || $bvar($1,1) == 10 || $bvar($1,1) == 13)) {
json.trimstart $1 1
}
}
; /json.trimstart &binvar length - trims length characters from the start of $binvar
alias -l json.trimstart {
; json.debug Trimstart: $1 $2 -- Size of bvar: $bvar($1,0)
if ($bvar($1,0) == 1) { bunset $1 }
else { bcopy -c $1 1 $1 $calc($2 +1) -1 }
}
; $json.getpropery(table, property).type - Returns number representing type of property
; $json.getproperty(table, property).value - Returns value of property
; $json.getproperty(table, property).bvar - Returns value of property as bvar
; $json.getproperty(table, property).arraytypetable - If property is array, returns its type table
; $json.getproperty(table, property).arraydatatable - If property is table,r eturns its data table
alias -l json.getproperty {
var %type = $hget($1,type. $+ $2)
var %value = $hget($1,value. $+ $2)
if ($prop == type) { return %type }
if ($prop == bvar) { noop $hget($1, value. $+ $2, &bvReturn) | return &bvReturn }
if ($prop == arraytypetable) { return $gettok(%value,2,32) }
if ($prop == arraydatatable) { return $gettok(%value,1,32) }
return %value
}
; $json.createtable - Creates a hashtable and returns its name
; $json.createtable(N) - gives it size N
alias -l json.createtable {
var %ticks = $ticks
var %rand = $rand(1,4294967295)
var %table = $+(json.,%ticks,.,%rand)
hmake %table $iif($1,$1,10)
return %table
}
; Creates a random binvar name to avoid collisions
alias -l json.createbvar {
var %ticks = $ticks
var %rand = $rand(1,4294967295)
var %bv = $+(&jsonbv.,%ticks,.,%rand)
return %bv
}
alias -l json.chars {
; {
if ($prop == OBJECT_START) { return 123 }
; }
if ($prop == OBJECT_END) { return 125 }
; "
if ($prop == STRING_START || $prop == STRING_END) { return 34 }
if ($prop == STRING_ESCAPE) { return $asc(\) }
if ($prop == ARRAY_START) { return $asc([) }
if ($prop == ARRAY_END) { return $asc(]) }
; ,
if ($prop == DELIMITER) { return 44 }
if ($prop == MAPPING) { return $asc(:) }
}
alias -l json.errors {
if ($prop == EXPECTED_START) { return 1 }
if ($prop == EXPECTED_END) { return 2 }
if ($prop == EXPECTED_DELIMITER) { return 3 }
if ($prop == EXPECTED_MAPPING) { return 4 }
if ($prop == UNEXPECTED_CHAR) { return 5 }
return 255
}
alias -l json.debug {
; echo -atg Debug: $1-
}

MJSON

2014-12-07T01:50:38Z

Aca20031: json.freeall is not a public alias

This script is a 100% native way of parsing JSON with an easy API

==Example==
To use the below example, Save the following JSON in "json-example.txt" in $mircdir

[
{
"name":"Todd",
"IsManager":false,
"Spouse":{"Name":"Marie"},
"Sallary":100000
},
{
"name":"Gena",
"IsManager":true,
"Spouse":null,
"Sallary":157103e-3
}
]

And then run /json-example with the script loaded.

alias json-example {
bread json-example.txt 0 $file(json-example.txt).size &bvar

; Parse top level
var %aEmployees = $json.parse(&bvar)
echo -atg The top level is a(n) $json.type(%aEmployees)

var %cEmployees = $json(%aEmployees).length
echo -atg Number of employees: %cEmployees

var %i = 0
while (%i < %cEmployees) {
var %oEmployee = $json(%aEmployees,%i)
inc %i

echo -atg Name: $json(%oEmployee,name).text
echo -atg IsManager: $json(%oEmployee,ismanager).text
var %spouse = $json(%oEmployee,spouse)
if (%spouse) { echo -atg Spouse: $json(%spouse,name).text }
echo -atg Sallary: $json(%oEmployee,Sallary).text
}

; Free memory
json.freeall %aEmployees
}

==Script==

;$json.parse(&bvar | json string) - Parses a json and returns you a "handle". Use this in the other functions
; If the handle is "ERROR N" then N is an error code
; $json(handle,N/PROPERTY)
; Give a handle (use json.parse first) allows you to index an array get a handle to a property
; .text - Returns a data property or array index as text, e.g. $json($json.parse({"foo":"bar"}),bar).text
; .bvar - Returns a data property or array index as a binvar
; $json.freeall(handle)
; Frees memory used to parse the given handle
;$json.parse(&bvar | json string) - Parses a json and returns you a "handle". Use this in the other functions
; If the handle is "ERROR N" then N is an error code
alias json.parse {
var %bvar = $false
if (&* iswm $1) {
%bvar = $1
}
else {
%bvar = $json.createbvar
bset -t %bvar 1 $1-
}
return $json.parseany(%bvar)
}
; $json.type(handle) - Returns ARRAY, OBJECT, or Data
alias json.type {
tokenize 32 $1-
if ($1 == 1) { return OBJECT }
elseif ($1 == 2) { return ARRAY }
elseif ($1 == 3) { return DATA }
else return UNKNOWN TYPE $1
}
; $json(handle [,N/PROPERTY])
; Give a handle (use json.parse first) allows you to index an array get a handle to a property
; .text - Returns a data property or array index as text, e.g. $json($json.parse({"foo":"bar"}),bar).text
; .bvar - Returns a data property or array index as a binvar
; .length - If the property is an array, or the handle is an array that isn't indexed, returns its length
alias json {
var %type = $gettok($1,1,32)
var %value = $gettok($1,2-,32)
if ($2 isnum && %type != 2) {
; Can't index non array
echo -atg $json Cannot use indexer on non-array value
return
}
; Indexing into an array
if ($2 isnum && %type == 2) {
var %datatable = $gettok(%value,1,32)
var %typetable = $gettok(%value,2,32)
var %thistype = $hget(%typetable,$2)
var %thisdata = $hget(%datatable,$2)
if (!%thistype) { return $null }
if (%thistype == 3 && $prop == bvar) {
var %bv = $json.createbvar
noop $hget(%datatable,$2,%bv)
return %bv
}
elseif (%thistype == 3 && $prop == text) {
return %thisdata
}
elseif (%thistype == 3) {
var %bv = $json.createbvar
noop $hget(%datatable,$2,%bv)
return %thistype %bv
}
elseif (%thistype != 3) {
return %thistype %thisdata
}
}
elseif (%type == 2 && $prop == length) {
; If we're not indexing, but we have an array with the .length property, return its length
; Return length of the data table for the array
return $hget($gettok(%value,1,32),0).item
}
; Getting a property of an object
elseif (%type == 1) {
var %proptype = $json.getproperty(%value,$2).type
var %propvalue = $json.getproperty(%value,$2).value
var %propbv = $json.getproperty(%value,$2).bvar
if (!%proptype) { return $null }
if (%proptype == 3 && $prop == text) {
return %propvalue
}
elseif (%proptype == 3 && $prop == bvar) {
return %propbv
}
elseif (%proptype == 3) {
return %proptype %propbv
}
elseif (%proptype == 2 && $prop == length) {
; Return length of the data table for the array
return $hget($gettok(%propvalue,1,32),0).item
}
else {
return %proptype %propvalue
}
}
else {
echo -atg Unknown usage of $!json --> Prop: $prop P1: $1 P2: $2
}
}
; Hash table layout:
; Name: json.<ticks><rand1,4294967295>
; Key: Name of json property
; Value <N> <value>
; N: 1 = pointer to another object, 3 = raw value
; 2 = <pointer to data array> <pointer to assoc array indicating types of data array>
; $json.proxyrecurse(idname, param1, param2)
alias -l json.proxyrecurse2 {
; json.debug Recurse on: return $($+($,$1,$chr(40),$2,$chr(44),$3,$chr(41)),1)
return $($+($,$1,$chr(40),$2,$chr(44),$3,$chr(41)),2)
}
; /json.freeall <type> <value>
alias json.freeall {
if (!$isid) {
noop $json.proxyrecurse2(json.freeall,$1,$2-)
return
}
json.debug ?4freeall $1-
; For binary data, just return
if ($1 == 3) {
return
}
; For arrays, call on each element then hfree tables
elseif ($1 == 2) {
var %datatable = $gettok($2,1,32)
var %typetable = $gettok($2,2,32)
json.debug FreeAll: Freeing array, datatable: %datatable - typetable: %typetable
var %i = 0
while ($hget(%typetable,%i)) {
var %elementType = $ifmatch
if (%elementType == 3) {
inc %i
continue
}
noop $json.proxyrecurse2(json.freeall,%elementType,$hget(%datatable,%i))
inc %i
}
.hfree %datatable
.hfree %typetable
}
; For objects, call on every property then hfree table
elseif ($1 == 1) {
var %i = 1
while ($hget($2,%i).item) {
inc %i
var %item = $ifmatch
if (type.* iswm %item) {
var %membername = $gettok(%item,2-,$asc(.))
noop $json.proxyrecurse2(json.freeall,$hget($2,%item), $hget($2,value. $+ %membername))
}
}
.hfree $2
}
}
; Parses an array, object, string or int, depending on the next character, and returns <type> <value>
; or returns "ERROR <error>
alias -l json.parseany {
; Now, read the value of the property
if ($bvar($1,1) == $json.chars().STRING_START) {
json.debug Parseany detected a string
var %strVal = $json.parsestring($1)
if (%strVal isnum) {
json.debug Error parsing string: %error
return ERROR %strVal
}
json.debug ParseAny: Read string value: $bvar(%strval,1-).text
return 3 %strval
}
elseif ($bvar($1,1) == $json.chars().OBJECT_START) {
json.debug ParseAny: detected an object
var %obj = $json.parseobject($1)
if (%obj isnum) { json.debug ParseAny: Error reading object subvalue ( $+ %obj $+ ) | return ERROR %obj }
json.debug ParseAny: Read object subvalue as %obj
return 1 %obj
}
elseif ($bvar($1,1) == $json.chars().ARRAY_START) {
json.debug Parseany detected an array
var %array = $json.parsearray($1)
if (%array isnum) {
json.debug ParseAny: error reading array subvalue: %array
return ERROR %array
}
json.debug ParseAny: Read array subvalue as %array
return 2 %array
}
elseif ($bvar($1,1,4).text == null) {
json.debug ParseAny found NULL value
json.trimstart $1 4
return 3 $null
}
elseif ($bvar($1,1,5).text == false || $bvar($1,1,4).text == true) {
var %value = $iif($bvar($1,1,5).text == false,$false,$true)
; if true, trim 'true' off the top, otherwise trim 'false'
if (%value) { json.trimstart $1 4 }
else { json.trimstart $1 5 }
json.debug ParseAny found bool value: %value
return 3 %value
}
; Must be an int
else {
var %int = $json.parseint($1)
if (%int isnum) {
json.debug Error reading int subvalue: %int
return ERROR %int
}
if ($bvar(%int,0) == 0) {
return ERROR $json.errors().UNEXPECTED_CHAR
}
json.debug Read int subvalue into var %int as $bvar(%int,1-).text
return 3 %int
}
}
; $json.parseobject(&binvar) - returns object name or error code
alias -l json.parseobject {
if ($bvar($1,1) == $json.chars().OBJECT_START) {
; Trim off {
json.trimstart $1 1
}
var %table = $json.createtable
var %error = 0
:property
noop $json.consumewhitespace($1)
if ($bvar($1,1) != $json.chars().STRING_START) { %error = $json.errors().EXPECTED_START | goto return }
; Property name
var %strPropName = $json.parsestring($1)
if (%strPropName isnum) { json.debug Error reading property name for object $1 }
else {
%strPropName = $bvar(%strPropName,1-).text
json.debug ParseObject: Read property %strPropName
noop $json.consumewhitespace($1)
if ($bvar($1,1) != $json.chars().MAPPING) { %error = $json.errors().EXPECTED_MAPPING | goto return }
; trim the mapping character
json.trimstart $1 1
noop $json.consumewhitespace($1)
var %any = $json.parseany($1)
var %type = $gettok(%any,1,32)
var %value = $gettok(%any,2-,32)
if (%type == ERROR) {
%error = %value
goto return
}
if (%type == 3) {
; rvalue
hadd %table type. $+ %strPropName 3
if (%value == $true || %value == $false) {
json.debug PasrseObject; Found boolean value for %strPropName : %value
hadd %table value. $+ %strPropName %value
}
elseif (!$bvar(%value,0)) {
hadd %table value. $+ %strPropName $null
}
else {
hadd -b %table value. $+ %strPropName %value
}
}
else if (%type == 2) {
; Arrays
json.debug Read array %strPropName as %value for object %table
hadd %table type. $+ %strPropName 2
; Add array hashtable
hadd %table value. $+ %strPropName %value
}
else if (%type == 1) {
hadd %table type. $+ %strPropName 1
; Add object naem to table
hadd %table value. $+ %strPropName %value
}
}
; Check to see if there are more properties
noop $json.consumewhitespace($1)
if ($bvar($1,1) == $json.chars().OBJECT_END) { json.debug Successful object parsing. | json.trimstart $1 1 | goto return }
elseif ($bvar($1,1) == $json.chars().DELIMITER) { json.trimstart $1 1 | goto property }
else { return $json.errors().UNEXPECTED_CHAR }
:return
if (%error) {
json.debug ParseObject Exiting with error %error
json.freeall 1 %table
return %error
}
return %table
}
; $json.parsestring(&binvar) - returns string (binvar) or error code
alias -l json.parsestring {
var %bv = $json.createbvar
if ($bvar($1,1) != $json.chars().STRING_START) { return $json.errors().EXPECTED_START }
json.trimstart $1 1
var %escape = 0
:loop
if ($bvar($1,1) == $json.chars().STRING_ESCAPE) {
if (%escape) {
; If the escape character is escaped, append it
dec %escape
goto append
}
else {
inc %escape
; Skip appending
goto trim
}
}
if (%escape) {
if ($bvar($1,1) == $asc(r)) { bset $1 1 $cr | dec %escape }
if ($bvar($1,1) == $asc(n)) { bset $1 1 $lf | dec %escape }
if ($bvar($1,1) == $asc(t)) { bset $1 1 9 | dec %escape }
if ($bvar($1,1) == $asc(b)) { bset $1 1 8 | dec %escape }
}
:append
; Add this character to the end
bset %bv $calc($bvar(%bv,0) +1) $bvar($1,1)
:trim
; Trim from the start
json.trimstart $1 1
; If we're at the end of a string and not escaped, bail out
if ($bvar($1,1) == $json.chars().STRING_END && !%escape) {
json.trimstart $1 1
return %bv
}
; Make sure we haven't consumed all the input
if ($bvar($1,0)) {
goto loop
}
return %bv
}
; $json.parseint(&binvar) - returns an int or error code
alias -l json.parseint {
var %bv = &json.createbvar
; Lax on the number format since its a string for us anyway
while ($bvar($1,1).text isnum || $bvar($1,1) == $asc(.) || $bvar($1,1) == $asc(-) || $bvar($1,1) == $asc(+) || $bvar($1,1) == $asc(e)) {
bset %bv $calc($bvar(%bv,0) +1) $bvar($1,1)
json.trimstart $1 1
}
return %bv
}
$json.parsearray - returns array tables (data, types) or error code
alias -l json.parsearray {
if ($bvar($1,1) != $json.chars().ARRAY_START) {
return $json.errors().EXPECTED_START
}
json.trimstart $1 1
; Create a linked list for the data
var %datatable = $json.createtable(1)
; Create a linked list for the types (associative with respect to the data list)
var %typetable = $json.createtable(1)
:member
noop $json.consumewhitespace($1)
; Parse members
var %any = $json.parseany($1)
var %type = $gettok(%any,1,32)
var %value = $gettok(%any,2-,32)
if (%type == ERROR) {
json.debug Error parsing array member: %value
json.freeall 2 %datatable %typetable
return %value
}
else {
; 0 indexed
var %newindex = $calc($hget(%datatable,0).item)
; Binary data
json.debug ParseArray: Add type %type array index %newindex as %value
if (%type == 3) {
hadd -b %datatable %newindex %value
}
else {
hadd %datatable %newindex %value
}
hadd %typetable %newindex %type
}
noop $json.consumewhitespace($1)
if ($bvar($1,1) == $json.chars().DELIMITER) {
json.trimstart $1 1
goto member
}
elseif ($bvar($1,1) == $json.chars().ARRAY_END) {
json.debug Parsed array successfully
json.trimstart $1 1
return %datatable %typetable
}
json.debug ParseArray failed with an unknown error. Read characters: $bvar($1,1)
json.freeall 2 %datatable %typetable
return $json.errors().UNEXPECTED_CHAR
}
; $json.consumewhitespace(&binvar) - returns number consumed
alias -l json.consumewhitespace {
while ($bvar($1,0) && ($bvar($1,1) == 32 || $bvar($1,1) == 9 || $bvar($1,1) == 160 || $bvar($1,1) == 10 || $bvar($1,1) == 13)) {
json.trimstart $1 1
}
}
; /json.trimstart &binvar length - trims length characters from the start of $binvar
alias -l json.trimstart {
; json.debug Trimstart: $1 $2 -- Size of bvar: $bvar($1,0)
if ($bvar($1,0) == 1) { bunset $1 }
else { bcopy -c $1 1 $1 $calc($2 +1) -1 }
}
; $json.getpropery(table, property).type - Returns number representing type of property
; $json.getproperty(table, property).value - Returns value of property
; $json.getproperty(table, property).bvar - Returns value of property as bvar
; $json.getproperty(table, property).arraytypetable - If property is array, returns its type table
; $json.getproperty(table, property).arraydatatable - If property is table,r eturns its data table
alias -l json.getproperty {
var %type = $hget($1,type. $+ $2)
var %value = $hget($1,value. $+ $2)
if ($prop == type) { return %type }
if ($prop == bvar) { noop $hget($1, value. $+ $2, &bvReturn) | return &bvReturn }
if ($prop == arraytypetable) { return $gettok(%value,2,32) }
if ($prop == arraydatatable) { return $gettok(%value,1,32) }
return %value
}
; $json.createtable - Creates a hashtable and returns its name
; $json.createtable(N) - gives it size N
alias -l json.createtable {
var %ticks = $ticks
var %rand = $rand(1,4294967295)
var %table = $+(json.,%ticks,.,%rand)
hmake %table $iif($1,$1,10)
return %table
}
; Creates a random binvar name to avoid collisions
alias -l json.createbvar {
var %ticks = $ticks
var %rand = $rand(1,4294967295)
var %bv = $+(&jsonbv.,%ticks,.,%rand)
return %bv
}
alias -l json.chars {
; {
if ($prop == OBJECT_START) { return 123 }
; }
if ($prop == OBJECT_END) { return 125 }
; "
if ($prop == STRING_START || $prop == STRING_END) { return 34 }
if ($prop == STRING_ESCAPE) { return $asc(\) }
if ($prop == ARRAY_START) { return $asc([) }
if ($prop == ARRAY_END) { return $asc(]) }
; ,
if ($prop == DELIMITER) { return 44 }
if ($prop == MAPPING) { return $asc(:) }
}
alias -l json.errors {
if ($prop == EXPECTED_START) { return 1 }
if ($prop == EXPECTED_END) { return 2 }
if ($prop == EXPECTED_DELIMITER) { return 3 }
if ($prop == EXPECTED_MAPPING) { return 4 }
if ($prop == UNEXPECTED_CHAR) { return 5 }
return 255
}
alias -l json.debug {
; echo -atg Debug: $1-
}

MJSON

2014-12-07T01:47:05Z

Aca20031: Fixed ParseObject failures not being cleaned up because we were not passing the type

This script is a 100% native way of parsing JSON with an easy API

==Example==
To use the below example, Save the following JSON in "json-example.txt" in $mircdir

[
{
"name":"Todd",
"IsManager":false,
"Spouse":{"Name":"Marie"},
"Sallary":100000
},
{
"name":"Gena",
"IsManager":true,
"Spouse":null,
"Sallary":157103e-3
}
]

And then run /json-example with the script loaded.

alias json-example {
bread json-example.txt 0 $file(json-example.txt).size &bvar

; Parse top level
var %aEmployees = $json.parse(&bvar)
echo -atg The top level is a(n) $json.type(%aEmployees)

var %cEmployees = $json(%aEmployees).length
echo -atg Number of employees: %cEmployees

var %i = 0
while (%i < %cEmployees) {
var %oEmployee = $json(%aEmployees,%i)
inc %i

echo -atg Name: $json(%oEmployee,name).text
echo -atg IsManager: $json(%oEmployee,ismanager).text
var %spouse = $json(%oEmployee,spouse)
if (%spouse) { echo -atg Spouse: $json(%spouse,name).text }
echo -atg Sallary: $json(%oEmployee,Sallary).text
}

; Free memory
json.freeall %aEmployees
}

==Script==

;$json.parse(&bvar | json string) - Parses a json and returns you a "handle". Use this in the other functions
; If the handle is "ERROR N" then N is an error code
; $json(handle,N/PROPERTY)
; Give a handle (use json.parse first) allows you to index an array get a handle to a property
; .text - Returns a data property or array index as text, e.g. $json($json.parse({"foo":"bar"}),bar).text
; .bvar - Returns a data property or array index as a binvar
; $json.freeall(handle)
; Frees memory used to parse the given handle
;$json.parse(&bvar | json string) - Parses a json and returns you a "handle". Use this in the other functions
; If the handle is "ERROR N" then N is an error code
alias json.parse {
var %bvar = $false
if (&* iswm $1) {
%bvar = $1
}
else {
%bvar = $json.createbvar
bset -t %bvar 1 $1-
}
return $json.parseany(%bvar)
}
; $json.type(handle) - Returns ARRAY, OBJECT, or Data
alias json.type {
tokenize 32 $1-
if ($1 == 1) { return OBJECT }
elseif ($1 == 2) { return ARRAY }
elseif ($1 == 3) { return DATA }
else return UNKNOWN TYPE $1
}
; $json(handle [,N/PROPERTY])
; Give a handle (use json.parse first) allows you to index an array get a handle to a property
; .text - Returns a data property or array index as text, e.g. $json($json.parse({"foo":"bar"}),bar).text
; .bvar - Returns a data property or array index as a binvar
; .length - If the property is an array, or the handle is an array that isn't indexed, returns its length
alias json {
var %type = $gettok($1,1,32)
var %value = $gettok($1,2-,32)
if ($2 isnum && %type != 2) {
; Can't index non array
echo -atg $json Cannot use indexer on non-array value
return
}
; Indexing into an array
if ($2 isnum && %type == 2) {
var %datatable = $gettok(%value,1,32)
var %typetable = $gettok(%value,2,32)
var %thistype = $hget(%typetable,$2)
var %thisdata = $hget(%datatable,$2)
if (!%thistype) { return $null }
if (%thistype == 3 && $prop == bvar) {
var %bv = $json.createbvar
noop $hget(%datatable,$2,%bv)
return %bv
}
elseif (%thistype == 3 && $prop == text) {
return %thisdata
}
elseif (%thistype == 3) {
var %bv = $json.createbvar
noop $hget(%datatable,$2,%bv)
return %thistype %bv
}
elseif (%thistype != 3) {
return %thistype %thisdata
}
}
elseif (%type == 2 && $prop == length) {
; If we're not indexing, but we have an array with the .length property, return its length
; Return length of the data table for the array
return $hget($gettok(%value,1,32),0).item
}
; Getting a property of an object
elseif (%type == 1) {
var %proptype = $json.getproperty(%value,$2).type
var %propvalue = $json.getproperty(%value,$2).value
var %propbv = $json.getproperty(%value,$2).bvar
if (!%proptype) { return $null }
if (%proptype == 3 && $prop == text) {
return %propvalue
}
elseif (%proptype == 3 && $prop == bvar) {
return %propbv
}
elseif (%proptype == 3) {
return %proptype %propbv
}
elseif (%proptype == 2 && $prop == length) {
; Return length of the data table for the array
return $hget($gettok(%propvalue,1,32),0).item
}
else {
return %proptype %propvalue
}
}
else {
echo -atg Unknown usage of $!json --> Prop: $prop P1: $1 P2: $2
}
}
; Hash table layout:
; Name: json.<ticks><rand1,4294967295>
; Key: Name of json property
; Value <N> <value>
; N: 1 = pointer to another object, 3 = raw value
; 2 = <pointer to data array> <pointer to assoc array indicating types of data array>
; $json.proxyrecurse(idname, param1, param2)
alias -l json.proxyrecurse2 {
; json.debug Recurse on: return $($+($,$1,$chr(40),$2,$chr(44),$3,$chr(41)),1)
return $($+($,$1,$chr(40),$2,$chr(44),$3,$chr(41)),2)
}
; /json.freeall <type> <value>
alias -l json.freeall {
if (!$isid) {
noop $json.proxyrecurse2(json.freeall,$1,$2-)
return
}
json.debug ?4freeall $1-
; For binary data, just return
if ($1 == 3) {
return
}
; For arrays, call on each element then hfree tables
elseif ($1 == 2) {
var %datatable = $gettok($2,1,32)
var %typetable = $gettok($2,2,32)
json.debug FreeAll: Freeing array, datatable: %datatable - typetable: %typetable
var %i = 0
while ($hget(%typetable,%i)) {
var %elementType = $ifmatch
if (%elementType == 3) {
inc %i
continue
}
noop $json.proxyrecurse2(json.freeall,%elementType,$hget(%datatable,%i))
inc %i
}
.hfree %datatable
.hfree %typetable
}
; For objects, call on every property then hfree table
elseif ($1 == 1) {
var %i = 1
while ($hget($2,%i).item) {
inc %i
var %item = $ifmatch
if (type.* iswm %item) {
var %membername = $gettok(%item,2-,$asc(.))
noop $json.proxyrecurse2(json.freeall,$hget($2,%item), $hget($2,value. $+ %membername))
}
}
.hfree $2
}
}
; Parses an array, object, string or int, depending on the next character, and returns <type> <value>
; or returns "ERROR <error>
alias -l json.parseany {
; Now, read the value of the property
if ($bvar($1,1) == $json.chars().STRING_START) {
json.debug Parseany detected a string
var %strVal = $json.parsestring($1)
if (%strVal isnum) {
json.debug Error parsing string: %error
return ERROR %strVal
}
json.debug ParseAny: Read string value: $bvar(%strval,1-).text
return 3 %strval
}
elseif ($bvar($1,1) == $json.chars().OBJECT_START) {
json.debug ParseAny: detected an object
var %obj = $json.parseobject($1)
if (%obj isnum) { json.debug ParseAny: Error reading object subvalue ( $+ %obj $+ ) | return ERROR %obj }
json.debug ParseAny: Read object subvalue as %obj
return 1 %obj
}
elseif ($bvar($1,1) == $json.chars().ARRAY_START) {
json.debug Parseany detected an array
var %array = $json.parsearray($1)
if (%array isnum) {
json.debug ParseAny: error reading array subvalue: %array
return ERROR %array
}
json.debug ParseAny: Read array subvalue as %array
return 2 %array
}
elseif ($bvar($1,1,4).text == null) {
json.debug ParseAny found NULL value
json.trimstart $1 4
return 3 $null
}
elseif ($bvar($1,1,5).text == false || $bvar($1,1,4).text == true) {
var %value = $iif($bvar($1,1,5).text == false,$false,$true)
; if true, trim 'true' off the top, otherwise trim 'false'
if (%value) { json.trimstart $1 4 }
else { json.trimstart $1 5 }
json.debug ParseAny found bool value: %value
return 3 %value
}
; Must be an int
else {
var %int = $json.parseint($1)
if (%int isnum) {
json.debug Error reading int subvalue: %int
return ERROR %int
}
if ($bvar(%int,0) == 0) {
return ERROR $json.errors().UNEXPECTED_CHAR
}
json.debug Read int subvalue into var %int as $bvar(%int,1-).text
return 3 %int
}
}
; $json.parseobject(&binvar) - returns object name or error code
alias -l json.parseobject {
if ($bvar($1,1) == $json.chars().OBJECT_START) {
; Trim off {
json.trimstart $1 1
}
var %table = $json.createtable
var %error = 0
:property
noop $json.consumewhitespace($1)
if ($bvar($1,1) != $json.chars().STRING_START) { %error = $json.errors().EXPECTED_START | goto return }
; Property name
var %strPropName = $json.parsestring($1)
if (%strPropName isnum) { json.debug Error reading property name for object $1 }
else {
%strPropName = $bvar(%strPropName,1-).text
json.debug ParseObject: Read property %strPropName
noop $json.consumewhitespace($1)
if ($bvar($1,1) != $json.chars().MAPPING) { %error = $json.errors().EXPECTED_MAPPING | goto return }
; trim the mapping character
json.trimstart $1 1
noop $json.consumewhitespace($1)
var %any = $json.parseany($1)
var %type = $gettok(%any,1,32)
var %value = $gettok(%any,2-,32)
if (%type == ERROR) {
%error = %value
goto return
}
if (%type == 3) {
; rvalue
hadd %table type. $+ %strPropName 3
if (%value == $true || %value == $false) {
json.debug PasrseObject; Found boolean value for %strPropName : %value
hadd %table value. $+ %strPropName %value
}
elseif (!$bvar(%value,0)) {
hadd %table value. $+ %strPropName $null
}
else {
hadd -b %table value. $+ %strPropName %value
}
}
else if (%type == 2) {
; Arrays
json.debug Read array %strPropName as %value for object %table
hadd %table type. $+ %strPropName 2
; Add array hashtable
hadd %table value. $+ %strPropName %value
}
else if (%type == 1) {
hadd %table type. $+ %strPropName 1
; Add object naem to table
hadd %table value. $+ %strPropName %value
}
}
; Check to see if there are more properties
noop $json.consumewhitespace($1)
if ($bvar($1,1) == $json.chars().OBJECT_END) { json.debug Successful object parsing. | json.trimstart $1 1 | goto return }
elseif ($bvar($1,1) == $json.chars().DELIMITER) { json.trimstart $1 1 | goto property }
else { return $json.errors().UNEXPECTED_CHAR }
:return
if (%error) {
json.debug ParseObject Exiting with error %error
json.freeall 1 %table
return %error
}
return %table
}
; $json.parsestring(&binvar) - returns string (binvar) or error code
alias -l json.parsestring {
var %bv = $json.createbvar
if ($bvar($1,1) != $json.chars().STRING_START) { return $json.errors().EXPECTED_START }
json.trimstart $1 1
var %escape = 0
:loop
if ($bvar($1,1) == $json.chars().STRING_ESCAPE) {
if (%escape) {
; If the escape character is escaped, append it
dec %escape
goto append
}
else {
inc %escape
; Skip appending
goto trim
}
}
if (%escape) {
if ($bvar($1,1) == $asc(r)) { bset $1 1 $cr | dec %escape }
if ($bvar($1,1) == $asc(n)) { bset $1 1 $lf | dec %escape }
if ($bvar($1,1) == $asc(t)) { bset $1 1 9 | dec %escape }
if ($bvar($1,1) == $asc(b)) { bset $1 1 8 | dec %escape }
}
:append
; Add this character to the end
bset %bv $calc($bvar(%bv,0) +1) $bvar($1,1)
:trim
; Trim from the start
json.trimstart $1 1
; If we're at the end of a string and not escaped, bail out
if ($bvar($1,1) == $json.chars().STRING_END && !%escape) {
json.trimstart $1 1
return %bv
}
; Make sure we haven't consumed all the input
if ($bvar($1,0)) {
goto loop
}
return %bv
}
; $json.parseint(&binvar) - returns an int or error code
alias -l json.parseint {
var %bv = &json.createbvar
; Lax on the number format since its a string for us anyway
while ($bvar($1,1).text isnum || $bvar($1,1) == $asc(.) || $bvar($1,1) == $asc(-) || $bvar($1,1) == $asc(+) || $bvar($1,1) == $asc(e)) {
bset %bv $calc($bvar(%bv,0) +1) $bvar($1,1)
json.trimstart $1 1
}
return %bv
}
$json.parsearray - returns array tables (data, types) or error code
alias -l json.parsearray {
if ($bvar($1,1) != $json.chars().ARRAY_START) {
return $json.errors().EXPECTED_START
}
json.trimstart $1 1
; Create a linked list for the data
var %datatable = $json.createtable(1)
; Create a linked list for the types (associative with respect to the data list)
var %typetable = $json.createtable(1)
:member
noop $json.consumewhitespace($1)
; Parse members
var %any = $json.parseany($1)
var %type = $gettok(%any,1,32)
var %value = $gettok(%any,2-,32)
if (%type == ERROR) {
json.debug Error parsing array member: %value
json.freeall 2 %datatable %typetable
return %value
}
else {
; 0 indexed
var %newindex = $calc($hget(%datatable,0).item)
; Binary data
json.debug ParseArray: Add type %type array index %newindex as %value
if (%type == 3) {
hadd -b %datatable %newindex %value
}
else {
hadd %datatable %newindex %value
}
hadd %typetable %newindex %type
}
noop $json.consumewhitespace($1)
if ($bvar($1,1) == $json.chars().DELIMITER) {
json.trimstart $1 1
goto member
}
elseif ($bvar($1,1) == $json.chars().ARRAY_END) {
json.debug Parsed array successfully
json.trimstart $1 1
return %datatable %typetable
}
json.debug ParseArray failed with an unknown error. Read characters: $bvar($1,1)
json.freeall 2 %datatable %typetable
return $json.errors().UNEXPECTED_CHAR
}
; $json.consumewhitespace(&binvar) - returns number consumed
alias -l json.consumewhitespace {
while ($bvar($1,0) && ($bvar($1,1) == 32 || $bvar($1,1) == 9 || $bvar($1,1) == 160 || $bvar($1,1) == 10 || $bvar($1,1) == 13)) {
json.trimstart $1 1
}
}
; /json.trimstart &binvar length - trims length characters from the start of $binvar
alias -l json.trimstart {
; json.debug Trimstart: $1 $2 -- Size of bvar: $bvar($1,0)
if ($bvar($1,0) == 1) { bunset $1 }
else { bcopy -c $1 1 $1 $calc($2 +1) -1 }
}
; $json.getpropery(table, property).type - Returns number representing type of property
; $json.getproperty(table, property).value - Returns value of property
; $json.getproperty(table, property).bvar - Returns value of property as bvar
; $json.getproperty(table, property).arraytypetable - If property is array, returns its type table
; $json.getproperty(table, property).arraydatatable - If property is table,r eturns its data table
alias -l json.getproperty {
var %type = $hget($1,type. $+ $2)
var %value = $hget($1,value. $+ $2)
if ($prop == type) { return %type }
if ($prop == bvar) { noop $hget($1, value. $+ $2, &bvReturn) | return &bvReturn }
if ($prop == arraytypetable) { return $gettok(%value,2,32) }
if ($prop == arraydatatable) { return $gettok(%value,1,32) }
return %value
}
; $json.createtable - Creates a hashtable and returns its name
; $json.createtable(N) - gives it size N
alias -l json.createtable {
var %ticks = $ticks
var %rand = $rand(1,4294967295)
var %table = $+(json.,%ticks,.,%rand)
hmake %table $iif($1,$1,10)
return %table
}
; Creates a random binvar name to avoid collisions
alias -l json.createbvar {
var %ticks = $ticks
var %rand = $rand(1,4294967295)
var %bv = $+(&jsonbv.,%ticks,.,%rand)
return %bv
}
alias -l json.chars {
; {
if ($prop == OBJECT_START) { return 123 }
; }
if ($prop == OBJECT_END) { return 125 }
; "
if ($prop == STRING_START || $prop == STRING_END) { return 34 }
if ($prop == STRING_ESCAPE) { return $asc(\) }
if ($prop == ARRAY_START) { return $asc([) }
if ($prop == ARRAY_END) { return $asc(]) }
; ,
if ($prop == DELIMITER) { return 44 }
if ($prop == MAPPING) { return $asc(:) }
}
alias -l json.errors {
if ($prop == EXPECTED_START) { return 1 }
if ($prop == EXPECTED_END) { return 2 }
if ($prop == EXPECTED_DELIMITER) { return 3 }
if ($prop == EXPECTED_MAPPING) { return 4 }
if ($prop == UNEXPECTED_CHAR) { return 5 }
return 255
}
alias -l json.debug {
; echo -atg Debug: $1-
}

MJSON

2014-12-07T01:40:48Z

Aca20031:

This script is a 100% native way of parsing JSON with an easy API

==Example==
To use the below example, Save the following JSON in "json-example.txt" in $mircdir

[
{
"name":"Todd",
"IsManager":false,
"Spouse":{"Name":"Marie"},
"Sallary":100000
},
{
"name":"Gena",
"IsManager":true,
"Spouse":null,
"Sallary":157103e-3
}
]

And then run /json-example with the script loaded.

alias json-example {
bread json-example.txt 0 $file(json-example.txt).size &bvar

; Parse top level
var %aEmployees = $json.parse(&bvar)
echo -atg The top level is a(n) $json.type(%aEmployees)

var %cEmployees = $json(%aEmployees).length
echo -atg Number of employees: %cEmployees

var %i = 0
while (%i < %cEmployees) {
var %oEmployee = $json(%aEmployees,%i)
inc %i

echo -atg Name: $json(%oEmployee,name).text
echo -atg IsManager: $json(%oEmployee,ismanager).text
var %spouse = $json(%oEmployee,spouse)
if (%spouse) { echo -atg Spouse: $json(%spouse,name).text }
echo -atg Sallary: $json(%oEmployee,Sallary).text
}

; Free memory
json.freeall %aEmployees
}

==Script==

;$json.parse(&bvar | json string) - Parses a json and returns you a "handle". Use this in the other functions
; If the handle is "ERROR N" then N is an error code
; $json(handle,N/PROPERTY)
; Give a handle (use json.parse first) allows you to index an array get a handle to a property
; .text - Returns a data property or array index as text, e.g. $json($json.parse({"foo":"bar"}),bar).text
; .bvar - Returns a data property or array index as a binvar
; $json.freeall(handle)
; Frees memory used to parse the given handle
;$json.parse(&bvar | json string) - Parses a json and returns you a "handle". Use this in the other functions
; If the handle is "ERROR N" then N is an error code
alias json.parse {
var %bvar = $false
if (&* iswm $1) {
%bvar = $1
}
else {
%bvar = $json.createbvar
bset -t %bvar 1 $1-
}
return $json.parseany(%bvar)
}
; $json.type(handle) - Returns ARRAY, OBJECT, or Data
alias json.type {
tokenize 32 $1-
if ($1 == 1) { return OBJECT }
elseif ($1 == 2) { return ARRAY }
elseif ($1 == 3) { return DATA }
else return UNKNOWN TYPE $1
}
; $json(handle [,N/PROPERTY])
; Give a handle (use json.parse first) allows you to index an array get a handle to a property
; .text - Returns a data property or array index as text, e.g. $json($json.parse({"foo":"bar"}),bar).text
; .bvar - Returns a data property or array index as a binvar
; .length - If the property is an array, or the handle is an array that isn't indexed, returns its length
alias json {
var %type = $gettok($1,1,32)
var %value = $gettok($1,2-,32)
if ($2 isnum && %type != 2) {
; Can't index non array
echo -atg $json Cannot use indexer on non-array value
return
}
; Indexing into an array
if ($2 isnum && %type == 2) {
var %datatable = $gettok(%value,1,32)
var %typetable = $gettok(%value,2,32)
var %thistype = $hget(%typetable,$2)
var %thisdata = $hget(%datatable,$2)
if (!%thistype) { return $null }
if (%thistype == 3 && $prop == bvar) {
var %bv = $json.createbvar
noop $hget(%datatable,$2,%bv)
return %bv
}
elseif (%thistype == 3 && $prop == text) {
return %thisdata
}
elseif (%thistype == 3) {
var %bv = $json.createbvar
noop $hget(%datatable,$2,%bv)
return %thistype %bv
}
elseif (%thistype != 3) {
return %thistype %thisdata
}
}
elseif (%type == 2 && $prop == length) {
; If we're not indexing, but we have an array with the .length property, return its length
; Return length of the data table for the array
return $hget($gettok(%value,1,32),0).item
}
; Getting a property of an object
elseif (%type == 1) {
var %proptype = $json.getproperty(%value,$2).type
var %propvalue = $json.getproperty(%value,$2).value
var %propbv = $json.getproperty(%value,$2).bvar
if (!%proptype) { return $null }
if (%proptype == 3 && $prop == text) {
return %propvalue
}
elseif (%proptype == 3 && $prop == bvar) {
return %propbv
}
elseif (%proptype == 3) {
return %proptype %propbv
}
elseif (%proptype == 2 && $prop == length) {
; Return length of the data table for the array
return $hget($gettok(%propvalue,1,32),0).item
}
else {
return %proptype %propvalue
}
}
else {
echo -atg Unknown usage of $!json --> Prop: $prop P1: $1 P2: $2
}
}
; Hash table layout:
; Name: json.<ticks><rand1,4294967295>
; Key: Name of json property
; Value <N> <value>
; N: 1 = pointer to another object, 3 = raw value
; 2 = <pointer to data array> <pointer to assoc array indicating types of data array>
; $json.proxyrecurse(idname, param1, param2)
alias -l json.proxyrecurse2 {
; json.debug Recurse on: return $($+($,$1,$chr(40),$2,$chr(44),$3,$chr(41)),1)
return $($+($,$1,$chr(40),$2,$chr(44),$3,$chr(41)),2)
}
; /json.freeall <type> <value>
alias -l json.freeall {
if (!$isid) {
noop $json.proxyrecurse2(json.freeall,$1,$2-)
return
}
json.debug ?4freeall $1-
; For binary data, just return
if ($1 == 3) {
return
}
; For arrays, call on each element then hfree tables
elseif ($1 == 2) {
var %datatable = $gettok($2,1,32)
var %typetable = $gettok($2,2,32)
json.debug FreeAll: Freeing array, datatable: %datatable - typetable: %typetable
var %i = 0
while ($hget(%typetable,%i)) {
var %elementType = $ifmatch
if (%elementType == 3) {
inc %i
continue
}
noop $json.proxyrecurse2(json.freeall,%elementType,$hget(%datatable,%i))
inc %i
}
.hfree %datatable
.hfree %typetable
}
; For objects, call on every property then hfree table
elseif ($1 == 1) {
var %i = 1
while ($hget($2,%i).item) {
inc %i
var %item = $ifmatch
if (type.* iswm %item) {
var %membername = $gettok(%item,2-,$asc(.))
noop $json.proxyrecurse2(json.freeall,$hget($2,%item), $hget($2,value. $+ %membername))
}
}
.hfree $2
}
}
; Parses an array, object, string or int, depending on the next character, and returns <type> <value>
; or returns "ERROR <error>
alias -l json.parseany {
; Now, read the value of the property
if ($bvar($1,1) == $json.chars().STRING_START) {
json.debug Parseany detected a string
var %strVal = $json.parsestring($1)
if (%strVal isnum) {
json.debug Error parsing string: %error
return ERROR %strVal
}
json.debug ParseAny: Read string value: $bvar(%strval,1-).text
return 3 %strval
}
elseif ($bvar($1,1) == $json.chars().OBJECT_START) {
json.debug ParseAny: detected an object
var %obj = $json.parseobject($1)
if (%obj isnum) { json.debug ParseAny: Error reading object subvalue ( $+ %obj $+ ) | return ERROR %obj }
json.debug ParseAny: Read object subvalue as %obj
return 1 %obj
}
elseif ($bvar($1,1) == $json.chars().ARRAY_START) {
json.debug Parseany detected an array
var %array = $json.parsearray($1)
if (%array isnum) {
json.debug ParseAny: error reading array subvalue: %array
return ERROR %array
}
json.debug ParseAny: Read array subvalue as %array
return 2 %array
}
elseif ($bvar($1,1,4).text == null) {
json.debug ParseAny found NULL value
json.trimstart $1 4
return 3 $null
}
elseif ($bvar($1,1,5).text == false || $bvar($1,1,4).text == true) {
var %value = $iif($bvar($1,1,5).text == false,$false,$true)
; if true, trim 'true' off the top, otherwise trim 'false'
if (%value) { json.trimstart $1 4 }
else { json.trimstart $1 5 }
json.debug ParseAny found bool value: %value
return 3 %value
}
; Must be an int
else {
var %int = $json.parseint($1)
if (%int isnum) {
json.debug Error reading int subvalue: %int
return ERROR %int
}
if ($bvar(%int,0) == 0) {
return ERROR $json.errors().UNEXPECTED_CHAR
}
json.debug Read int subvalue into var %int as $bvar(%int,1-).text
return 3 %int
}
}
; $json.parseobject(&binvar) - returns object name or error code
alias -l json.parseobject {
if ($bvar($1,1) == $json.chars().OBJECT_START) {
; Trim off {
json.trimstart $1 1
}
var %table = $json.createtable
var %error = 0
:property
noop $json.consumewhitespace($1)
if ($bvar($1,1) != $json.chars().STRING_START) { %error = $json.errors().EXPECTED_START | goto return }
; Property name
var %strPropName = $json.parsestring($1)
if (%strPropName isnum) { json.debug Error reading property name for object $1 }
else {
%strPropName = $bvar(%strPropName,1-).text
json.debug ParseObject: Read property %strPropName
noop $json.consumewhitespace($1)
if ($bvar($1,1) != $json.chars().MAPPING) { %error = $json.errors().EXPECTED_MAPPING | goto return }
; trim the mapping character
json.trimstart $1 1
noop $json.consumewhitespace($1)
var %any = $json.parseany($1)
var %type = $gettok(%any,1,32)
var %value = $gettok(%any,2-,32)
if (%type == ERROR) {
%error = %value
goto return
}
if (%type == 3) {
; rvalue
hadd %table type. $+ %strPropName 3
if (%value == $true || %value == $false) {
json.debug PasrseObject; Found boolean value for %strPropName : %value
hadd %table value. $+ %strPropName %value
}
elseif (!$bvar(%value,0)) {
hadd %table value. $+ %strPropName $null
}
else {
hadd -b %table value. $+ %strPropName %value
}
}
else if (%type == 2) {
; Arrays
json.debug Read array %strPropName as %value for object %table
hadd %table type. $+ %strPropName 2
; Add array hashtable
hadd %table value. $+ %strPropName %value
}
else if (%type == 1) {
hadd %table type. $+ %strPropName 1
; Add object naem to table
hadd %table value. $+ %strPropName %value
}
}
; Check to see if there are more properties
noop $json.consumewhitespace($1)
if ($bvar($1,1) == $json.chars().OBJECT_END) { json.debug Successful object parsing. | json.trimstart $1 1 | goto return }
elseif ($bvar($1,1) == $json.chars().DELIMITER) { json.trimstart $1 1 | goto property }
else { return $json.errors().UNEXPECTED_CHAR }
:return
if (%error) {
json.debug ParseObject Exiting with error %error
json.freeall %table
return %error
}
return %table
}
; $json.parsestring(&binvar) - returns string (binvar) or error code
alias -l json.parsestring {
var %bv = $json.createbvar
if ($bvar($1,1) != $json.chars().STRING_START) { return $json.errors().EXPECTED_START }
json.trimstart $1 1
var %escape = 0
:loop
if ($bvar($1,1) == $json.chars().STRING_ESCAPE) {
if (%escape) {
; If the escape character is escaped, append it
dec %escape
goto append
}
else {
inc %escape
; Skip appending
goto trim
}
}
if (%escape) {
if ($bvar($1,1) == $asc(r)) { bset $1 1 $cr | dec %escape }
if ($bvar($1,1) == $asc(n)) { bset $1 1 $lf | dec %escape }
if ($bvar($1,1) == $asc(t)) { bset $1 1 9 | dec %escape }
if ($bvar($1,1) == $asc(b)) { bset $1 1 8 | dec %escape }
}
:append
; Add this character to the end
bset %bv $calc($bvar(%bv,0) +1) $bvar($1,1)
:trim
; Trim from the start
json.trimstart $1 1
; If we're at the end of a string and not escaped, bail out
if ($bvar($1,1) == $json.chars().STRING_END && !%escape) {
json.trimstart $1 1
return %bv
}
; Make sure we haven't consumed all the input
if ($bvar($1,0)) {
goto loop
}
return %bv
}
; $json.parseint(&binvar) - returns an int or error code
alias -l json.parseint {
var %bv = &json.createbvar
; Lax on the number format since its a string for us anyway
while ($bvar($1,1).text isnum || $bvar($1,1) == $asc(.) || $bvar($1,1) == $asc(-) || $bvar($1,1) == $asc(+) || $bvar($1,1) == $asc(e)) {
bset %bv $calc($bvar(%bv,0) +1) $bvar($1,1)
json.trimstart $1 1
}
return %bv
}
$json.parsearray - returns array tables (data, types) or error code
alias -l json.parsearray {
if ($bvar($1,1) != $json.chars().ARRAY_START) {
return $json.errors().EXPECTED_START
}
json.trimstart $1 1
; Create a linked list for the data
var %datatable = $json.createtable(1)
; Create a linked list for the types (associative with respect to the data list)
var %typetable = $json.createtable(1)
:member
noop $json.consumewhitespace($1)
; Parse members
var %any = $json.parseany($1)
var %type = $gettok(%any,1,32)
var %value = $gettok(%any,2-,32)
if (%type == ERROR) {
json.debug Error parsing array member: %value
json.freeall 2 %datatable %typetable
return %value
}
else {
; 0 indexed
var %newindex = $calc($hget(%datatable,0).item)
; Binary data
json.debug ParseArray: Add type %type array index %newindex as %value
if (%type == 3) {
hadd -b %datatable %newindex %value
}
else {
hadd %datatable %newindex %value
}
hadd %typetable %newindex %type
}
noop $json.consumewhitespace($1)
if ($bvar($1,1) == $json.chars().DELIMITER) {
json.trimstart $1 1
goto member
}
elseif ($bvar($1,1) == $json.chars().ARRAY_END) {
json.debug Parsed array successfully
json.trimstart $1 1
return %datatable %typetable
}
json.debug ParseArray failed with an unknown error. Read characters: $bvar($1,1)
json.freeall 2 %datatable %typetable
return $json.errors().UNEXPECTED_CHAR
}
; $json.consumewhitespace(&binvar) - returns number consumed
alias -l json.consumewhitespace {
while ($bvar($1,0) && ($bvar($1,1) == 32 || $bvar($1,1) == 9 || $bvar($1,1) == 160 || $bvar($1,1) == 10 || $bvar($1,1) == 13)) {
json.trimstart $1 1
}
}
; /json.trimstart &binvar length - trims length characters from the start of $binvar
alias -l json.trimstart {
; json.debug Trimstart: $1 $2 -- Size of bvar: $bvar($1,0)
if ($bvar($1,0) == 1) { bunset $1 }
else { bcopy -c $1 1 $1 $calc($2 +1) -1 }
}
; $json.getpropery(table, property).type - Returns number representing type of property
; $json.getproperty(table, property).value - Returns value of property
; $json.getproperty(table, property).bvar - Returns value of property as bvar
; $json.getproperty(table, property).arraytypetable - If property is array, returns its type table
; $json.getproperty(table, property).arraydatatable - If property is table,r eturns its data table
alias -l json.getproperty {
var %type = $hget($1,type. $+ $2)
var %value = $hget($1,value. $+ $2)
if ($prop == type) { return %type }
if ($prop == bvar) { noop $hget($1, value. $+ $2, &bvReturn) | return &bvReturn }
if ($prop == arraytypetable) { return $gettok(%value,2,32) }
if ($prop == arraydatatable) { return $gettok(%value,1,32) }
return %value
}
; $json.createtable - Creates a hashtable and returns its name
; $json.createtable(N) - gives it size N
alias -l json.createtable {
var %ticks = $ticks
var %rand = $rand(1,4294967295)
var %table = $+(json.,%ticks,.,%rand)
hmake %table $iif($1,$1,10)
return %table
}
; Creates a random binvar name to avoid collisions
alias -l json.createbvar {
var %ticks = $ticks
var %rand = $rand(1,4294967295)
var %bv = $+(&jsonbv.,%ticks,.,%rand)
return %bv
}
alias -l json.chars {
; {
if ($prop == OBJECT_START) { return 123 }
; }
if ($prop == OBJECT_END) { return 125 }
; "
if ($prop == STRING_START || $prop == STRING_END) { return 34 }
if ($prop == STRING_ESCAPE) { return $asc(\) }
if ($prop == ARRAY_START) { return $asc([) }
if ($prop == ARRAY_END) { return $asc(]) }
; ,
if ($prop == DELIMITER) { return 44 }
if ($prop == MAPPING) { return $asc(:) }
}
alias -l json.errors {
if ($prop == EXPECTED_START) { return 1 }
if ($prop == EXPECTED_END) { return 2 }
if ($prop == EXPECTED_DELIMITER) { return 3 }
if ($prop == EXPECTED_MAPPING) { return 4 }
if ($prop == UNEXPECTED_CHAR) { return 5 }
return 255
}
alias -l json.debug {
; echo -atg Debug: $1-
}

MJSON

2014-12-07T01:40:23Z

Aca20031: Fixed cleanup of arrays to pass binvar properly instead of evaluating it

This script is a 100% native way of parsing JSON with an easy API

==Example==
To use the below example, Save the following JSON in "json-example.txt" in $mircdir

[
{
"name":"Todd",
"IsManager":false,
"Spouse":{"Name":"Marie"},
"Sallary":100000
},
{
"name":"Gena",
"IsManager":true,
"Spouse":null,
"Sallary":157103e-3
}
]

And then run /json-example with the script loaded.

alias json-example {
bread json-example.txt 0 $file(json-example.txt).size &bvar

; Parse top level
var %aEmployees = $json.parse(&bvar)
echo -atg The top level is a(n) $json.type(%aEmployees)

var %cEmployees = $json(%aEmployees).length
echo -atg Number of employees: %cEmployees

var %i = 0
while (%i < %cEmployees) {
var %oEmployee = $json(%aEmployees,%i)
inc %i

echo -atg Name: $json(%oEmployee,name).text
echo -atg IsManager: $json(%oEmployee,ismanager).text
var %spouse = $json(%oEmployee,spouse)
if (%spouse) { echo -atg Spouse: $json(%spouse,name).text }
echo -atg Sallary: $json(%oEmployee,Sallary).text
}

; Free memory
json.freeall %aEmployees
}

;$json.parse(&bvar | json string) - Parses a json and returns you a "handle". Use this in the other functions
; If the handle is "ERROR N" then N is an error code
; $json(handle,N/PROPERTY)
; Give a handle (use json.parse first) allows you to index an array get a handle to a property
; .text - Returns a data property or array index as text, e.g. $json($json.parse({"foo":"bar"}),bar).text
; .bvar - Returns a data property or array index as a binvar
; $json.freeall(handle)
; Frees memory used to parse the given handle
;$json.parse(&bvar | json string) - Parses a json and returns you a "handle". Use this in the other functions
; If the handle is "ERROR N" then N is an error code
alias json.parse {
var %bvar = $false
if (&* iswm $1) {
%bvar = $1
}
else {
%bvar = $json.createbvar
bset -t %bvar 1 $1-
}
return $json.parseany(%bvar)
}
; $json.type(handle) - Returns ARRAY, OBJECT, or Data
alias json.type {
tokenize 32 $1-
if ($1 == 1) { return OBJECT }
elseif ($1 == 2) { return ARRAY }
elseif ($1 == 3) { return DATA }
else return UNKNOWN TYPE $1
}
; $json(handle [,N/PROPERTY])
; Give a handle (use json.parse first) allows you to index an array get a handle to a property
; .text - Returns a data property or array index as text, e.g. $json($json.parse({"foo":"bar"}),bar).text
; .bvar - Returns a data property or array index as a binvar
; .length - If the property is an array, or the handle is an array that isn't indexed, returns its length
alias json {
var %type = $gettok($1,1,32)
var %value = $gettok($1,2-,32)
if ($2 isnum && %type != 2) {
; Can't index non array
echo -atg $json Cannot use indexer on non-array value
return
}
; Indexing into an array
if ($2 isnum && %type == 2) {
var %datatable = $gettok(%value,1,32)
var %typetable = $gettok(%value,2,32)
var %thistype = $hget(%typetable,$2)
var %thisdata = $hget(%datatable,$2)
if (!%thistype) { return $null }
if (%thistype == 3 && $prop == bvar) {
var %bv = $json.createbvar
noop $hget(%datatable,$2,%bv)
return %bv
}
elseif (%thistype == 3 && $prop == text) {
return %thisdata
}
elseif (%thistype == 3) {
var %bv = $json.createbvar
noop $hget(%datatable,$2,%bv)
return %thistype %bv
}
elseif (%thistype != 3) {
return %thistype %thisdata
}
}
elseif (%type == 2 && $prop == length) {
; If we're not indexing, but we have an array with the .length property, return its length
; Return length of the data table for the array
return $hget($gettok(%value,1,32),0).item
}
; Getting a property of an object
elseif (%type == 1) {
var %proptype = $json.getproperty(%value,$2).type
var %propvalue = $json.getproperty(%value,$2).value
var %propbv = $json.getproperty(%value,$2).bvar
if (!%proptype) { return $null }
if (%proptype == 3 && $prop == text) {
return %propvalue
}
elseif (%proptype == 3 && $prop == bvar) {
return %propbv
}
elseif (%proptype == 3) {
return %proptype %propbv
}
elseif (%proptype == 2 && $prop == length) {
; Return length of the data table for the array
return $hget($gettok(%propvalue,1,32),0).item
}
else {
return %proptype %propvalue
}
}
else {
echo -atg Unknown usage of $!json --> Prop: $prop P1: $1 P2: $2
}
}
; Hash table layout:
; Name: json.<ticks><rand1,4294967295>
; Key: Name of json property
; Value <N> <value>
; N: 1 = pointer to another object, 3 = raw value
; 2 = <pointer to data array> <pointer to assoc array indicating types of data array>
; $json.proxyrecurse(idname, param1, param2)
alias -l json.proxyrecurse2 {
; json.debug Recurse on: return $($+($,$1,$chr(40),$2,$chr(44),$3,$chr(41)),1)
return $($+($,$1,$chr(40),$2,$chr(44),$3,$chr(41)),2)
}
; /json.freeall <type> <value>
alias -l json.freeall {
if (!$isid) {
noop $json.proxyrecurse2(json.freeall,$1,$2-)
return
}
json.debug ?4freeall $1-
; For binary data, just return
if ($1 == 3) {
return
}
; For arrays, call on each element then hfree tables
elseif ($1 == 2) {
var %datatable = $gettok($2,1,32)
var %typetable = $gettok($2,2,32)
json.debug FreeAll: Freeing array, datatable: %datatable - typetable: %typetable
var %i = 0
while ($hget(%typetable,%i)) {
var %elementType = $ifmatch
if (%elementType == 3) {
inc %i
continue
}
noop $json.proxyrecurse2(json.freeall,%elementType,$hget(%datatable,%i))
inc %i
}
.hfree %datatable
.hfree %typetable
}
; For objects, call on every property then hfree table
elseif ($1 == 1) {
var %i = 1
while ($hget($2,%i).item) {
inc %i
var %item = $ifmatch
if (type.* iswm %item) {
var %membername = $gettok(%item,2-,$asc(.))
noop $json.proxyrecurse2(json.freeall,$hget($2,%item), $hget($2,value. $+ %membername))
}
}
.hfree $2
}
}
; Parses an array, object, string or int, depending on the next character, and returns <type> <value>
; or returns "ERROR <error>
alias -l json.parseany {
; Now, read the value of the property
if ($bvar($1,1) == $json.chars().STRING_START) {
json.debug Parseany detected a string
var %strVal = $json.parsestring($1)
if (%strVal isnum) {
json.debug Error parsing string: %error
return ERROR %strVal
}
json.debug ParseAny: Read string value: $bvar(%strval,1-).text
return 3 %strval
}
elseif ($bvar($1,1) == $json.chars().OBJECT_START) {
json.debug ParseAny: detected an object
var %obj = $json.parseobject($1)
if (%obj isnum) { json.debug ParseAny: Error reading object subvalue ( $+ %obj $+ ) | return ERROR %obj }
json.debug ParseAny: Read object subvalue as %obj
return 1 %obj
}
elseif ($bvar($1,1) == $json.chars().ARRAY_START) {
json.debug Parseany detected an array
var %array = $json.parsearray($1)
if (%array isnum) {
json.debug ParseAny: error reading array subvalue: %array
return ERROR %array
}
json.debug ParseAny: Read array subvalue as %array
return 2 %array
}
elseif ($bvar($1,1,4).text == null) {
json.debug ParseAny found NULL value
json.trimstart $1 4
return 3 $null
}
elseif ($bvar($1,1,5).text == false || $bvar($1,1,4).text == true) {
var %value = $iif($bvar($1,1,5).text == false,$false,$true)
; if true, trim 'true' off the top, otherwise trim 'false'
if (%value) { json.trimstart $1 4 }
else { json.trimstart $1 5 }
json.debug ParseAny found bool value: %value
return 3 %value
}
; Must be an int
else {
var %int = $json.parseint($1)
if (%int isnum) {
json.debug Error reading int subvalue: %int
return ERROR %int
}
if ($bvar(%int,0) == 0) {
return ERROR $json.errors().UNEXPECTED_CHAR
}
json.debug Read int subvalue into var %int as $bvar(%int,1-).text
return 3 %int
}
}
; $json.parseobject(&binvar) - returns object name or error code
alias -l json.parseobject {
if ($bvar($1,1) == $json.chars().OBJECT_START) {
; Trim off {
json.trimstart $1 1
}
var %table = $json.createtable
var %error = 0
:property
noop $json.consumewhitespace($1)
if ($bvar($1,1) != $json.chars().STRING_START) { %error = $json.errors().EXPECTED_START | goto return }
; Property name
var %strPropName = $json.parsestring($1)
if (%strPropName isnum) { json.debug Error reading property name for object $1 }
else {
%strPropName = $bvar(%strPropName,1-).text
json.debug ParseObject: Read property %strPropName
noop $json.consumewhitespace($1)
if ($bvar($1,1) != $json.chars().MAPPING) { %error = $json.errors().EXPECTED_MAPPING | goto return }
; trim the mapping character
json.trimstart $1 1
noop $json.consumewhitespace($1)
var %any = $json.parseany($1)
var %type = $gettok(%any,1,32)
var %value = $gettok(%any,2-,32)
if (%type == ERROR) {
%error = %value
goto return
}
if (%type == 3) {
; rvalue
hadd %table type. $+ %strPropName 3
if (%value == $true || %value == $false) {
json.debug PasrseObject; Found boolean value for %strPropName : %value
hadd %table value. $+ %strPropName %value
}
elseif (!$bvar(%value,0)) {
hadd %table value. $+ %strPropName $null
}
else {
hadd -b %table value. $+ %strPropName %value
}
}
else if (%type == 2) {
; Arrays
json.debug Read array %strPropName as %value for object %table
hadd %table type. $+ %strPropName 2
; Add array hashtable
hadd %table value. $+ %strPropName %value
}
else if (%type == 1) {
hadd %table type. $+ %strPropName 1
; Add object naem to table
hadd %table value. $+ %strPropName %value
}
}
; Check to see if there are more properties
noop $json.consumewhitespace($1)
if ($bvar($1,1) == $json.chars().OBJECT_END) { json.debug Successful object parsing. | json.trimstart $1 1 | goto return }
elseif ($bvar($1,1) == $json.chars().DELIMITER) { json.trimstart $1 1 | goto property }
else { return $json.errors().UNEXPECTED_CHAR }
:return
if (%error) {
json.debug ParseObject Exiting with error %error
json.freeall %table
return %error
}
return %table
}
; $json.parsestring(&binvar) - returns string (binvar) or error code
alias -l json.parsestring {
var %bv = $json.createbvar
if ($bvar($1,1) != $json.chars().STRING_START) { return $json.errors().EXPECTED_START }
json.trimstart $1 1
var %escape = 0
:loop
if ($bvar($1,1) == $json.chars().STRING_ESCAPE) {
if (%escape) {
; If the escape character is escaped, append it
dec %escape
goto append
}
else {
inc %escape
; Skip appending
goto trim
}
}
if (%escape) {
if ($bvar($1,1) == $asc(r)) { bset $1 1 $cr | dec %escape }
if ($bvar($1,1) == $asc(n)) { bset $1 1 $lf | dec %escape }
if ($bvar($1,1) == $asc(t)) { bset $1 1 9 | dec %escape }
if ($bvar($1,1) == $asc(b)) { bset $1 1 8 | dec %escape }
}
:append
; Add this character to the end
bset %bv $calc($bvar(%bv,0) +1) $bvar($1,1)
:trim
; Trim from the start
json.trimstart $1 1
; If we're at the end of a string and not escaped, bail out
if ($bvar($1,1) == $json.chars().STRING_END && !%escape) {
json.trimstart $1 1
return %bv
}
; Make sure we haven't consumed all the input
if ($bvar($1,0)) {
goto loop
}
return %bv
}
; $json.parseint(&binvar) - returns an int or error code
alias -l json.parseint {
var %bv = &json.createbvar
; Lax on the number format since its a string for us anyway
while ($bvar($1,1).text isnum || $bvar($1,1) == $asc(.) || $bvar($1,1) == $asc(-) || $bvar($1,1) == $asc(+) || $bvar($1,1) == $asc(e)) {
bset %bv $calc($bvar(%bv,0) +1) $bvar($1,1)
json.trimstart $1 1
}
return %bv
}
$json.parsearray - returns array tables (data, types) or error code
alias -l json.parsearray {
if ($bvar($1,1) != $json.chars().ARRAY_START) {
return $json.errors().EXPECTED_START
}
json.trimstart $1 1
; Create a linked list for the data
var %datatable = $json.createtable(1)
; Create a linked list for the types (associative with respect to the data list)
var %typetable = $json.createtable(1)
:member
noop $json.consumewhitespace($1)
; Parse members
var %any = $json.parseany($1)
var %type = $gettok(%any,1,32)
var %value = $gettok(%any,2-,32)
if (%type == ERROR) {
json.debug Error parsing array member: %value
json.freeall 2 %datatable %typetable
return %value
}
else {
; 0 indexed
var %newindex = $calc($hget(%datatable,0).item)
; Binary data
json.debug ParseArray: Add type %type array index %newindex as %value
if (%type == 3) {
hadd -b %datatable %newindex %value
}
else {
hadd %datatable %newindex %value
}
hadd %typetable %newindex %type
}
noop $json.consumewhitespace($1)
if ($bvar($1,1) == $json.chars().DELIMITER) {
json.trimstart $1 1
goto member
}
elseif ($bvar($1,1) == $json.chars().ARRAY_END) {
json.debug Parsed array successfully
json.trimstart $1 1
return %datatable %typetable
}
json.debug ParseArray failed with an unknown error. Read characters: $bvar($1,1)
json.freeall 2 %datatable %typetable
return $json.errors().UNEXPECTED_CHAR
}
; $json.consumewhitespace(&binvar) - returns number consumed
alias -l json.consumewhitespace {
while ($bvar($1,0) && ($bvar($1,1) == 32 || $bvar($1,1) == 9 || $bvar($1,1) == 160 || $bvar($1,1) == 10 || $bvar($1,1) == 13)) {
json.trimstart $1 1
}
}
; /json.trimstart &binvar length - trims length characters from the start of $binvar
alias -l json.trimstart {
; json.debug Trimstart: $1 $2 -- Size of bvar: $bvar($1,0)
if ($bvar($1,0) == 1) { bunset $1 }
else { bcopy -c $1 1 $1 $calc($2 +1) -1 }
}
; $json.getpropery(table, property).type - Returns number representing type of property
; $json.getproperty(table, property).value - Returns value of property
; $json.getproperty(table, property).bvar - Returns value of property as bvar
; $json.getproperty(table, property).arraytypetable - If property is array, returns its type table
; $json.getproperty(table, property).arraydatatable - If property is table,r eturns its data table
alias -l json.getproperty {
var %type = $hget($1,type. $+ $2)
var %value = $hget($1,value. $+ $2)
if ($prop == type) { return %type }
if ($prop == bvar) { noop $hget($1, value. $+ $2, &bvReturn) | return &bvReturn }
if ($prop == arraytypetable) { return $gettok(%value,2,32) }
if ($prop == arraydatatable) { return $gettok(%value,1,32) }
return %value
}
; $json.createtable - Creates a hashtable and returns its name
; $json.createtable(N) - gives it size N
alias -l json.createtable {
var %ticks = $ticks
var %rand = $rand(1,4294967295)
var %table = $+(json.,%ticks,.,%rand)
hmake %table $iif($1,$1,10)
return %table
}
; Creates a random binvar name to avoid collisions
alias -l json.createbvar {
var %ticks = $ticks
var %rand = $rand(1,4294967295)
var %bv = $+(&jsonbv.,%ticks,.,%rand)
return %bv
}
alias -l json.chars {
; {
if ($prop == OBJECT_START) { return 123 }
; }
if ($prop == OBJECT_END) { return 125 }
; "
if ($prop == STRING_START || $prop == STRING_END) { return 34 }
if ($prop == STRING_ESCAPE) { return $asc(\) }
if ($prop == ARRAY_START) { return $asc([) }
if ($prop == ARRAY_END) { return $asc(]) }
; ,
if ($prop == DELIMITER) { return 44 }
if ($prop == MAPPING) { return $asc(:) }
}
alias -l json.errors {
if ($prop == EXPECTED_START) { return 1 }
if ($prop == EXPECTED_END) { return 2 }
if ($prop == EXPECTED_DELIMITER) { return 3 }
if ($prop == EXPECTED_MAPPING) { return 4 }
if ($prop == UNEXPECTED_CHAR) { return 5 }
return 255
}
alias -l json.debug {
; echo -atg Debug: $1-
}

MJSON

2014-12-07T01:08:45Z

Aca20031: /* Script */

This script is a 100% native way of parsing JSON with an easy API

==Example==
To use the below example, Save the following JSON in "json-example.txt" in $mircdir

[
{
"name":"Todd",
"IsManager":false,
"Spouse":{"Name":"Marie"},
"Sallary":100000
},
{
"name":"Gena",
"IsManager":true,
"Spouse":null,
"Sallary":157103e-3
}
]

And then run /json-example with the script loaded.

alias json-example {
bread json-example.txt 0 $file(json-example.txt).size &bvar

; Parse top level
var %aEmployees = $json.parse(&bvar)
echo -atg The top level is a(n) $json.type(%aEmployees)

var %cEmployees = $json(%aEmployees).length
echo -atg Number of employees: %cEmployees

var %i = 0
while (%i < %cEmployees) {
var %oEmployee = $json(%aEmployees,%i)
inc %i

echo -atg Name: $json(%oEmployee,name).text
echo -atg IsManager: $json(%oEmployee,ismanager).text
var %spouse = $json(%oEmployee,spouse)
if (%spouse) { echo -atg Spouse: $json(%spouse,name).text }
echo -atg Sallary: $json(%oEmployee,Sallary).text
}

; Free memory
json.freeall %aEmployees
}

==Script==

;mJSON by Ben Buzbee (ben@st0rm.net)
;
;
;$json.parse(&bvar | json string) - Parses a json and returns you a "handle". Use this in the other functions
; If the handle is "ERROR N" then N is an error code
;
; $json(handle,N/PROPERTY)
; Give a handle (use json.parse first) allows you to index an array get a handle to a property
; .text - Returns a data property or array index as text, e.g. $json($json.parse({"foo":"bar"}),bar).text
; .bvar - Returns a data property or array index as a binvar
;
; $json.freeall(handle)
; Frees memory used to parse the given handle
;

alias json.parse {
var %bvar = $false
if (&* iswm $1) {
%bvar = $1
}
else {
%bvar = $json.createbvar
bset -t %bvar 1 $1-
}
return $json.parseany(%bvar)
}
; $json.type(handle) - Returns ARRAY, OBJECT, or Data
alias json.type {
tokenize 32 $1-
if ($1 == 1) { return OBJECT }
elseif ($1 == 2) { return ARRAY }
elseif ($1 == 3) { return DATA }
}
; $json(handle [,N/PROPERTY])
; Give a handle (use json.parse first) allows you to index an array get a handle to a property
; .text - Returns a data property or array index as text, e.g. $json($json.parse({"foo":"bar"}),bar).text
; .bvar - Returns a data property or array index as a binvar
; .length - If the property is an array, or the handle is an array that isn't indexed, returns its length
alias json {
var %type = $gettok($1,1,32)
var %value = $gettok($1,2-,32)
if ($2 isnum && %type != 2) {
; Can't index non array
echo -atg $json Cannot use indexer on non-array value
return
}
; Indexing into an array
if ($2 isnum && %type == 2) {
var %datatable = $gettok(%value,1,32)
var %typetable = $gettok(%value,2,32)
var %thistype = $hget(%typetable,$2)
var %thisdata = $hget(%datatable,$2)
if (!%thistype) { return $null }
if (%thistype == 3 && $prop == bvar) {
var %bv = $json.createbvar
noop $hget(%datatable,$2,%bv)
return %bv
}
elseif (%thistype == 3 && $prop == text) {
return %thisdata
}
elseif (%thistype == 3) {
var %bv = $json.createbvar
noop $hget(%datatable,$2,%bv)
return %thistype %bv
}
elseif (%thistype != 3) {
return %thistype %thisdata
}
}
elseif (%type == 2 && $prop == length) {
; If we're not indexing, but we have an array with the .length property, return its length
; Return length of the data table for the array
return $hget($gettok(%value,1,32),0).item
}
; Getting a property of an object
elseif (%type == 1) {
var %proptype = $json.getproperty(%value,$2).type
var %propvalue = $json.getproperty(%value,$2).value
var %propbv = $json.getproperty(%value,$2).bvar
if (!%proptype) { return $null }
if (%proptype == 3 && $prop == text) {
return %propvalue
}
elseif (%proptype == 3 && $prop == bvar) {
return %propbv
}
elseif (%proptype == 3) {
return %proptype %propbv
}
elseif (%proptype == 2 && $prop == length) {
; Return length of the data table for the array
return $hget($gettok(%propvalue,1,32),0).item
}
else {
return %proptype %propvalue
}
}
else {
echo -atg Unknown usage of $!json --> Prop: $prop P1: $1 P2: $2
}
}
; Hash table layout:
; Name: json.<ticks><rand1,4294967295>
; Key: Name of json property
; Value <N> <value>
; N: 1 = pointer to another object, 3 = raw value
; 2 = <pointer to data array> <pointer to assoc array indicating types of data array>
; $json.proxyrecurse(idname, param1, param2)
alias -l json.proxyrecurse2 {
return $($+($,$1,$chr(40),$2,$chr(44),$3,$chr(41)),2)
}
; /json.freeall <type> <value>
alias -l json.freeall {
if (!$isid) {
noop $json.proxyrecurse2(json.freeall,$1,$2-)
return
}
json.debug ?4freeall $1-
; For binary data, just return
if ($1 == 3) {
return
}
; For arrays, call on each element then hfree tables
elseif ($1 == 2) {
var %datatable = $gettok($2,1,32)
var %typetable = $gettok($2,2,32)
json.debug Freeing array, datatable: %datatable - typetable: %typetable
var %i = 0
while ($hget(%typetable,%i)) {
noop $json.proxyrecurse2(json.freeall,$ifmatch,$hget(%datatable,%i))
inc %i
}
.hfree %datatable
.hfree %typetable
}
; For objects, call on every property then hfree table
elseif ($1 == 1) {
var %i = 1
while ($hget($2,%i).item) {
inc %i
var %item = $ifmatch
if (type.* iswm %item) {
var %membername = $gettok(%item,2-,$asc(.))
noop $json.proxyrecurse2(json.freeall,$hget($2,%item), $hget($2,value. $+ %membername))
}
}
.hfree $2
}
}
; Parses an array, object, string or int, depending on the next character, and returns <type> <value>
; or returns "ERROR <error>
alias -l json.parseany {
; Now, read the value of the property
if ($bvar($1,1) == $json.chars().STRING_START) {
json.debug Parseany detected a string
var %strVal = $json.parsestring($1)
if (%strVal isnum) {
json.debug Error parsing string: %error
return ERROR %strVal
}
json.debug ParseAny: Read string value: $bvar(%strval,1-).text
return 3 %strval
}
elseif ($bvar($1,1) == $json.chars().OBJECT_START) {
json.debug ParseAny: detected an object
var %obj = $json.parseobject($1)
if (%obj isnum) { json.debug ParseAny: Error reading object subvalue ( $+ %obj $+ ) | return ERROR %obj }
json.debug ParseAny: Read object subvalue as %obj
return 1 %obj
}
elseif ($bvar($1,1) == $json.chars().ARRAY_START) {
json.debug Parseany detected an array
var %array = $json.parsearray($1)
if (%array isnum) {
json.debug ParseAny: error reading array subvalue: %array
return ERROR %array
}
json.debug ParseAny: Read array subvalue as %array
return 2 %array
}
elseif ($bvar($1,1,4).text == null) {
json.debug ParseAny found NULL value
json.trimstart $1 4
return 3 $null
}
elseif ($bvar($1,1,5).text == false || $bvar($1,1,4).text == true) {
var %value = $iif($bvar($1,1,5).text == false,$false,$true)
; if true, trim 'true' off the top, otherwise trim 'false'
if (%value) { json.trimstart $1 4 }
else { json.trimstart $1 5 }
json.debug ParseAny found bool value: %value
return 3 %value
}
; Must be an int
else {
var %int = $json.parseint($1)
if (%int isnum) {
json.debug Error reading int subvalue: %int
return ERROR %int
}
if ($bvar(%int,0) == 0) {
return ERROR $json.errors().UNEXPECTED_CHAR
}
json.debug Read int subvalue into var %int as $bvar(%int,1-).text
return 3 %int
}
}
; $json.parseobject(&binvar) - returns object name or error code
alias -l json.parseobject {
if ($bvar($1,1) == $json.chars().OBJECT_START) {
; Trim off {
json.trimstart $1 1
}
var %table = $json.createtable
var %error = 0
:property
noop $json.consumewhitespace($1)
if ($bvar($1,1) != $json.chars().STRING_START) { %error = $json.errors().EXPECTED_START | goto return }
; Property name
var %strPropName = $json.parsestring($1)
if (%strPropName isnum) { json.debug Error reading property name for object $1 }
else {
%strPropName = $bvar(%strPropName,1-).text
json.debug ParseObject: Read property %strPropName
noop $json.consumewhitespace($1)
if ($bvar($1,1) != $json.chars().MAPPING) { %error = $json.errors().EXPECTED_MAPPING | goto return }
; trim the mapping character
json.trimstart $1 1
noop $json.consumewhitespace($1)
var %any = $json.parseany($1)
var %type = $gettok(%any,1,32)
var %value = $gettok(%any,2-,32)
if (%type == ERROR) {
%error = %value
goto return
}
if (%type == 3) {
; rvalue
hadd %table type. $+ %strPropName 3
if (%value == $true || %value == $false) {
json.debug PasrseObject; Found boolean value for %strPropName : %value
hadd %table value. $+ %strPropName %value
}
elseif (!$bvar(%value,0)) {
hadd %table value. $+ %strPropName $null
}
else {
hadd -b %table value. $+ %strPropName %value
}
}
else if (%type == 2) {
; Arrays
json.debug Read array %strPropName as %value for object %table
hadd %table type. $+ %strPropName 2
; Add array hashtable
hadd %table value. $+ %strPropName %value
}
else if (%type == 1) {
hadd %table type. $+ %strPropName 1
; Add object naem to table
hadd %table value. $+ %strPropName %value
}
}
; Check to see if there are more properties
noop $json.consumewhitespace($1)
if ($bvar($1,1) == $json.chars().OBJECT_END) { json.debug Successful object parsing. | json.trimstart $1 1 | goto return }
elseif ($bvar($1,1) == $json.chars().DELIMITER) { json.trimstart $1 1 | goto property }
else { return $json.errors().UNEXPECTED_CHAR }
:return
if (%error) {
json.freeall %table
return %error
}
return %table
}
; $json.parsestring(&binvar) - returns string (binvar) or error code
alias -l json.parsestring {
var %bv = $json.createbvar
if ($bvar($1,1) != $json.chars().STRING_START) { return $json.errors().EXPECTED_START }
json.trimstart $1 1
var %escape = 0
:loop
if ($bvar($1,1) == $json.chars().STRING_ESCAPE) {
if (%escape) {
; If the escape character is escaped, append it
dec %escape
goto append
}
else {
inc %escape
; Skip appending
goto trim
}
}
if (%escape) {
if ($bvar($1,1) == $asc(r)) { bset $1 1 $cr | dec %escape }
if ($bvar($1,1) == $asc(n)) { bset $1 1 $lf | dec %escape }
if ($bvar($1,1) == $asc(t)) { bset $1 1 9 | dec %escape }
if ($bvar($1,1) == $asc(b)) { bset $1 1 8 | dec %escape }
}
:append
; Add this character to the end
bset %bv $calc($bvar(%bv,0) +1) $bvar($1,1)
:trim
; Trim from the start
json.trimstart $1 1
; If we're at the end of a string and not escaped, bail out
if ($bvar($1,1) == $json.chars().STRING_END && !%escape) {
json.trimstart $1 1
return %bv
}
; Make sure we haven't consumed all the input
if ($bvar($1,0)) {
goto loop
}
return %bv
}
; $json.parseint(&binvar) - returns an int or error code
alias -l json.parseint {
var %bv = &json.createbvar
; Lax on the number format since its a string for us anyway
while ($bvar($1,1).text isnum || $bvar($1,1) == $asc(.) || $bvar($1,1) == $asc(-) || $bvar($1,1) == $asc(+) || $bvar($1,1) == $asc(e)) {
bset %bv $calc($bvar(%bv,0) +1) $bvar($1,1)
json.trimstart $1 1
}
return %bv
}
$json.parsearray - returns array tables (data, types) or error code
alias -l json.parsearray {
if ($bvar($1,1) != $json.chars().ARRAY_START) {
return $json.errors().EXPECTED_START
}
json.trimstart $1 1
; Create a linked list for the data
var %datatable = $json.createtable(1)
; Create a linked list for the types (associative with respect to the data list)
var %typetable = $json.createtable(1)
:member
noop $json.consumewhitespace($1)
; Parse members
var %any = $json.parseany($1)
var %type = $gettok(%any,1,32)
var %value = $gettok(%any,2-,32)
if (%type == ERROR) {
json.debug Error parsing array member: %value
json.freeall 2 %datatable %typetable
return %value
}
else {
; 0 indexed
var %newindex = $calc($hget(%datatable,0).item)
; Binary data
json.debug Add type %type array index %newindex as %value
if (%type == 3) {
hadd -b %datatable %newindex %value
}
else {
hadd %datatable %newindex %value
}
hadd %typetable %newindex %type
}
noop $json.consumewhitespace($1)
if ($bvar($1,1) == $json.chars().DELIMITER) {
json.trimstart $1 1
goto member
}
elseif ($bvar($1,1) == $json.chars().ARRAY_END) {
json.debug Parsed array successfully
json.trimstart $1 1
return %datatable %typetable
}
json.freeall 2 %datatable %typetable
return $json.errors().UNKNOWN
}
; $json.consumewhitespace(&binvar) - returns number consumed
alias -l json.consumewhitespace {
while ($bvar($1,0) && ($bvar($1,1) == 32 || $bvar($1,1) == 9 || $bvar($1,1) == 160 || $bvar($1,1) == 10 || $bvar($1,1) == 13)) {
json.trimstart $1 1
}
}
; /json.trimstart &binvar length - trims length characters from the start of $binvar
alias -l json.trimstart {
; json.debug Trimstart: $1 $2 -- Size of bvar: $bvar($1,0)
if ($bvar($1,0) == 1) { bunset $1 }
else { bcopy -c $1 1 $1 $calc($2 +1) -1 }
}
; $json.getpropery(table, property).type - Returns number representing type of property
; $json.getproperty(table, property).value - Returns value of property
; $json.getproperty(table, property).bvar - Returns value of property as bvar
; $json.getproperty(table, property).arraytypetable - If property is array, returns its type table
; $json.getproperty(table, property).arraydatatable - If property is table,r eturns its data table
alias -l json.getproperty {
var %type = $hget($1,type. $+ $2)
var %value = $hget($1,value. $+ $2)
if ($prop == type) { return %type }
if ($prop == bvar) { noop $hget($1, value. $+ $2, &bvReturn) | return &bvReturn }
if ($prop == arraytypetable) { return $gettok(%value,2,32) }
if ($prop == arraydatatable) { return $gettok(%value,1,32) }
return %value
}
; $json.createtable - Creates a hashtable and returns its name
; $json.createtable(N) - gives it size N
alias -l json.createtable {
var %ticks = $ticks
var %rand = $rand(1,4294967295)
var %table = $+(json.,%ticks,.,%rand)
hmake %table $iif($1,$1,10)
return %table
}
; Creates a random binvar name to avoid collisions
alias -l json.createbvar {
var %ticks = $ticks
var %rand = $rand(1,4294967295)
var %bv = $+(&jsonbv.,%ticks,.,%rand)
return %bv
}
alias -l json.chars {
; {
if ($prop == OBJECT_START) { return 123 }
; }
if ($prop == OBJECT_END) { return 125 }
; "
if ($prop == STRING_START || $prop == STRING_END) { return 34 }
if ($prop == STRING_ESCAPE) { return $asc(\) }
if ($prop == ARRAY_START) { return $asc([) }
if ($prop == ARRAY_END) { return $asc(]) }
; ,
if ($prop == DELIMITER) { return 44 }
if ($prop == MAPPING) { return $asc(:) }
}
alias -l json.errors {
if ($prop == EXPECTED_START) { return 1 }
if ($prop == EXPECTED_END) { return 2 }
if ($prop == EXPECTED_DELIMITER) { return 3 }
if ($prop == EXPECTED_MAPPING) { return 4 }
if ($prop == UNEXPECTED_CHAR) { return 5 }
return 255
}
alias -l json.debug {
; echo -atg Debug: $1-
}

{{Author|aca20031}}

[[Category:Script Archive]]

MJSON

2014-12-07T01:07:45Z

Aca20031:

This script is a 100% native way of parsing JSON with an easy API

==Example==
To use the below example, Save the following JSON in "json-example.txt" in $mircdir

[
{
"name":"Todd",
"IsManager":false,
"Spouse":{"Name":"Marie"},
"Sallary":100000
},
{
"name":"Gena",
"IsManager":true,
"Spouse":null,
"Sallary":157103e-3
}
]

And then run /json-example with the script loaded.

alias json-example {
bread json-example.txt 0 $file(json-example.txt).size &bvar

; Parse top level
var %aEmployees = $json.parse(&bvar)
echo -atg The top level is a(n) $json.type(%aEmployees)

var %cEmployees = $json(%aEmployees).length
echo -atg Number of employees: %cEmployees

var %i = 0
while (%i < %cEmployees) {
var %oEmployee = $json(%aEmployees,%i)
inc %i

echo -atg Name: $json(%oEmployee,name).text
echo -atg IsManager: $json(%oEmployee,ismanager).text
var %spouse = $json(%oEmployee,spouse)
if (%spouse) { echo -atg Spouse: $json(%spouse,name).text }
echo -atg Sallary: $json(%oEmployee,Sallary).text
}

; Free memory
json.freeall %aEmployees
}

==Script==

;mJSON by Ben Buzbee (ben@st0rm.net)
;
;
;$json.parse(&bvar | json string) - Parses a json and returns you a "handle". Use this in the other functions
; If the handle is "ERROR N" then N is an error code
;
; $json(handle,N/PROPERTY)
; Give a handle (use json.parse first) allows you to index an array get a handle to a property
; .text - Returns a data property or array index as text, e.g. $json($json.parse({"foo":"bar"}),bar).text
; .bvar - Returns a data property or array index as a binvar
;
; $json.freeall(handle)
; Frees memory used to parse the given handle
;

alias json.parse {
var %bvar = $false
if (&* iswm $1) {
%bvar = $1
}
else {
%bvar = $json.createbvar
bset -t %bvar 1 $1-
}
return $json.parseany(%bvar)
}
; $json.type(handle) - Returns ARRAY, OBJECT, or Data
alias json.type {
tokenize 32 $1-
if ($1 == 1) { return OBJECT }
elseif ($1 == 2) { return ARRAY }
elseif ($1 == 3) { return DATA }
}
; $json(handle [,N/PROPERTY])
; Give a handle (use json.parse first) allows you to index an array get a handle to a property
; .text - Returns a data property or array index as text, e.g. $json($json.parse({"foo":"bar"}),bar).text
; .bvar - Returns a data property or array index as a binvar
; .length - If the property is an array, or the handle is an array that isn't indexed, returns its length
alias json {
var %type = $gettok($1,1,32)
var %value = $gettok($1,2-,32)
if ($2 isnum && %type != 2) {
; Can't index non array
echo -atg $json Cannot use indexer on non-array value
return
}
; Indexing into an array
if ($2 isnum && %type == 2) {
var %datatable = $gettok(%value,1,32)
var %typetable = $gettok(%value,2,32)
var %thistype = $hget(%typetable,$2)
var %thisdata = $hget(%datatable,$2)
if (!%thistype) { return $null }
if (%thistype == 3 && $prop == bvar) {
var %bv = $json.createbvar
noop $hget(%datatable,$2,%bv)
return %bv
}
elseif (%thistype == 3 && $prop == text) {
return %thisdata
}
elseif (%thistype == 3) {
var %bv = $json.createbvar
noop $hget(%datatable,$2,%bv)
return %thistype %bv
}
elseif (%thistype != 3) {
return %thistype %thisdata
}
}
elseif (%type == 2 && $prop == length) {
; If we're not indexing, but we have an array with the .length property, return its length
; Return length of the data table for the array
return $hget($gettok(%value,1,32),0).item
}
; Getting a property of an object
elseif (%type == 1) {
var %proptype = $json.getproperty(%value,$2).type
var %propvalue = $json.getproperty(%value,$2).value
var %propbv = $json.getproperty(%value,$2).bvar
if (!%proptype) { return $null }
if (%proptype == 3 && $prop == text) {
return %propvalue
}
elseif (%proptype == 3 && $prop == bvar) {
return %propbv
}
elseif (%proptype == 3) {
return %proptype %propbv
}
elseif (%proptype == 2 && $prop == length) {
; Return length of the data table for the array
return $hget($gettok(%propvalue,1,32),0).item
}
else {
return %proptype %propvalue
}
}
else {
echo -atg Unknown usage of $!json --> Prop: $prop P1: $1 P2: $2
}
}
; Hash table layout:
; Name: json.<ticks><rand1,4294967295>
; Key: Name of json property
; Value <N> <value>
; N: 1 = pointer to another object, 3 = raw value
; 2 = <pointer to data array> <pointer to assoc array indicating types of data array>
; $json.proxyrecurse(idname, param1, param2)
alias -l json.proxyrecurse2 {
return $($+($,$1,$chr(40),$2,$chr(44),$3,$chr(41)),2)
}
; /json.freeall <type> <value>
alias -l json.freeall {
if (!$isid) {
noop $json.proxyrecurse2(json.freeall,$1,$2-)
return
}
json.debug ?4freeall $1-
; For binary data, just return
if ($1 == 3) {
return
}
; For arrays, call on each element then hfree tables
elseif ($1 == 2) {
var %datatable = $gettok($2,1,32)
var %typetable = $gettok($2,2,32)
json.debug Freeing array, datatable: %datatable - typetable: %typetable
var %i = 0
while ($hget(%typetable,%i)) {
noop $json.proxyrecurse2(json.freeall,$ifmatch,$hget(%datatable,%i))
inc %i
}
.hfree %datatable
.hfree %typetable
}
; For objects, call on every property then hfree table
elseif ($1 == 1) {
var %i = 1
while ($hget($2,%i).item) {
inc %i
var %item = $ifmatch
if (type.* iswm %item) {
var %membername = $gettok(%item,2-,$asc(.))
noop $json.proxyrecurse2(json.freeall,$hget($2,%item), $hget($2,value. $+ %membername))
}
}
.hfree $2
}
}
; Parses an array, object, string or int, depending on the next character, and returns <type> <value>
; or returns "ERROR <error>
alias -l json.parseany {
; Now, read the value of the property
if ($bvar($1,1) == $json.chars().STRING_START) {
json.debug Parseany detected a string
var %strVal = $json.parsestring($1)
if (%strVal isnum) {
json.debug Error parsing string: %error
return ERROR %strVal
}
json.debug ParseAny: Read string value: $bvar(%strval,1-).text
return 3 %strval
}
elseif ($bvar($1,1) == $json.chars().OBJECT_START) {
json.debug ParseAny: detected an object
var %obj = $json.parseobject($1)
if (%obj isnum) { json.debug ParseAny: Error reading object subvalue ( $+ %obj $+ ) | return ERROR %obj }
json.debug ParseAny: Read object subvalue as %obj
return 1 %obj
}
elseif ($bvar($1,1) == $json.chars().ARRAY_START) {
json.debug Parseany detected an array
var %array = $json.parsearray($1)
if (%array isnum) {
json.debug ParseAny: error reading array subvalue: %array
return ERROR %array
}
json.debug ParseAny: Read array subvalue as %array
return 2 %array
}
elseif ($bvar($1,1,4).text == null) {
json.debug ParseAny found NULL value
json.trimstart $1 4
return 3 $null
}
elseif ($bvar($1,1,5).text == false || $bvar($1,1,4).text == true) {
var %value = $iif($bvar($1,1,5).text == false,$false,$true)
; if true, trim 'true' off the top, otherwise trim 'false'
if (%value) { json.trimstart $1 4 }
else { json.trimstart $1 5 }
json.debug ParseAny found bool value: %value
return 3 %value
}
; Must be an int
else {
var %int = $json.parseint($1)
if (%int isnum) {
json.debug Error reading int subvalue: %int
return ERROR %int
}
if ($bvar(%int,0) == 0) {
return ERROR $json.errors().UNEXPECTED_CHAR
}
json.debug Read int subvalue into var %int as $bvar(%int,1-).text
return 3 %int
}
}
; $json.parseobject(&binvar) - returns object name or error code
alias -l json.parseobject {
if ($bvar($1,1) == $json.chars().OBJECT_START) {
; Trim off {
json.trimstart $1 1
}
var %table = $json.createtable
var %error = 0
:property
noop $json.consumewhitespace($1)
if ($bvar($1,1) != $json.chars().STRING_START) { %error = $json.errors().EXPECTED_START | goto return }
; Property name
var %strPropName = $json.parsestring($1)
if (%strPropName isnum) { json.debug Error reading property name for object $1 }
else {
%strPropName = $bvar(%strPropName,1-).text
json.debug ParseObject: Read property %strPropName
noop $json.consumewhitespace($1)
if ($bvar($1,1) != $json.chars().MAPPING) { %error = $json.errors().EXPECTED_MAPPING | goto return }
; trim the mapping character
json.trimstart $1 1
noop $json.consumewhitespace($1)
var %any = $json.parseany($1)
var %type = $gettok(%any,1,32)
var %value = $gettok(%any,2-,32)
if (%type == ERROR) {
%error = %value
goto return
}
if (%type == 3) {
; rvalue
hadd %table type. $+ %strPropName 3
if (%value == $true || %value == $false) {
json.debug PasrseObject; Found boolean value for %strPropName : %value
hadd %table value. $+ %strPropName %value
}
elseif (!$bvar(%value,0)) {
hadd %table value. $+ %strPropName $null
}
else {
hadd -b %table value. $+ %strPropName %value
}
}
else if (%type == 2) {
; Arrays
json.debug Read array %strPropName as %value for object %table
hadd %table type. $+ %strPropName 2
; Add array hashtable
hadd %table value. $+ %strPropName %value
echo -atg hadd %table value. $+ %strPropName %value
echo -atg $hget(%table,value. $+ %strPropName)
}
else if (%type == 1) {
hadd %table type. $+ %strPropName 1
; Add object naem to table
hadd %table value. $+ %strPropName %value
}
}
; Check to see if there are more properties
noop $json.consumewhitespace($1)
if ($bvar($1,1) == $json.chars().OBJECT_END) { json.debug Successful object parsing. | json.trimstart $1 1 | goto return }
elseif ($bvar($1,1) == $json.chars().DELIMITER) { json.trimstart $1 1 | goto property }
else { return $json.errors().UNEXPECTED_CHAR }
:return
if (%error) {
json.freeall %table
return %error
}
return %table
}
; $json.parsestring(&binvar) - returns string (binvar) or error code
alias -l json.parsestring {
var %bv = $json.createbvar
if ($bvar($1,1) != $json.chars().STRING_START) { return $json.errors().EXPECTED_START }
json.trimstart $1 1
var %escape = 0
:loop
if ($bvar($1,1) == $json.chars().STRING_ESCAPE) {
if (%escape) {
; If the escape character is escaped, append it
dec %escape
goto append
}
else {
inc %escape
; Skip appending
goto trim
}
}
if (%escape) {
if ($bvar($1,1) == $asc(r)) { bset $1 1 $cr | dec %escape }
if ($bvar($1,1) == $asc(n)) { bset $1 1 $lf | dec %escape }
if ($bvar($1,1) == $asc(t)) { bset $1 1 9 | dec %escape }
if ($bvar($1,1) == $asc(b)) { bset $1 1 8 | dec %escape }
}
:append
; Add this character to the end
bset %bv $calc($bvar(%bv,0) +1) $bvar($1,1)
:trim
; Trim from the start
json.trimstart $1 1
; If we're at the end of a string and not escaped, bail out
if ($bvar($1,1) == $json.chars().STRING_END && !%escape) {
json.trimstart $1 1
return %bv
}
; Make sure we haven't consumed all the input
if ($bvar($1,0)) {
goto loop
}
return %bv
}
; $json.parseint(&binvar) - returns an int or error code
alias -l json.parseint {
var %bv = &json.createbvar
; Lax on the number format since its a string for us anyway
while ($bvar($1,1).text isnum || $bvar($1,1) == $asc(.) || $bvar($1,1) == $asc(-) || $bvar($1,1) == $asc(+) || $bvar($1,1) == $asc(e)) {
bset %bv $calc($bvar(%bv,0) +1) $bvar($1,1)
json.trimstart $1 1
}
return %bv
}
$json.parsearray - returns array tables (data, types) or error code
alias -l json.parsearray {
if ($bvar($1,1) != $json.chars().ARRAY_START) {
return $json.errors().EXPECTED_START
}
json.trimstart $1 1
; Create a linked list for the data
var %datatable = $json.createtable(1)
; Create a linked list for the types (associative with respect to the data list)
var %typetable = $json.createtable(1)
:member
noop $json.consumewhitespace($1)
; Parse members
var %any = $json.parseany($1)
var %type = $gettok(%any,1,32)
var %value = $gettok(%any,2-,32)
if (%type == ERROR) {
json.debug Error parsing array member: %value
json.freeall 2 %datatable %typetable
return %value
}
else {
; 0 indexed
var %newindex = $calc($hget(%datatable,0).item)
; Binary data
json.debug Add type %type array index %newindex as %value
if (%type == 3) {
hadd -b %datatable %newindex %value
}
else {
hadd %datatable %newindex %value
}
hadd %typetable %newindex %type
}
noop $json.consumewhitespace($1)
if ($bvar($1,1) == $json.chars().DELIMITER) {
json.trimstart $1 1
goto member
}
elseif ($bvar($1,1) == $json.chars().ARRAY_END) {
json.debug Parsed array successfully
json.trimstart $1 1
return %datatable %typetable
}
json.freeall 2 %datatable %typetable
return $json.errors().UNKNOWN
}
; $json.consumewhitespace(&binvar) - returns number consumed
alias -l json.consumewhitespace {
while ($bvar($1,0) && ($bvar($1,1) == 32 || $bvar($1,1) == 9 || $bvar($1,1) == 160 || $bvar($1,1) == 10 || $bvar($1,1) == 13)) {
json.trimstart $1 1
}
}
; /json.trimstart &binvar length - trims length characters from the start of $binvar
alias -l json.trimstart {
; json.debug Trimstart: $1 $2 -- Size of bvar: $bvar($1,0)
if ($bvar($1,0) == 1) { bunset $1 }
else { bcopy -c $1 1 $1 $calc($2 +1) -1 }
}
; $json.getpropery(table, property).type - Returns number representing type of property
; $json.getproperty(table, property).value - Returns value of property
; $json.getproperty(table, property).bvar - Returns value of property as bvar
; $json.getproperty(table, property).arraytypetable - If property is array, returns its type table
; $json.getproperty(table, property).arraydatatable - If property is table,r eturns its data table
alias -l json.getproperty {
var %type = $hget($1,type. $+ $2)
var %value = $hget($1,value. $+ $2)
if ($prop == type) { return %type }
if ($prop == bvar) { noop $hget($1, value. $+ $2, &bvReturn) | return &bvReturn }
if ($prop == arraytypetable) { return $gettok(%value,2,32) }
if ($prop == arraydatatable) { return $gettok(%value,1,32) }
return %value
}
; $json.createtable - Creates a hashtable and returns its name
; $json.createtable(N) - gives it size N
alias -l json.createtable {
var %ticks = $ticks
var %rand = $rand(1,4294967295)
var %table = $+(json.,%ticks,.,%rand)
hmake %table $iif($1,$1,10)
return %table
}
; Creates a random binvar name to avoid collisions
alias -l json.createbvar {
var %ticks = $ticks
var %rand = $rand(1,4294967295)
var %bv = $+(&jsonbv.,%ticks,.,%rand)
return %bv
}
alias -l json.chars {
; {
if ($prop == OBJECT_START) { return 123 }
; }
if ($prop == OBJECT_END) { return 125 }
; "
if ($prop == STRING_START || $prop == STRING_END) { return 34 }
if ($prop == STRING_ESCAPE) { return $asc(\) }
if ($prop == ARRAY_START) { return $asc([) }
if ($prop == ARRAY_END) { return $asc(]) }
; ,
if ($prop == DELIMITER) { return 44 }
if ($prop == MAPPING) { return $asc(:) }
}
alias -l json.errors {
if ($prop == EXPECTED_START) { return 1 }
if ($prop == EXPECTED_END) { return 2 }
if ($prop == EXPECTED_DELIMITER) { return 3 }
if ($prop == EXPECTED_MAPPING) { return 4 }
if ($prop == UNEXPECTED_CHAR) { return 5 }
return 255
}
alias -l json.debug {
; echo -atg Debug: $1-
}

{{Author|aca20031}}

[[Category:Script Archive]]

MJSON

2014-12-06T23:31:16Z

Aca20031: Created page with "This script is a 100% native way of parsing JSON with an easy API ==Example== To use the below example, Save the following JSON in "json-example.txt" in $mircdir [ { ..."

This script is a 100% native way of parsing JSON with an easy API

==Example==
To use the below example, Save the following JSON in "json-example.txt" in $mircdir

[
{
"name":"Todd",
"IsManager":false,
"Spouse":{"Name":"Marie"},
"Sallary":100000
},
{
"name":"Gena",
"IsManager":true,
"Spouse":null,
"Sallary":157103e-3
}
]

And then run /json-example with the script loaded.

alias json-example {
bread json-example.txt 0 $file(json-example.txt).size &bvar

; Parse top level
var %aEmployees = $json.parse(&bvar)
echo -atg The top level is a(n) $json.gettype(%aEmployees)

var %cEmployees = $json(%aEmployees).length
echo -atg Number of employees: %cEmployees

var %i = 0
while (%i < %cEmployees) {
var %oEmployee = $json(%aEmployees,%i)
inc %i

echo -atg Name: $json(%oEmployee,name).text
echo -atg IsManager: $json(%oEmployee,ismanager).text
var %spouse = $json(%oEmployee,spouse)
if (%spouse) { echo -atg Spouse: $json(%spouse,name).text }
echo -atg Sallary: $json(%oEmployee,Sallary).text
}

; Free memory
json.freeall %aEmployees
}

==Script==

;mJSON by Ben Buzbee (ben@st0rm.net)
;
;
;$json.parse(&bvar | json string) - Parses a json and returns you a "handle". Use this in the other functions
; If the handle is "ERROR N" then N is an error code
;
; $json(handle,N/PROPERTY)
; Give a handle (use json.parse first) allows you to index an array get a handle to a property
; .text - Returns a data property or array index as text, e.g. $json($json.parse({"foo":"bar"}),bar).text
; .bvar - Returns a data property or array index as a binvar
;
; $json.freeall(handle)
; Frees memory used to parse the given handle
;

alias json.parse {
var %bvar = $false
if (&* iswm $1) {
%bvar = $1
}
else {
%bvar = $json.createbvar
bset -t %bvar 1 $1-
}
return $json.parseany(%bvar)
}
; $json.type(handle) - Returns ARRAY, OBJECT, or Data
alias json.type {
if ($1 == 1) { return OBJECT }
elseif ($1 == 2) { return ARRAY }
elseif ($1 == 3) { return DATA }
}
; $json(handle [,N/PROPERTY])
; Give a handle (use json.parse first) allows you to index an array get a handle to a property
; .text - Returns a data property or array index as text, e.g. $json($json.parse({"foo":"bar"}),bar).text
; .bvar - Returns a data property or array index as a binvar
; .length - If the property is an array, or the handle is an array that isn't indexed, returns its length
alias json {
var %type = $gettok($1,1,32)
var %value = $gettok($1,2-,32)
if ($2 isnum && %type != 2) {
; Can't index non array
echo -atg $json Cannot use indexer on non-array value
return
}
; Indexing into an array
if ($2 isnum && %type == 2) {
var %datatable = $gettok(%value,1,32)
var %typetable = $gettok(%value,2,32)
var %thistype = $hget(%typetable,$2)
var %thisdata = $hget(%datatable,$2)
if (!%thistype) { return $null }
if (%thistype == 3 && $prop == bvar) {
var %bv = $json.createbvar
noop $hget(%datatable,$2,%bv)
return %bv
}
elseif (%thistype == 3 && $prop == text) {
return %thisdata
}
elseif (%thistype == 3) {
var %bv = $json.createbvar
noop $hget(%datatable,$2,%bv)
return %thistype %bv
}
elseif (%thistype != 3) {
return %thistype %thisdata
}
}
elseif (%type == 2 && $prop == length) {
; If we're not indexing, but we have an array with the .length property, return its length
; Return length of the data table for the array
return $hget($gettok(%value,1,32),0).item
}
; Getting a property of an object
elseif (%type == 1) {
var %proptype = $json.getproperty(%value,$2).type
var %propvalue = $json.getproperty(%value,$2).value
var %propbv = $json.getproperty(%value,$2).bvar
if (!%proptype) { return $null }
if (%proptype == 3 && $prop == text) {
return %propvalue
}
elseif (%proptype == 3 && $prop == bvar) {
return %propbv
}
elseif (%proptype == 3) {
return %proptype %propbv
}
elseif (%proptype == 2 && $prop == length) {
; Return length of the data table for the array
return $hget($gettok(%propvalue,1,32),0).item
}
else {
return %proptype %propvalue
}
}
else {
echo -atg Unknown usage of $!json --> Prop: $prop P1: $1 P2: $2
}
}
; Hash table layout:
; Name: json.<ticks><rand1,4294967295>
; Key: Name of json property
; Value <N> <value>
; N: 1 = pointer to another object, 3 = raw value
; 2 = <pointer to data array> <pointer to assoc array indicating types of data array>
; $json.proxyrecurse(idname, param1, param2)
alias -l json.proxyrecurse2 {
return $($+($,$1,$chr(40),$2,$chr(44),$3,$chr(41)),2)
}
; /json.freeall <type> <value>
alias -l json.freeall {
if (!$isid) {
noop $json.proxyrecurse2(json.freeall,$1,$2-)
return
}
json.debug ?4freeall $1-
; For binary data, just return
if ($1 == 3) {
return
}
; For arrays, call on each element then hfree tables
elseif ($1 == 2) {
var %datatable = $gettok($2,1,32)
var %typetable = $gettok($2,2,32)
json.debug Freeing array, datatable: %datatable - typetable: %typetable
var %i = 0
while ($hget(%typetable,%i)) {
noop $json.proxyrecurse2(json.freeall,$ifmatch,$hget(%datatable,%i))
inc %i
}
.hfree %datatable
.hfree %typetable
}
; For objects, call on every property then hfree table
elseif ($1 == 1) {
var %i = 1
while ($hget($2,%i).item) {
inc %i
var %item = $ifmatch
if (type.* iswm %item) {
var %membername = $gettok(%item,2-,$asc(.))
noop $json.proxyrecurse2(json.freeall,$hget($2,%item), $hget($2,value. $+ %membername))
}
}
.hfree $2
}
}
; Parses an array, object, string or int, depending on the next character, and returns <type> <value>
; or returns "ERROR <error>
alias -l json.parseany {
; Now, read the value of the property
if ($bvar($1,1) == $json.chars().STRING_START) {
json.debug Parseany detected a string
var %strVal = $json.parsestring($1)
if (%strVal isnum) {
json.debug Error parsing string: %error
return ERROR %strVal
}
json.debug ParseAny: Read string value: $bvar(%strval,1-).text
return 3 %strval
}
elseif ($bvar($1,1) == $json.chars().OBJECT_START) {
json.debug ParseAny: detected an object
var %obj = $json.parseobject($1)
if (%obj isnum) { json.debug ParseAny: Error reading object subvalue ( $+ %obj $+ ) | return ERROR %obj }
json.debug ParseAny: Read object subvalue as %obj
return 1 %obj
}
elseif ($bvar($1,1) == $json.chars().ARRAY_START) {
json.debug Parseany detected an array
var %array = $json.parsearray($1)
if (%array isnum) {
json.debug ParseAny: error reading array subvalue: %array
return ERROR %array
}
json.debug ParseAny: Read array subvalue as %array
return 2 %array
}
elseif ($bvar($1,1,4).text == null) {
json.debug ParseAny found NULL value
json.trimstart $1 4
return 3 $null
}
elseif ($bvar($1,1,5).text == false || $bvar($1,1,4).text == true) {
var %value = $iif($bvar($1,1,5).text == false,$false,$true)
; if true, trim 'true' off the top, otherwise trim 'false'
if (%value) { json.trimstart $1 4 }
else { json.trimstart $1 5 }
json.debug ParseAny found bool value: %value
return 3 %value
}
; Must be an int
else {
var %int = $json.parseint($1)
if (%int isnum) {
json.debug Error reading int subvalue: %int
return ERROR %int
}
if ($bvar(%int,0) == 0) {
return ERROR $json.errors().UNEXPECTED_CHAR
}
json.debug Read int subvalue into var %int as $bvar(%int,1-).text
return 3 %int
}
}
; $json.parseobject(&binvar) - returns object name or error code
alias -l json.parseobject {
if ($bvar($1,1) == $json.chars().OBJECT_START) {
; Trim off {
json.trimstart $1 1
}
var %table = $json.createtable
var %error = 0
:property
noop $json.consumewhitespace($1)
if ($bvar($1,1) != $json.chars().STRING_START) { %error = $json.errors().EXPECTED_START | goto return }
; Property name
var %strPropName = $json.parsestring($1)
if (%strPropName isnum) { json.debug Error reading property name for object $1 }
else {
%strPropName = $bvar(%strPropName,1-).text
json.debug ParseObject: Read property %strPropName
noop $json.consumewhitespace($1)
if ($bvar($1,1) != $json.chars().MAPPING) { %error = $json.errors().EXPECTED_MAPPING | goto return }
; trim the mapping character
json.trimstart $1 1
noop $json.consumewhitespace($1)
var %any = $json.parseany($1)
var %type = $gettok(%any,1,32)
var %value = $gettok(%any,2-,32)
if (%type == ERROR) {
%error = %value
goto return
}
if (%type == 3) {
; rvalue
hadd %table type. $+ %strPropName 3
if (%value == $true || %value == $false) {
json.debug PasrseObject; Found boolean value for %strPropName : %value
hadd %table value. $+ %strPropName %value
}
elseif (!$bvar(%value,0)) {
hadd %table value. $+ %strPropName $null
}
else {
hadd -b %table value. $+ %strPropName %value
}
}
else if (%type == 2) {
; Arrays
json.debug Read array %strPropName as %value for object %table
hadd %table type. $+ %strPropName 2
; Add array hashtable
hadd %table value. $+ %strPropName %value
echo -atg hadd %table value. $+ %strPropName %value
echo -atg $hget(%table,value. $+ %strPropName)
}
else if (%type == 1) {
hadd %table type. $+ %strPropName 1
; Add object naem to table
hadd %table value. $+ %strPropName %value
}
}
; Check to see if there are more properties
noop $json.consumewhitespace($1)
if ($bvar($1,1) == $json.chars().OBJECT_END) { json.debug Successful object parsing. | json.trimstart $1 1 | goto return }
elseif ($bvar($1,1) == $json.chars().DELIMITER) { json.trimstart $1 1 | goto property }
else { return $json.errors().UNEXPECTED_CHAR }
:return
if (%error) {
json.freeall %table
return %error
}
return %table
}
; $json.parsestring(&binvar) - returns string (binvar) or error code
alias -l json.parsestring {
var %bv = $json.createbvar
if ($bvar($1,1) != $json.chars().STRING_START) { return $json.errors().EXPECTED_START }
json.trimstart $1 1
var %escape = 0
:loop
if ($bvar($1,1) == $json.chars().STRING_ESCAPE) {
if (%escape) {
; If the escape character is escaped, append it
dec %escape
goto append
}
else {
inc %escape
; Skip appending
goto trim
}
}
if (%escape) {
if ($bvar($1,1) == $asc(r)) { bset $1 1 $cr | dec %escape }
if ($bvar($1,1) == $asc(n)) { bset $1 1 $lf | dec %escape }
if ($bvar($1,1) == $asc(t)) { bset $1 1 9 | dec %escape }
if ($bvar($1,1) == $asc(b)) { bset $1 1 8 | dec %escape }
}
:append
; Add this character to the end
bset %bv $calc($bvar(%bv,0) +1) $bvar($1,1)
:trim
; Trim from the start
json.trimstart $1 1
; If we're at the end of a string and not escaped, bail out
if ($bvar($1,1) == $json.chars().STRING_END && !%escape) {
json.trimstart $1 1
return %bv
}
; Make sure we haven't consumed all the input
if ($bvar($1,0)) {
goto loop
}
return %bv
}
; $json.parseint(&binvar) - returns an int or error code
alias -l json.parseint {
var %bv = &json.createbvar
; Lax on the number format since its a string for us anyway
while ($bvar($1,1).text isnum || $bvar($1,1) == $asc(.) || $bvar($1,1) == $asc(-) || $bvar($1,1) == $asc(+) || $bvar($1,1) == $asc(e)) {
bset %bv $calc($bvar(%bv,0) +1) $bvar($1,1)
json.trimstart $1 1
}
return %bv
}
$json.parsearray - returns array tables (data, types) or error code
alias -l json.parsearray {
if ($bvar($1,1) != $json.chars().ARRAY_START) {
return $json.errors().EXPECTED_START
}
json.trimstart $1 1
; Create a linked list for the data
var %datatable = $json.createtable(1)
; Create a linked list for the types (associative with respect to the data list)
var %typetable = $json.createtable(1)
:member
noop $json.consumewhitespace($1)
; Parse members
var %any = $json.parseany($1)
var %type = $gettok(%any,1,32)
var %value = $gettok(%any,2-,32)
if (%type == ERROR) {
json.debug Error parsing array member: %value
json.freeall 2 %datatable %typetable
return %value
}
else {
; 0 indexed
var %newindex = $calc($hget(%datatable,0).item)
; Binary data
json.debug Add type %type array index %newindex as %value
if (%type == 3) {
hadd -b %datatable %newindex %value
}
else {
hadd %datatable %newindex %value
}
hadd %typetable %newindex %type
}
noop $json.consumewhitespace($1)
if ($bvar($1,1) == $json.chars().DELIMITER) {
json.trimstart $1 1
goto member
}
elseif ($bvar($1,1) == $json.chars().ARRAY_END) {
json.debug Parsed array successfully
json.trimstart $1 1
return %datatable %typetable
}
json.freeall 2 %datatable %typetable
return $json.errors().UNKNOWN
}
; $json.consumewhitespace(&binvar) - returns number consumed
alias -l json.consumewhitespace {
while ($bvar($1,0) && ($bvar($1,1) == 32 || $bvar($1,1) == 9 || $bvar($1,1) == 160 || $bvar($1,1) == 10 || $bvar($1,1) == 13)) {
json.trimstart $1 1
}
}
; /json.trimstart &binvar length - trims length characters from the start of $binvar
alias -l json.trimstart {
; json.debug Trimstart: $1 $2 -- Size of bvar: $bvar($1,0)
if ($bvar($1,0) == 1) { bunset $1 }
else { bcopy -c $1 1 $1 $calc($2 +1) -1 }
}
; $json.getpropery(table, property).type - Returns number representing type of property
; $json.getproperty(table, property).value - Returns value of property
; $json.getproperty(table, property).bvar - Returns value of property as bvar
; $json.getproperty(table, property).arraytypetable - If property is array, returns its type table
; $json.getproperty(table, property).arraydatatable - If property is table,r eturns its data table
alias -l json.getproperty {
var %type = $hget($1,type. $+ $2)
var %value = $hget($1,value. $+ $2)
if ($prop == type) { return %type }
if ($prop == bvar) { noop $hget($1, value. $+ $2, &bvReturn) | return &bvReturn }
if ($prop == arraytypetable) { return $gettok(%value,2,32) }
if ($prop == arraydatatable) { return $gettok(%value,1,32) }
return %value
}
; $json.createtable - Creates a hashtable and returns its name
; $json.createtable(N) - gives it size N
alias -l json.createtable {
var %ticks = $ticks
var %rand = $rand(1,4294967295)
var %table = $+(json.,%ticks,.,%rand)
hmake %table $iif($1,$1,10)
return %table
}
; Creates a random binvar name to avoid collisions
alias -l json.createbvar {
var %ticks = $ticks
var %rand = $rand(1,4294967295)
var %bv = $+(&jsonbv.,%ticks,.,%rand)
return %bv
}
alias -l json.chars {
; {
if ($prop == OBJECT_START) { return 123 }
; }
if ($prop == OBJECT_END) { return 125 }
; "
if ($prop == STRING_START || $prop == STRING_END) { return 34 }
if ($prop == STRING_ESCAPE) { return $asc(\) }
if ($prop == ARRAY_START) { return $asc([) }
if ($prop == ARRAY_END) { return $asc(]) }
; ,
if ($prop == DELIMITER) { return 44 }
if ($prop == MAPPING) { return $asc(:) }
}
alias -l json.errors {
if ($prop == EXPECTED_START) { return 1 }
if ($prop == EXPECTED_END) { return 2 }
if ($prop == EXPECTED_DELIMITER) { return 3 }
if ($prop == EXPECTED_MAPPING) { return 4 }
if ($prop == UNEXPECTED_CHAR) { return 5 }
return 255
}
alias -l json.debug {
; echo -atg Debug: $1-
}

{{Author|aca20031}}

[[Category:Script Archive]]

MHTTP

2014-11-11T01:44:15Z

Aca20031: Created page with "Often times you may want to download a web page from the internet using HTTP, but HTTP can be complicated. This script handles most of the basics for you including * URL Pars..."

Often times you may want to download a web page from the internet using HTTP, but HTTP can be complicated. This script handles most of the basics for you including
* URL Parsing
* SSL
* Cookies
* Sending POST data
* Following redirects
* Handling CHUNKED encoding

Typical usage simply involves using the /http.open, save and close commands to download a file, and creating a signal event to do something with it once it is done.
== Example ==
alias DownloadGooglesLogo {
http.open google https://www.google.com/images/srpr/logo11w.png
http.save -f google logo.png
}
on *:SIGNAL:http: {
if ($1 == google) {
if ($2 == SAVED) { run $3- }
if ($2 == PROGRESS) { echo -atg Download progress: $bytes($3).suf $+ / $+ $bytes($4).suf downloaded }
}
}

== Script ==
; Ben's (ben@st0rm.net) HTTP for mIRC script (mHTTP)
; Used to download over HTTP
; Basic usage
; /http.open [name] <URL>
; Opens an HTTP handle for the given URL
; /http.save [-f] <name> <file>
; Downloads the HTTP resource to the given file
; -f forces the file to be overwritten
; /http.close <name>
; Closes and HTTP handle for the given URL
;
; Here are some things you can do after opening a handle, but before saving/downloading it as a file
; Manage POST data:
; /http.addpost <handle> <variable> <value>
; /http.delpost <handle> <variable>
; Manage cookies
; /http.addcookie <handle> <value>
; $http.cookie(handle,N) - gets Nth cookie
;
; After a request completes (e.g. after a save) you can get some data:
; $http.responseheader(handle, header, N) - Returns value of given responseheader, or $false. Only useful after a request is made
;
; Signals
; In order to tell via script when something happens (your file is being saved, for example) use
; on *:SIGNAL:http:
; where $1 = Handle name, $2 = Event name, $3- = parameters
; Events:
; COMPLETED <statuscode> - when a request completes
; SAVED <location> - when a save completes
; REDIRECT <location> - when a request is redirected elsewhere
; PROGRESS <bytes> [total size] - When part but not all of the data is downloaded. Total size is not available for chunked transfer
;
;
; Known issues:
; Cookies do not respect attributes such as domain, path, expiration, or secure. They area always sent
; Relative redirects don't work, only absolute
; Redirects from insecure to secure links when you don't have SSL will not be handled well
; Creates a request that when completed is saved to a file
alias http.save {
if ($1 == -f) {
var %force = $true
tokenize 32 $2-
}
else { var %force = $false }
if ($0 < 2) {
echo -atg * /http.save: Use /http.save <http handle> <file>
return
}
var %hashtable = http. $+ $1
if (!$hget(%hashtable)) {
echo -atg * /http.save: No such HTTP handle exists. Use /http.open first
return
}
if ($sock(%hashtable)) {
echo -atg * /http.save: There is a pending request for this HTTP handle already. A connection is open the the remote host. Close it, or wait for it to complete
return
}
var %file = $2-
if ($exists(%file)) {
if (%force) {
.remove %file
}
else {
echo -atg * /http.save: File already exists. Try /http.save -f to force an overwrite
return
}
}
; Open file handler stream for writing
.fopen -n %hashtable %file
if ($ferr) {
echo -atg * /http.save: Could not use file. Error: $ferr
return
}
; Store fstream name in hashtable to indicate that we want to save this once it completes
.hadd %hashtable fstream %hashtable
; Set redirect counter to 0
.hadd %hashtable redirects 0
; Start socket
http.sockstart %hashtable
}
; Opens socket
alias -l http.sockstart {
if ($hget($1,secure) == $true) {
if ($sock($1) && $sock($1).ssl) {
http.sendrequest $1
}
else {
if ($sock($1)) { .sockclose $1 }
if (!$sslready) {
echo -atg HTTP Error - request $qt($right($1,-5)) would require you to use SSL but you are not SSL ready. Please see http://mirc.com/ssl.html
http.close $right($1,-5)
return
}
sockopen -e $1 $hget($1, host) $hget($1, port)
}
}
else {
if ($sock($1)) {
http.sendrequest $1
}
else {
sockopen $1 $hget($1, host) $hget($1, port)
}
}
}
; Sends the request. Assumes the socket is open and ready
alias -l http.sendrequest {
if (!$sock($1)) { echo -atg HTTP Internal error. Socket not open in /http.sendrequest | return }
var %inname = $1
var %exname = $right($1,-5)
; Cleanup from previous requests
.hdel %inname responseheaders
.hdel %inname body
.hdel %inname contentlength
.hdel %inname chunkleft
; Get POST binvar
var %postBV = $http.postdata(%inname)
; Use GET if there's no post data, POST otherwise
if ($bvar(%postBV,0) == 0) {
sockwrite -n %inname GET $hget(%inname,path) HTTP/1.1
}
else {
sockwrite -n %inname POST $hget(%inname,path) HTTP/1.1
}
; Send the host
sockwrite -n %inname Host: $hget(%inname,host)
; Send the user-agent
sockwrite -n %inname User-agent: $hget(%inname,user-agent)
sockwrite -n %inname Connection: Keep-Alive
; Only plain-text supported
sockwrite -n %inname Accept: text/plain; q=0.5, text/html
; Send cookies
if ($http.cookie(%exname, 0) > 0) {
sockwrite %inname Cookie: $+ $chr(32)
var %i = 1
while ($http.cookie(%exname, %i)) {
sockwrite %inname $http.urlencode($ifmatch) $+ ;
inc %i
}
sockwrite -n %inname
}
; If POST send content type and length
if ($bvar(%postBV,0) > 0) {
sockwrite -n %inname Content-Type: application/x-www-form-urlencoded
sockwrite -n %inname Content-Length: $v1
}
; End request headers with empty line
sockwrite -n %inname
; If POST, send data
if ($bvar(%postBV,0) > 0) {
sockwrite %inname %postBV
; sockwrite -n %inname
}
}
; Just some bookeeping in case we miss it
on *:SOCKCLOSE:http.*: {
if ($fopen($sockname)) { .fclose $sockname }
}
on *:SOCKOPEN:http.*: {
http.sendrequest $sockname
}
on *:SOCKREAD:http.*: {
if ($sockerr > 0) {
echo -atg * HTTP handle $qt($right($sockname,-5)) failed with socket error $sockerr
http.close $right($sockname,-5)
return
}
;Read all the data into &bvTemp
:read
; First, read this buffer
sockread &bvThis
if ($sockbr > 0) {
; If data was read, copy it to the on-going buffer and continue
bcopy &bvTemp $calc($bvar(&bvTemp,0) +1) &bvThis 1 -1
goto read
}
if ($bvar(&bvTemp,0) == 0) { echo -atg HTTP sockread called with no data to read... | return }
; Do we need to parse headers?
; If response headers not set, this call has the headers
if (!$hget($sockname,responseheaders)) {
; Find the response headers
var %end = $bfind(&bvTemp,1, 13 10 13 10)
if (%end == 0) { echo -atg Error: No headers found, but no content length so this can't be a subsequent call | return }
; Increase to include the 3 extra characters
inc %end 3
bcopy &bvResponseHeaders 1 &bvTemp 1 %end
; If there's still non-header data copy it over
if (%end < $bvar(&bvTemp, 0)) {
bcopy -c &bvTemp 1 &bvTemp $calc(%end + 1) -1
}
else { bunset &bvTemp }
; If this is the first header response, save in hash table
if (!$hget($sockname, responseheaders)) {
.hadd -b $sockname responseheaders &bvResponseHeaders
http.OnHeaders $sockname
}
}
; there's no more to read, bail
if (!$bvar(&bvTemp,0)) {
; If that's all this response has to offer, we're done
if ($hget($sockname,contentlength) == 0) {
http.ondone $sockname
}
return
}
; Read body
var %contentlength = $hget($sockname,contentlength)
if (%contentlength == $null || %contentlength == $false) {
var %chunked = $true
}
else {
var %chunked = $false
}
; Set bvBody to the body ready so far
if ($hget($sockname,body)) {
noop $hget($sockname, body, &bvBody)
}
if (%chunked) {
:readChunk
var %chunkleft = $hget($sockname, chunkleft)
if (!%chunkleft) {
; If we've read all of a chunk, or this is the first one, get its size
var %crlf = $bfind(&bvTemp, 1, 13 10)
if (!%crlf) {
echo -atg HTTP internal error. Handle $qt($right($sockname,-5)) is in chunked encoding but no chunk size found in data
return
}
var %chunkleft = $base($bvar(&bvTemp, 1, $calc(%crlf - 1)).text,16,10)
if (%chunkleft !isnum) {
echo -atg HTTP internal error. Handle $qt($right($sockname,-5)) has invalid chunk size: %chunkleft
}
; New chunk
else {
; Save chunk size and remove it (plus its \r\n) from temp
.hadd $sockname chunkleft %chunkleft
.bcopy -c &bvTemp 1 &bvTemp $calc(%crlf +2) -1
if (%chunkLeft == 0) {
; if we just read chunk size 0, that was the end.
.hadd -b $sockname body &bvBody
http.onDone $sockname
return
}
}
}
; read %chunkleft bytes
var %bytesToRead = $iif(%chunkLeft < $bvar(&bvTemp,0),%chunkLeft, $bvar(&bvTemp,0))
.bcopy &bvBody $calc($bvar(&bvBody,0) +1) &bvTemp 1 %bytesToRead
hdec $sockname chunkleft %bytesToRead
.signal http $right($sockname,-5) PROGRESS %bytesToRead
if (%bytesToRead == %chunkLeft) {
; If this is the end of the chunk, consume crlf
inc %bytesToRead 2
; If there's still stuff in this var, go back and read the new chunk
if (%bytesToRead < $bvar(&bvTemp,0)) {
.bcopy -c &bvTemp 1 &bvTemp $calc(%bytesToRead + 1) -1
goto readChunk
}
}
; End of this call, save body in hashtable for future calls
.hadd -b $sockname body &bvBody
}
else {
; Copy everything
.bcopy &bvBody $calc($bvar(&bvBody,0) +1) &bvTemp 1 -1
; Add read-so-far body to hashtable
.hadd -b $sockname body &bvBody
.signal http $right($sockname,-5) PROGRESS $bvar(&bvBody,0) $hget($sockname,contentlength)
; Check if we're done
if ($bvar(&bvBody,0) >= $hget($sockname,contentlength)) {
; We're done
http.onDone $sockname
if ($bvar(&bvBody,0) > $hget($sockname,contentlength)) {
echo -qatg HTTP Warning: Read past content-length.
}
}
}
}
; Internal event called when we get the first header response from the server
alias -l http.OnHeaders {
noop $hget($1,responseheaders, &bvResponseHeaders)
; First header is always the status response
var %end = $bfind(&bvResponseHeaders, 1, 13 10)
if (%end <= 1) {
echo -atg Error: HTTP $qt($right($1,-5)) Server did not respond with HTTP status
goto cleanup
}
var %status = $bvar(&bvResponseHeaders,1,$calc(%end - 1)).text
.hadd $1 responsestatus %status
var %version = $gettok(%status,1,32)
if (%version != HTTP/1.1 && %version != HTTP/1.0) {
echo -atg Error: HTTP $qt($right($1,-5)) Server indicated unknown version: %version
goto cleanup
}
var %statuscode = $gettok(%status,2,32)
if (%statuscode !isnum) {
echo -atg Error: HTTP $qt($right($1,-5)) Server indicated invalid status code: %statuscode
goto cleanup
}
; Check transfer type
if ($http.responseheader($right($1,-5),Content-Length,1) != $null) {
hadd $1 contentlength $v1
}
elseif ($http.responseheader($right($1,-5), Transfer-Encoding, 1) != chunked) {
echo -atg HTTP Handle $qt($right($1,-5)) has no content-length header and is not chunked
echo -atg $bvar(&bvResponseHeaders,1-).text
return
}
; Add any cookies that were set
var %cookie = 1
while ($http.responseheader($right($1,-5), Set-Cookie, %cookie)) {
inc %cookie
var %cookieValue = $gettok($ifmatch,1,$asc(;))
http.addcookie $right($1,-5) %cookieValue
}
; Handle redirects
if (%statuscode == 303 || %statuscode == 302 || %statuscode == 307) {
var %location = $http.responseheader($right($1,-5), Location)
.signal http $right($1,-5) REDIRECT %location
http.seturl $1 %location
hinc $1 redirects
; If the server doesn't promise us this connection is keep-alive, close it and use a new one
if ($http.responseheader($right($1,-5), Connection, 1) != Keep-Alive) {
if ($sock($1)) { .sockclose $1 }
}
if ($hget($1, redirects) > 5) {
echo -atg HTTP Handle $qt($right($1,-5)) redirect loop detected
return
}
http.sockstart $1
}
return
:cleanup
if ($sock($1)) { .sockclose $1 }
}
alias http.addcookie {
var %hashtable = http. $+ $1
if (!$hget(%hashtable)) {
echo -atg * /http.addcookie: No such HTTP handle
return
}
if ($0 < 2) {
echo -atg * /http.addcookie: Usage: /http.addcookie <handle> <value>
return
}
var %i = 1
var %cookieNum = 1
while ($hget(%hashtable,%i).item) {
var %item = $ifmatch
inc %i
if (cookie-* iswm %item) {
var %tmp = $gettok(%item,2,$asc(-))
; If the value is the same, overwrite
if ($2- == $hget(%hashtable,%item)) {
%cookieNum = %tmp
break
}
; Otherwise store max cookie num
elseif (%tmp >= %cookieNum) { %cookieNum = $calc(%tmp + 1) }
}
}
.hadd %hashtable cookie- $+ %cookieNum $+ -value $2-
}
; Gets an HTTP cookie for the given handle
; $http.cookie(<handle>, <index>)
alias http.cookie {
if ($2 !isnum) {
echo -atg * $!http.cookie invalid parameters
return
}
var %hashtable = http. $+ $1
if (!$hget(%hashtable)) {
echo -atg * $!http.cookie no such HTTP handle
return
}
var %i = 1
var %found = 0
while ($hget(%hashtable, %i).item) {
inc %i
var %item = $ifmatch
if (cookie-*-value iswm %item) {
inc %found
var %id = $gettok(%item,2,$asc(-))
if (%found == $2) {
return $hget(%hashtable, cookie- $+ %id $+ -value)
}
}
}
if ($2 == 0) { return %found }
}
; Returns the value of the given response header
; Case sensitive since it is binary variable operation
alias http.responseheader {
if ($0 < 2) {
echo -atg Invalid usage. Use: $http.responseheader(<handle>, <header>[, index])
return
}
; %index is parameter 3 - 1-N or 0 for number
var %index = 1
if ($3 isnum) {
%index = $3
}
; Veriy hash table exists
var %table = http. $+ $1
if (!$hget(%table,responseheaders)) { return $false }
noop $hget(%table,responseheaders, &bvResponseHeaders))
; Set up parameters for the header search
; Offset is where we start searching from in the loop
; thisIndex is the number of matches found so far
var %offset = 1
var %thisIndex = 0
; The main search loop
:search
var %start = $bfind(&bvResponseHeaders, %offset, $2 $+ :).text
; If there isn't another match, either the index was too large or they want the count
if (!%start) {
if (%index == 0) { return %thisIndex }
else { return $false }
}
; Find the end of the header
var %end = $bfind(&bvResponseHeaders, %start, 13 10)
if (%end <= %start) { echo -atg HTTP Internal error ($http.responseheader), header $qt($2) for handle $qt($1) has no CRLF termination | return $false }
inc %thisIndex
; If this not the one they asked for, try again starting from the end of this header
if (%index != %thisIndex) {
var %offset = %end
goto search
}
; Find the colon. If there isn't one we'll return the whole string
if ($calc($bfind(&bvResponseHeaders, %start, $asc(:)) +1) < %end) {
%start = $v1
}
return $bvar(&bvResponseHeaders,%start, $calc(%end - %start)).text
}
; Internal event called when a request is filled. $1 = internal handle name
alias -l http.onDone {
if ($hget($1,responseheaders)) {
noop $hget($1,responseheaders,&bvResponseHeaders)
}
; Write out and close filestream if set
if ($hget($1,fstream)) {
noop $hget($1,body,&bvBody)
if (!$bvar(&bvBody,0)) {
.fclose $hget($1,fstream)
}
else {
.fwrite -b $hget($1,fstream) &bvBody
; Save fname so we can use it in the signal after the close
var %fname = $fopen($hget($1,fstream)).fname
.fclose $hget($1,fstream)
.signal http $right($1,-5) SAVED %fname
}
}
; If socket is still around, close it
if ($sock($1)) { .sockclose $1 }
; Reset redirects for future calls
.hadd $1 redirects 0
.signal HTTP $right($1,-5) COMPLETED $hget($1,responsestatus)
}
alias http.open {
var %hashtable
; If two parameters are given, $1 is the name, else create a new name
if ($0 > 1) { %hashtable = http. $+ $1 }
else {
var %h = $calc($ticks % $rand(1,1000000))
var %hashtable = http. $+ %h
}
if ($hget(%hashtable)) {
echo -atg * /http.open: HTTP Request $qt($1) already exists
return
}
; Encode the octects of the URL. e.g.: foo bar,pie --> foo%20bar,%2Cpie
var %url = $iif($0 > 1, $2-, $1-)
var %urlEncoded = $http.urlencode(%url)
; Check the URL
if (!$http.urlparse(%urlEncoded)) {
echo -atg * /http.open: Malformed URL. Use /http.open [name] <url>
return
}
if ($http.urlparse(%urlEncoded).secure && !$sslready) {
echo -atg * /http.open: URL is SSL but $!sslready = false. See http://www.mirc.com/ssl.html
return
}
; Everything checks out, let's store the relevent bits in a hashtable
.hmake %hashtable 10
http.seturl %hashtable %url
echo -qatg * /http.open: Opened HTTP request $qt($right(%hashtable,-5))
}
alias -l http.seturl {
if ($0 < 2) { echo -atg HTTP Internal error, seturl called with no url }
var %hashtable = $1
if (!$hget(%hashtable)) { echo -atg HTTP Internal error, seturl called with invalid handle }
var %urlEncoded = $http.urlencode($2-)
.hadd %hashtable host $http.urlparse(%urlEncoded).host
.hadd %hashtable port $http.urlparse(%urlEncoded).port
.hadd %hashtable secure $http.urlparse(%urlEncoded).secure
.hadd %hashtable path $http.urlparse(%urlEncoded).path
.hadd %hashtable user-agent mIRC $version
}
alias http.list {
var %i = 1
var %numFound = 0
while (%i <= $hget(0)) {
var %table = $hget(%i)
inc %i
if (http.* iswm %table) {
inc %numFound
echo -atg * $right(%table,-5) $+ : Host: $hget(%table,host) Port: $hget(%table,port) Path: $hget(%table,path)
}
}
if (%numFound == 0) { echo -atg * No HTTP handles opened }
}
alias http.close {
var %i = 1
var %numFound = 0
while (%i <= $hget(0)) {
var %table = $hget(%i)
if (http. $+ $1 iswm %table) {
; Cleanup resources
if ($sock(%table)) { .sockclose %table }
if ($fopen(%table)) { .fclose %table }
if ($hget(%table $+ .postdata)) { .hfree %table $+ .postdata }
.hfree %table
inc %numFound
echo -qatg * HTTP Closed $right(%table,-5)
}
; Only inc if we didnt find a match
else {
inc %i
}
}
if (%numFound == 0) { echo -qatg * No matching HTTP handles }
}
;
; Takes an encoded URL and returns based on the property
; .secure - true if https
; .host - the URL host
; .port - the port, 80 by default
; .path - The path to download, / by default
; Returns $false is URL is malformed
;
alias http.urlparse {
var %secure
var %host
var %port
var %path
var %regex = /^(https?://)?([a-z.0-9\-_]+)(:\d+)?(/.*)?$/i
if ($regex($1, %regex)) {
if (http*:// iswm $regml(1)) {
%protocol = $lower($left($regml(1),-3))
}
%secure = $false
if (%protocol == https) {
%secure = $true
}
if (%protocol) { %host = $regml(2) }
else { %host = $regml(1) }
var %portIndex = $iif(%protocol, 3, 2)
var %portfound = $false
if ($left($regml(%portIndex),1) == : && $right($regml(%portIndex),-1) isnum) {
%port = $right($regml(%portIndex),-1)
%portFound = $true
}
else {
if (%secure) {
%port = 443
}
else {
%port = 80
}
}
%pathIndex = $iif(%portFound, $calc(%portIndex + 1), %portIndex)
if ($regml(0) >= %pathIndex) {
%path = $regml(%pathIndex)
}
else { %path = / }
}
else { return $false }
if ($prop == secure) { return %secure }
if ($prop == host) { return %host }
if ($prop == path) { return %path }
if ($prop == port) { return %port }
return $true
}
alias http.addpost {
if ($0 < 3) {
echo -atg * /http.addpost: Usage: /http.addpost <handle> <variable> <value>
return
}
var %maintable = http. $+ $1
var %posttable = %maintable $+ .postdata
if (!$hget(%maintable)) {
echo -atg * /http.addpost: No such HTTP handle found
return
}
if (!$hget(%posttable)) { .hmake %posttable 10 }
hadd %posttable $2 $3-
echo -qatg Post variable added: $2 $+ = $+ $3-
}
alias http.delpost {
if ($0 < 2) {
echo -atg * /http.delpost: Usage: /http.delpost <handle> <variable>
return
}
var %maintable = http. $+ $1
var %posttable = %maintable $+ .postdata
if (!$hget(%maintable)) {
echo -atg * /http.addpost: No such HTTP handle found
return
}
if (!$hget(%posttable,$2)) {
echo -qatg * /http.addpost: No post variable with that name exists
return
}
hdel %posttable $2
echo -qatg Post variable deleted: $2
}
; Usage: $http.postdata(handle)
; Returns a binvar with a post data style query string (x=y&z=a) or $false
alias http.postdata {
; Post data is stored in INNAME.postdata
var %posttable = http. $+ $1 $+ .postdata
if (!$hget(%posttable,0).item) { return $false }
var %i = 1
while ($hget(%posttable,%i).item) {
var %item = $ifmatch
bset -t &bvPost $calc($bvar(&bvPost,0) +1) $iif(%i > 1,&,) $+ $http.urlencode(%item) $+ = $+ $http.urlencode($hget(%posttable,%item))
inc %i
}
return &bvPost
}
; Replace some commonly touchy URL characters with their hex-octect encoding
alias -l http.urlencode {
return $replacex($1-,$chr(32),% $+ 20, $chr(44), % $+ 2C,+, % $+ 2B, $chr(37), % $+ 25)
}

{{Author|aca20031}}

[[Category:Script Archive]]

Editbox

2010-12-03T23:16:08Z

Aca20031: added -c

This command controls the window edit box, and can be used to manipulate the text inside. (An editbox is the place where text is typed in a window, for example where you would type your message)

/editbox [-safnopbNeNvqNc] [window] <text>

Choosing your window
* -s specifies status window
* -a specifies the active window
* you can use [window] to give a specific window name
** If the window is a DCC chat, prefix it with =

* -f sets the focus to the editbox of the specified window
* -p appends a space to the end of the text
* -n will press enter after the text has been entered
* -o specifies the second editbox, if the given window has two
* -bNeN will select text in the edit box, starting at b and ending at e
** To select characters 5-10, /editbox -b5e10 #help.script This text will be highlighted
* -v prevents the content from being changed
* -qN enables, disables, or toggles (on/off) the second edit box.
* -c clears the editbox '''Note: This is undocumented functionality and may be removed in future versions'''

==See Also==
[[$editbox]]

[[Category:Commands]][[Category:Custom Windows]]

Editbox

2010-12-03T23:15:46Z

Aca20031:

This command controls the window edit box, and can be used to manipulate the text inside. (An editbox is the place where text is typed in a window, for example where you would type your message)

/editbox [-safnopbNeNvqN] [window] <text>

Choosing your window
* -s specifies status window
* -a specifies the active window
* you can use [window] to give a specific window name
** If the window is a DCC chat, prefix it with =

* -f sets the focus to the editbox of the specified window
* -p appends a space to the end of the text
* -n will press enter after the text has been entered
* -o specifies the second editbox, if the given window has two
* -bNeN will select text in the edit box, starting at b and ending at e
** To select characters 5-10, /editbox -b5e10 #help.script This text will be highlighted
* -v prevents the content from being changed
* -qN enables, disables, or toggles (on/off) the second edit box.
* -c clears the editbox '''Note: This is undocumented functionality and may be removed in future versions'''

==See Also==
[[$editbox]]

[[Category:Commands]][[Category:Custom Windows]]

If-Then-Else

2010-11-17T23:51:42Z

Aca20031: Link to Basic control tutorial

__NOTOC__
* Note: This is a reference. For a tutorial please see the [[basic control tutorial]].
The If-then-else statement allows you to compare values and execute different parts of a script based on that comparison. This is a basic structure for any script that includes anything more than one-liners!

if (v1 operator v2) { commands1 }
elseif (v1 operator v2) { commands2 }
else { commands3 }

If the first statement (line) is [[$true]], commands inside the first brackets are executed. If the first if-statement returns [[$false]], script starts looking for an elseif-statement. An elseif-statement is only triggered if the group's if-statement returned $false before. And at last, if none of the if or elseif statements were triggered, commands in else-statement are executed.

One if structure/group can consist of one main if-statement, after it there can be 0 .. N elseif-statements. There can be only one else, which can be understood as the default statement, if none one before were triggered. There doesn't need to be else-statement though.

Every if statement is handled separatly and none of others affect in another.

if (A) { ... }
elseif (B) {
if (C) { ... }
elseif (D) { ... }
elseif (E) { ... }
else { F }
}
elseif (G) { ... }
else { H }

If structure would be hierarchical represented it would look something like this

A If A is true, execute its commands and skip the rest
B If B is true,
\
C check if C, D or E returns true
D
E
F If none of these got triggered, return F
G If A and B were false and G is true, execute this
H If A, B and G were all false, execute H

== The Operators ==

[[#==|==]] equal to
[[#==|===]] equal to (case-sensitive)
[[#<|<]] less than
[[#>|>]] larger than
[[#<=|<=]] less than or equal to
[[#>=|>=]] larger than or equal to
[[#//|//]] v2 is a multiple of v1
[[#\\|\\]] v2 is not a multiple of v1
[[#&|&]] bitwise comparison
[[#!=|!]] negation operator (!= is opposite of == and !isin is "is not in")

[[#isin|isin]] string v1 is in string v2
[[#isin|isincs]] string v1 is in string v2 (case sensitive)
[[#iswm|iswm]] wildcard string v1 matches string v2
[[#iswm|iswmcs]] wildcard string v1 matches string v2 (case sensitive)
[[#isnum|isnum]] number v1 is a number in the range v2 which is in the form n1-n2 (v2 optional)
[[#isletter|isletter]] letter v1 is a letter in the list of letters in v2 (v2 optional)

[[#isalnum|isalnum]] text contains only letters and numbers
[[#isalpha|isalpha]] text contains only letters
[[#islower|islower]] text contains only lower case letters
[[#isupper|isupper]] text contains only upper case letters

[[#ison|ison]] if v1 is on channel v2
[[#isop|isop]] if v1 is an op on channel v2
[[#ishop|ishop]] if v1 is a halfop on channel v2
[[#isvoice|isvoice]] if v1 has a voice on channel v2
[[#isreg|isreg]] if v1 is a normal nick on channel v2
[[#ischan|ischan]] if v1 is a channel which you are on.
[[#isban|isban]] if v1 is a banned address in the internal ban list for channel v2

[[#isaop|isaop]] if v1 is a user in your auto-op list for channel v2 (v2 optional)
[[#isavoice|isavoice]] if v1 is a user in your auto-voice list for channel v2 (v2 optional)
[[#isignore|isignore]] if v1 is a user in your ignore list with the ignore switch v2 (v2 optional)
[[#isprotect|isprotect]] if v1 is a user in your protect list for channel v2 (v2 optional)
[[#isnotify|isnotify]] if v1 is a user in your notify list.

''Note:'' To negate an operator you can prefix it with an exclamation mark (!).

=== == ===
if (cat == cAt) ;Returns true since == is case-insensitive.
if (cat === cAt) ;Returns false since === is case-sensitive.
The above checks that v1 (cat) matches v2 (cAt).

=== != ===
This isn't actually an operator, but a combination of two operators ! and =. And actually, = isn't an operator either, but in mIRC scripting it can be used instead of == and it works just the way == works. In most mIRC scripts you only see !=, which actually shouldn't be used. Instead, !== should be used to negate ==.

if (cat != cAt) ;Returns false since != is case-insensitive and both values v1 and v2 are equal.
if (cat !== caT) ;Returns false since !== is the same as !=
if (cat !=== cAt) ;Returns true since !=== is case-sensitive and both values v1 and v2 are not equal when case is taken in to consideration.
if (!$away) ;Returns $true if you are NOT away ($away returns $false and ! negates it to $true).

=== < ===
if (6 < 9) ;Returns true because the numerical value 6 is less than 9.
Checks that v1 (6) has a lower numerical value than v2 (9)

=== > ===
if (6 > 9) ;Returns false because the numerical value 6 is not greater than 9.
Checks that v1 (6) has a higher numerical value than v2 (9)

=== <= ===
if (6 <= 9) ;Returns true because the numerical value 6 is less than or equal to 9.
Checks that v1 (6) has a lower or equal numerical value than v2 (9).

=== >= ===
if (6 >= 9) ;Returns false because the numerical value 6 is not greater than or equal to 9.
Checks that v1 (6) has a greater or equal numerical value than v2 (9).

=== // ===
if (3 // 9) ;Returns true because 3 is a multiple of 9.
Multiples of 9 are numbers that when devided in to 9 result in an integer.
You are not limited to positive numbers.

=== \\ ===
if (3 \\ 9) ;Returns false because 3 is a multiple of 9.
\\ is the negate of //

=== & ===
if (N1 & N2) ; This will compare the bits that are [[$biton|turned on]] in the decimal N1 AND N2 in the same way [[$and]]() would.
As long as N1 and N2 share atleast 1 bit the condition is returned as true.

if (13 & 11) ;Is true, see the table below for explanation.
echo -ag $and(13,11) ;returns 9.

If you break down 13 and 11 into their bits as below:
{|class="gallery"
|-
| style="width:100px" | '''''Binary''''' || '''''Value'''''
|-
| 1101 || 13
|-
| 1011 || 11
|-
| style="border:1px dotted #2f6fab; color: Black;" | 1001 || style="border:1px dotted #2f6fab; color: Black;" | 9
|}
if (11 & 4) ;Is false.
echo -ag $and(11,4) ;returns 0.
{|class="gallery"
|-
| style="width:100px" | '''''Binary''''' || '''''Value'''''
|-
| 1011 || 11
|-
| 0100 || 4
|-
| style="border:1px dotted #2f6fab; color: Black;" | 0000 || style="border:1px dotted #2f6fab; color: Black;" | 0
|}
Above you can see, 13 and 11 both have the first bit AND fourth bit on, so the statement is true. The binary 1001 value has a decimal value of 9.
Also you can see, 11 and 4 do not share any common bits, so the statement is false.

=== isin ===
if (cat isin [[$1-]])
Matches for "a ''cat''", "''cat''alog", "impli''cat''e " and any string where "cat" '''is in'''.

=== iswm ===
iswm stands for ''is wildcard match''.

Operators:
* 0 or more characters
? 1 character
& 1 word (atleast 1 or more non-space characters)

if (home*away*lost iswm $1-)
This would match anything starting with home and ending in lost, with away being between home and lost.
It would match, "homeawaylost", "home away lost", "home is missed when you are away or lost", etc.

if (ca?* iswm $1-)
Requires one character after "ca" and allows 0 or more character after it. So it would match for cat, cab, cabin etc.

if ([[$(...)|$(]]I & you) iswm $1-)
Matches any string that consists of "I + one word + you".
Examples would be, "I love you", "I hate you", "I moo you", it would not however match, "I don't love you" since "don't love" contains a space. Note the $( ), it is needed to prevent mirc treat this statement as bitwise comparison.

=== isnum ===

if ($1 isnum) ;Returns true if $1 is of numeric value
if ($1 isnum 10-) ;Returns true if $1 is number higher than or equal to 10
if ($1 isnum 20-30) ;Returns true if $1 is a number between 20 and 30 inclusive

The examples above checks $1, to see;

Is it a number?<br />
Is it a number above 10?<br />
Is it a number between 20 and 30?

=== isletter ===

if ($1 isletter) ;Returns true if ''$1'' is a letter, any letter
if ($1 isletter abcdefg) ;Returns true if ''$1'' is in the string of letters ''abcdefg''
if ($1 isletter HelloWorld) ;Returns true if ''$1'' is in the string of letters ''HeloWrd''

* Note that the checking is case-sensitive, the letter ''h'' will not return true if checked against the string ''HelloWorld''.

=== isalnum ===
if (Dana34 isalnum) ;returns true as ''Dana34'' contains letters and numbers only
if (Dana_ isalnum) ;returns false as ''_'' is neither letter nor number

Matches whether the string consists of letters and numbers only.

=== isalpha ===
if (Dana isalpha) ; returns true as ''Dana'' consists of letters only
if (foo42 isalpha) ; returns false as ''42'' is no letter

Isalpha checks whether the word consists of letters only. It doesn't matter whether there are upper or lower case.

=== islower ===
if (moo islower) ; returns true as all letters in ''moo'' are lower case.
if (m0o islower) ; returns true as well as all letters in ''m0o'' are lower case.
if (mooO islower) ; retursn false as there is an upper ''O'' in ''mooO''.
'''Note''' that islower checks whether all letters in the string are lower case. There can still be numbers or other characters in the string $1.

=== isupper ===
if (MOO isupper) ; returns true as ''MOO'' consists of upper case letters only
if (1234 isupper) ; returns true as all letters in ''1234'' are upper case, as there are none.
'''Note''' that it checks whether all letters in $1 are upper case. There can still be numbers or other characters in $1.

=== ison ===
if (Dana ison #help.script) ; returns true as ''Dana'' is in the channel #help.script
if (foo !ison #help.script) ; returns true as ''foo'' is not in #help.script

This checks whether $1 is in the channel $2. Note that you need to be in the same channel to use this.

=== isop ===
if (Dana isop #help.script) ; returns true as ''Dana'' is an operator in #help.script
if (foo isop #help.script) ; returns false as ''foo'' is no operator in #help.script

Checks whether $1 is an operator in $2. Note that you need to be in the same channel to use this.

=== ishop ===
if (moo ishop #mIRC) ; returns true if ''moo'' is an half operator in #mIRC
'''Note''' that QuakeNet does not support halfops. Note also that you need to be in the same channel to use this.

=== isvoice ===
if (Dana isvoice #help.script) ; returns true as ''Dana'' has voice in #help.script.
if (foobar isvoice #help.script) ; returns false as ''foobar'' has no voice in #help.script.
This checks if $1 has voice in $2 or not. Note that you need to be in the same channel to use this.

=== isreg ===
if (Dana isreg #help.script) ; returns false as Dana is no regular user in #help.script.
if (foobar isreg #help.script) ; returns true as foobar is a regular user in #help.script.
This checks whether $1 is a regular user (no voice, no half operator, no operator) in $2. Note that you need to be in the same channel to use this.

=== ischan ===
if (#help.script ischan) ; returns true as you are in #help.script.
if (#foobar ischan) ; returns false as you are no in #foobar.
'''Note''' that it returns true only if you are in this channel.

=== isban ===
if (idiot!*@* isban #mychan) ; returns $true if ''idiot!*@*'' is in your [[:Category:IBL|Internal Ban List]] for the channel #mychan.
if ($ial($me) isban $chan) ; returns $true if you are banned on the current channel.
'''Note''' that isban performs two different checks, depending on whether v1 contains wildcards or not:
* if v1 contains wildcards, isban will return $true if v1 is an exact ban in the IBL;
* if v1 does not contain wildcards, isban will return $true if one or more bans match that address.

=== isaop ===
if (foobar isaop) ; returns true if ''foobar'' is in your autoop list for any channel.
if (foobar isaop #help.script) ; returns true if ''foobar'' is in your autoop list for #help.script.
To put someone in your autoop-list, take a look at [[Aop|/aop]].

=== isavoice ===
if (foobar isavoice) ; returns true if ''foobar'' is in your autovoicelist for any channel.
if (foobar isavoice #help.script) ; returns true if ''foobar'' is your autovoicelist for #help.script.
To put someone in your autovoicelist, take a look at [[Avoice|/avoice]].

=== isignore ===
if (foobar isignore) ; returns true if ''foobar'' is in your ignore list.
if (foobar isignore c) ; returns true if ''foobar'' is in your ignore list with switch -c.
To get a more in detail explanation of these switches, take a look at [[Ignore|/ignore]].

=== isprotect ===
if (foobar isprotect) ; returns true if ''foobar'' is in your protect list.
if (foobar isprotect #help.script) ; returns true if ''foobar'' is in your protect list for #help.script.
To get more information about protection, see [[Protect|/protect]].

=== isnotify ===
if (Dana isnotify) ; returns true if Dana is in your notify list.
Take a look at [[Notify|/notify]] to add someone to your notifylist. If someone in your notifylist connects (disconnects), the [[On_notify|On notify event]] ([[On_unotify|On Unotify event]]) is triggered.

== Combining comparisons ==

You can combine comparisons by using the && for AND and || for OR characters.

[[var]] %c = 5
if (%c < 6) && (%c > 0) ; returns true because %c is both, smaller than 6 and greater than 0
if (%c < 6) || (%c isalpha) ; returns true because %c is lower than 6.
; note that %c is not alphapetical and returns false, but || matches for 1 .. N true values.
if (%c < 6) && (%c isalpha) ; returns false
if (%c < 6) && (%c !isalpha) ; ! negates the operator, this this returns true

== Notes ==
====''Not all comparations need two parameters''====
if ($1- isupper)
Returns true if $1- contains only uppercase letters. So ABCD returns true, but even one lowercase letter makes it return false.

====''Use parenthesis correctly''====
(A) || (B) && (C) <- logical order for this is to check if either one of A or B is true, and C is true, but if you wish to check that B and C must be true, or A is true, you'll need to do (A) || ((B) && (C))

====''This article covers only if-then-else '''string''' operators''====
You '''can't''' use
if (foo isin test.txt)
To check the content of a text file, use [[$read]] to search through a file via its search switches.

== See Also ==
* [[$v1]] & [[$v1|$v2]] - These identifiers allow you to retrieve the values of the last if condition.
* [[Basic control tutorial]] - An in depth tutorial on how to use these statements

[[Category:Commands]]

Basic control tutorial

2010-11-17T23:50:12Z

Aca20031: 'Final' first draft

Control statements are, very simply, statements which control which parts of your code gets executed. You should know much about [[aliases]] and [[:Category: Events|events]] (Particularly the [[on text]] event) before reading this.

==Boolean==
A 'boolean' statement is a statement that can have one of two values, "true" or "false".
For example:
I have a donkey.
This is a boolean statement because it is either true, or false. Control structures operate under this pretense, "If something is true, do thing1, otherwise do thing2"

For example:
Let a = "It is raining"

This is clearly a boolean statement, it is either 'true' or 'false'. An example of some program may be
; Here the letter 'a' means "it is raining", like we said up above
if (a) { put on poncho }
else { take off poncho }

This can be read as
if (it is raining) { put on poncho }
else { take off poncho }

==If Statements==
In programming, and particularly mIRC scripts, we use if statements like the example above for our control management.<br />
They follow the format if (condition) { commands } <br />
For example, consider the following alias:

alias ifexample {
echo -atg Let's see...
if ($true) { echo -atg Yep. This is true. }
echo -atg See?
}
In this example, $true is the 'condition' and the 'command' is "echo -atg Yep. This is true." <br />
If you put this [[alias]] in the remote section of mIRC and type /ifexample in the command line, it will echo to you "Yep. This is true". <br />
Now try changing [[$true]] to [[$false]] and notice that it will not say this is true. <br />
Also notice that no matter what is inside the if statement, you will see "Let's see..." and "See?". These things are completely separate from the control statement and will not depend on the value of the stuff in parenthesis.<br/>
<br />
Well this is all well and good, but how does this help us do anything? The simple answer is [[If-then-else|operators]]. Operators are special words you put inside control statements which will tell you if something is true or false. <br />
What if you don't know if it's raining, but you still want to put a poncho on if it is? You may wish to have
Let a = Is it raining?
if (a) { put on poncho }
<br /> <br />
Let's make an alias that tells us what to do under different weather conditions named "weather." We will make it so that we can type /weather rain, and it will tell us to put a poncho on. Remember that if you do this, [[$1]] will be "rain". <br />
To do this we will need to learn the "==" operator. There are two equals here and you MUST use them both. This checks to see if two things are equal. For example:
a == b // This is $false
a == a // This is $true
So in our weather alias we will need to check to see if $1 is equal to "rain", and if it is, we echo "Put on a poncho."

alias weather {
if ($1 == rain) { echo -atg Put on a poncho. }
}

We use some special terms to refer to the condition, condition = v1 operator v2. In this example, v1 is $1, and v2 is weather. operator is ==. This is how the [[If-then-else|operator list]] is formatted so you will need to know this. We can also use special operators [[$v1]] and [[$v2]] to return what was in those positions. For example we could do this:
alias weather {
if ($1 == rain) { echo -atg Due to $v1, you should put on a poncho. }
}
And it would tell us "Due to rain, you should..." because $v1 is $1 which is "rain"

Some operators do not have a v2, for example "isupper" is $true if v1 is all upper case, and $false if it is not. For this you only need the text to check, v1.
on *:TEXT:*:#: {
if ($1- isupper) { msg [[$chan]] STOP YELLING AT ME... }
if ($1- islower) { msg $chan Speak up.... }
}

This is an example of an event, and of using two control statements.

===Negation===
One more thing about operators. <br />
Now we know how to check if text is all upper case, and if something equals something, but what if we want to check the opposite? What if we want to know if all the text is NOT upper case, or if something does NOT equal something. For this, we use the 'negation' or 'not' operator !. <br />
The negative version of isupper is !isupper
on *:TEXT:*:#YellHouse: {
if ($1- !isupper) { msg $chan YOU HAVE TO YELL IN #YELLHOUSE!!! }
}
This detects if $1- is NOT all upper case. This is the same for most operators (!islower, !isvoice, !isin) the only exception is the equality operators. The opposite of == is !=, the opposite of > is <= and of < is >=, etc. <br />

==Combining Statements==
Now what if you wish to check to things? Something like
if (it is raining AND I do not have a poncho on) { put on poncho }
This combines two statements "it is raining", "I do not have a poncho on" using AND. We call AND a "conditional operator". There is also OR as you might imagine.<br />
In mIRC, we use && for and, and || for or.
if (it is raining && I do not have a poncho on) { put on poncho }
So let's say we now want to modify our weather alias to remember what the last weather was, and not tell us to do something we've already done. For example /weather rain would tell us to put on a poncho, but if we did it again it wouldn't say that, because we already have one on.
alias weather {
; Check to make sure we actually told us of a weather, if not 'return' (which means STOP!)
if ($1 != [[$null]]) { [[return]] }
; If it is now rain AND we didnt already know that
if ($1 == rain && %weather != rain) {
set %weather rain
echo -atg Put on a poncho.
}
}

In this example we show that you can do two things in one control statement by putting them on different lines. Our if statement now checks to see if %weather is not already 'rain', that way we don't put the poncho on twice. We might also do this:
alias weather {
; Check to make sure we actually told us of a weather, if not 'return' (which means STOP!)
if ($1 != [[$null]]) { [[return]] }
; If it is now rain AND we didnt already know that
if ($1 == rain && %weather != rain) {
set %weather rain
echo -atg Put on a poncho.
}
if ($1 == clear && %weather != clear) {
echo -atg Take off poncho
set %weather clear
}
}

==Nesting==
This is a bit obvious, but warrants saying aloud. Since 'if' is technically a command, we can 'nest' it. That means we can have if (condition1) { command | if (condition2) { command2 } } <br />
For example, now we want /weather clear to say "Take off poncho" if %weather is rain.

alias weather {
; Check to make sure we actually told us of a weather, if not 'return' (which means STOP!)
if ($1 != [[$null]]) { [[return]] }
; If it is now rain AND we didnt already know that
if ($1 == rain && %weather != rain) {
set %weather rain
echo -atg Put on a poncho.
}
if ($1 == clear && %weather != clear) {
; Here we NEST another if statement!
if (%weather == rain) {
echo -atg Take off poncho
}
set %weather clear
}
}

Another example of this being used more constructively, and in an event:
on *:TEXT:*:#YellHouse: {
if ($1- !isupper) {
msg # YOU HAVE TO YELL IN #YELLHOUSE!!!!
if ($right($1-,1) == !) {
msg # PUNCTUATION IS NOT GOOD ENOUGH!!!
}
}
}

==Else and Elseif==
Elseif and Else are two very useful commands. These commands have to be used with an 'if' statement. Elseif is only considered if the if statement before it was $false, and else is only considered if everything before it was $false.

if (it is raining) { put on poncho }
elseif (it is snowing) { put on jacket }
else { take off poncho and jacket and enjoy the sun }

Notice, else does not take a condition! Else statements run if none of the elseif statements above it have run and if the closest if has not run. In this example, if it were somehow both raining and snowing, we would only put on a poncho, not a jacket, because the first if would run, and the elseif would not.
alias Sign {
var %a = $1
if (%a > 0) { echo -atg Positive! }
if (%a < 0) { echo -atg Negative! }
else { echo -atg Zero! }
}

There is an error in this alias, and that is that if $1 is positive, it will echo "Positive!" and "Zero!". This is because else only looks at the first if above it. The proper way to do this is:
alias Sign {
var %a = $1
if (%a > 0) { echo -atg Positive! }
elseif (%a < 0) { echo -atg Negative! }
else { echo -atg Zero! }

Modification of the weather alias to make it faster by using elseifs. This increases speed because it doesn't have to check $1 if it already knows it is rain
alias weather {
; Check to make sure we actually told us of a weather, if not 'return' (which means STOP!)
if ($1 != [[$null]]) { [[return]] }
; If it is now rain AND we didnt already know that
if ($1 == rain && %weather != rain) {
set %weather rain
echo -atg Put on a poncho.
}
; We use an elseif here, so that it doesnt bother checking if $1 == rain.
elseif ($1 == clear && %weather != clear) {
; Here we NEST another if statement!
if (%weather == rain) {
echo -atg Take off poncho
}
set %weather clear
}
}
}
==Other Boolean Values==
There are three important notes about boolean values. Besides $true and $false, three other things are interpreted
* 0 is ALWAYS interpreted as $false [if (0) { this will never happen }]
* $null is ALWAYS interpreted as $false [if (!$1) { this is like saying if $1 is not null, because its !$false if $1 is $null }]
* Anything else is ALWAYS interpreted as $true
<br />
<br />
Consider this minor change to the weather alias where we change if ($1 == $null) to something a bit shorter. This uses the fact that $null is $false
alias weather {
; Check to make sure we actually told us of a weather, if not 'return' (which means STOP!)
if (!$1) { [[return]] }
; If it is now rain AND we didnt already know that
if ($1 == rain && %weather != rain) {
set %weather rain
echo -atg Put on a poncho.
}
if ($1 == clear && %weather != clear) {
; Here we NEST another if statement!
if (%weather == rain) {
echo -atg Take off poncho
}
set %weather clear
}
}
==Examples==
Completed weather alias:
alias weather {
; Check to see if they gave us a weather condition, and if it isnt the same as before
if ($1 && $1 != %weather) {
if ($1 == rain) {
echo -atg Put on a poncho!
}
elseif ($1 == snow) {
echo -atg Put on a jacket!
}
elseif ($1 == clear) {
echo -atg Enjoy the sun!
}
; If this is some nonsense weather
else {
echo -atg I don't care about $1 $+ , I only advise on rain snow and clear.
return
}
; This chain of control is for checking what to remove
if (%weather == rain) { echo -atg Take off poncho. }
elseif (%weather == snow) { echo -atg Take off jacket. }
set %weather $1

}
; If they didnt give us a condition...
elseif (!$1) { echo -atg What is the weather like? }
; If its the same as before, tell them we know!
else {
echo -atg I already told you what to do about the $1 $+ ...
}
}

==See Also==
* [[If-Then-Else]] - 'Full' list of operators
* [[While]] - Another control structure for repeating things as long as something is true
[[Category:Tutorials]]

Basic control tutorial

2010-11-17T23:21:57Z

Aca20031:

Basic control tutorial

2010-11-17T23:00:41Z

Aca20031:

Basic control tutorial

2010-11-17T22:55:19Z

Aca20031:

Big sockets tutorial

2010-06-13T21:14:44Z

Aca20031:

This is an advanced socket tutorial covering TCP sockets, and using as an example an http connection. It provides you with an explanation of everything going on, and assumes you have no clue as to what a socket really is. In addition, this tutorial uses [[:Category:Binary_Files|binary variables]] to ensure this works correctly. You may use normal [[variables]] if you know what you are doing an understand what is going on.

In this tutorial we will create a script that goes to youtube.com and finds the title of any link pasted in the channel.

==What Are Sockets, How Do Networks Work?==

First let's de-romanticize sockets. The idea is rather simple but most scripters go into them thinking they are magical and difficult. Sockets (Read: TCP Sockets) are the method used by programs to communicate over a network, a network such as the internet.

A TCP Socket must connect to a computer using two things: an [http://en.wikipedia.org/wiki/IP_address IP Address] which specifies where the computer is in the world, and a port, which is a number between 1 and 65535 that contains the program you wish to communicate with on the computer.

Once a connection is established, you can read (receive data) and write (send data) through it, until it is disconnected.

==Script Setup==

First let us set up our script. We will catch all youtube links in any window and call an [[alias]] "youtubelookup" with the location of the file.
Note: http://www.youtube.com/watch?v=dF184_T_eWw&feature=sub
The HOST (which counts as the IP Address, in a manner of speaking) is www.youtube.com
The LOCATION is /watch?v=dF184_T_eWw&feature=sub
The PROTOCOL is http

on *:TEXT:*youtube.com/*:*: {
; Get the first youtube.com link from the text the users say. We use the $mid just so we don;t have to worry about the http://www.you... crap in our $pos
[[var]] %link = $mid([[$wildtok]]([[$1-]], *youtube.com/*,1,32),10)
; Get the location by returning everything after and including the /
var %location = $mid(%link,$pos(%link,/))
; Call alias youtubelookup
youtubelookup %location
}

Now that the dirty business there is done, lets get to the sockets.

==Making the Connection==

Now we must establish a connection to youtube's servers. I said before that you need an IP and a port, well theres a bit of a catch. The internet has a more practical way than remembering complex IP addresses such as 74.125.95.93, they are called host names. www.youtube.com is a host name. mIRC makes things easy for us, we can give it a host name and a port, or an a ip and a port.

So clearly our host name is www.youtube.com, but what is our port? Some ports are reserved, here is a list of reserved ports: [http://www.iana.org/assignments/port-numbers Reserved Port Numbers]. What you need to know now is that the reserved port for the HTTP protocol, which is what the web is based on in general, is 80. There are others, but 80 is the most common, and the default port for all browsers.

We will use the [[sockopen]] command to connect. In the interest of time I will not explain every command or event, but will instead provide a link, please use them to learn more.

In mIRC sockets are referred to by their names, so we will need to give this connection a unique name. We could use a name such as 'youtubecheck' but then we would only be able to do one at a time. Instead, let us use a randomly made name created by using this: youtubecheck $+ [[$ticks]]

alias youtubelookup {
; We make sure the location was given to us, otherwise we echo an error and stop doing things
if ($0 != 1) { echo -a * /youtubelookup: invalid parameters | [[halt]] }
; We generate our random name and make absolutely certain this name isn't taken. Note since our on text can work for both channels and queries, we use an iif
var %name = youtubelookup $+ $ticks
if ($sock(%name)) { msg [[$iif]](#,#,$nick) Youtube lookup error, name was in use ( $+ %name $+ ) | halt }
;
sockopen %name www.youtube.com 80
; We will need a way to tell which channel or nick to respond to once we get our reply from youtube's servers. We use sockmark for this.
;Sockmark is a simple way to store data related to a socket in text form. Please click the link for more information
[[sockmark]] %name $iif(#,#,$nick) $1
}

==Sending Data==
Now we have opened a connection to youtube's servers.
A [http://en.wikipedia.org/wiki/Protocol_(computing) Protocol] is the rules by which two things communicate. In this case, it tells us what we (the client) and what youtube (the server) should say in response to events. The [http://en.wikipedia.org/wiki/Hypertext_Transfer_Protocol HTTP protocol] says that once connected, the client should send headers, a list of information about what we want the server to send us.
<br />
[http://en.wikipedia.org/wiki/List_of_HTTP_headers Headers] look like this: <br />
GET /mypage.html HTTP/1.1<br />
Host: mysite.com<br />
User-Agent: Mozilla/5.0 (Windows; U; Windows NT 6.1; ru; rv:1.9.2.3) Gecko/20100401 Firefox/4.0 (.NET CLR 3.5.30729)<br />
Connection: close<br />
<br />
<br />
You can look them up at the link, by the basic gist of this is that we want to get the location /mypage.html from mysite.com. Once we get it, we want you to close the connection. We are browsing with Mozilla Firefox 5.0 for Windows. [https://addons.mozilla.org/en-US/firefox/addon/3829/ Live HTTP Headers] is a plugin for firefox which allows you to see the headers firefox sends. If you have trouble viewing a site with your sockets, use every header that firefox sends just in case.

Let us now send our request to youtube once we connect:

on *:SOCKOPEN:youtubelookup*: {
; We set an variable as an alias to write the data to the socket so we don't have to type it every time
var %n = [[sockwrite]] -n [[$sockname]]
; We GET the location we parsed out in our on text event. If you recall, we set this as the second word in our sockmark in the alias above.
%n GET [[$gettok]]($sock($sockname).mark,2,32) HTTP/1.1
; Some IPs have many web sites on them. We need to tell the web server that www.youtube.com is the host we are using.
%n Host: www.youtube.com
; Some web sites only allow certain web browsers, so we lie a bit here and tell youtube we are firefox 5.0.
%n User-Agent: Mozilla/5.0 (Windows; U; Windows NT 6.1; ru; rv:1.9.2.3) Gecko/20100401 Firefox/4.0 (.NET CLR 3.5.30729)
; We make sure youtube closes its connection with us as soon as its sent everything we asked for
%n Connection: close
; This empty line is the HTTP protocol way to tell it that we are done sending our data.
%n
}

==Using the Reply==

Youtube's server will reply to what we asked for. There are many possible replies depending on what the deal is: The page may not be found, and then it will reply to tell us as much. The page may be moved, or the page may be just fine. No matter what the deal is, the server will explain it to us in headers. If the page exists, it will send us the page's HTML (javascript css etc, the stuff the web site is written in) after the header telling us it exists.

Now, we do not receive this whole web page at once! Our internet speeds aren't unlimited, and data must travel, for that reason we can only receive data at most as fast as our connection is, and so we must deal with the data as we receive it. In mIRC the easiest way to do this is to add it all to the end of a binary variable as we receive the data then write it to a file for storage and once we are done receiving data (Once the server closes the connection) then we can work with all of it at once. Let us do this now.

Sockread is triggered every time more data is received.

on *:SOCKREAD:youtubelookup*: {
; If there was an error, $sockerr will contain the error number. We will message the user and tell them about the error, then stop.
if ($sockerr) { msg $gettok($sock($sockname).mark,1,32) There was an error while verifying youtube link: $sock($sockname).wsmsg | [[sockclose]] $sockname | halt }
;
:read
; We will read the data we received
[[sockread]] -f &data
; We will write the data to the end of the file with the same name as the socket. The -1 means the end of the file.
if ($sockbr > 0) { [[bwrite]] $sockname -1 &data }
; $sockbr (sock bytes read) contains the number of bytes (read: ascii letters) that we received this time. We want to keep reading until we can't read anymore!
; Note: Once $sockbr is 0, this doesn't mean the server doesn't have more to send! It just means we haven't gotten any more.
while ($sockbr > 0) { [[goto]] read }
;
}

==Using the Data==
Congratulations! You are done with sockets. We have now asked youtube for information, and received our information. Now, we need to do something with it. This isn't related to sockets, but since I took you this far I'll take you to the end. Remember: We have written all the data we received constantly to a file which has the same name as the socket, now we will read this data, first lets add this bit of practice that will just open the file so we can see it all in all its glory :)

Recall: When the server is done, we told it to close the socket.
on *:SOCKCLOSE:youtubelookup*: { run notepad $sockname }

I used the same link as I did from above to test it, saying "http://www.youtube.com/watch?v=dF184_T_eWw&feature=sub" in a channel I am in. If you did too, you probably saw a few headers setting some cookies, other things, and HTTP/1.1 200 OK telling us this page is fine and it gave it to us.

Then you will see an empty line followed by what may be gibberish to you. This is the web page. It is HTML, CSS, and Javascript. I'm certainly not going to teach you HTML in this tutorial, if you're interested see w3schools.com - what's important is that everything on the web page is represented here in one form or another. What I want my script to do is tell the person who pasted the link the title of the page. Press ctrl+f in notepad and search the document for <title>: You should see this:

<title>YouTube - Congressmen Submit Emergency 3 AM Bill Demanding IHOP Stay Open All Night</title>

Although it will not be as pretty. Youtube and most mass sites have BAD code, they do not care as long as it works. There will be line breaks and spaces everywhere, we are going to fix that. This part is somewhat advanced and is not related to sockets, if you wish to continue you may, but otherwise I encourage you to use what you learned here and try several things; Try web pages that dont exists or redirect and see what they say, once you have what you need read from the file you downloaded and paste the data to a channel or user, just do not forget to delete the file when you are done reading from it!

==Parsing The Data==
on *:SOCKCLOSE:youtubelookup*: {
; The place to send the data
var %target = $gettok($sock($sockname).mark,1,32)
; Read the file into the binary file &data
bread $sockname 1 $file($sockname).size &data
; Gets the position of <title> in the document
var %start = $bfind(&data,1,<title>).text
; Gets the position of </title> in the document
var %end = $bfind(&data,%start,</title>).text
; If we could not find these tags, the file likely is not valid.
if (!%start || !%end) { msg %target Invalid youtube link. | halt }
; get the data in between %start and %end, excluding the 7 letters for <title>
echo -atg Test: $bvar(&data,$calc(%start +7),$calc(%end - %start - 7))
; Remove new lines
breplace &data 10 32
breplace &data 13 32
var %title = $bvar(&data, $calc(%start + 7), $calc(%end - %start - 7)).text
; Tell target
msg %target Youtube Link: %title
; Delete the file
.remove $sockname
}

[[Category:Tutorials]][[Category:Socket]]

Big sockets tutorial

2010-06-10T19:44:01Z

Aca20031:

This is an advanced socket tutorial covering TCP sockets, and using as an example an http connection. It provides you with an explanation of everything going on, and assumes you have no clue as to what a socket really is. In addition, this tutorial uses [[:Category:Binary_Files|binary variables]] to ensure this works correctly. You may use normal [[variables]] if you know what you are doing an understand what is going on.

In this tutorial we will create a script that goes to youtube.com and finds the title of any link pasted in the channel.

==What Are Sockets, How Do Networks Work?==

First let's de-romanticize sockets. The idea is rather simple but most scripters go into them thinking they are magical and difficult. Sockets (Read: TCP Sockets) are the method used by programs to communicate over a network, a network such as the internet.

A TCP Socket must connect to a computer using two things: an [http://en.wikipedia.org/wiki/IP_address IP Address] which specifies where the computer is in the world, and a port, which is a number between 1 and 65535 that contains the program you wish to communicate with on the computer.

Once a connection is established, you can read (receive data) and write (send data) through it, until it is disconnected.

==Script Setup==

First let us set up our script. We will catch all youtube links in any window and call an [[alias]] "youtubelookup" with the location of the file.
Note: http://www.youtube.com/watch?v=dF184_T_eWw&feature=sub
The HOST (which counts as the IP Address, in a manner of speaking) is www.youtube.com
The LOCATION is /watch?v=dF184_T_eWw&feature=sub
The PROTOCOL is http

on *:TEXT:*youtube.com/*:*: {
; Get the first youtube.com link from the text the users say. We use the $mid just so we don;t have to worry about the http://www.you... crap in our $pos
[[var]] %link = $mid([[$wildtok]]([[$1-]], *youtube.com/*,1,32),10)
; Get the location by returning everything after and including the /
var %location = $mid(%link,$pos(%link,/))
; Call alias youtubelookup
youtubelookup %location
}

Now that the dirty business there is done, lets get to the sockets.

==Making the Connection==

Now we must establish a connection to youtube's servers. I said before that you need an IP and a port, well theres a bit of a catch. The internet has a more practical way than remembering complex IP addresses such as 74.125.95.93, they are called host names. www.youtube.com is a host name. mIRC makes things easy for us, we can give it a host name and a port, or an a ip and a port.

So clearly our host name is www.youtube.com, but what is our port? Some ports are reserved, here is a list of reserved ports: [http://www.iana.org/assignments/port-numbers Reserved Port Numbers]. What you need to know now is that the reserved port for the HTTP protocol, which is what the web is based on in general, is 80. There are others, but 80 is the most common, and the default port for all browsers.

We will use the [[sockopen]] command to connect. In the interest of time I will not explain every command or event, but will instead provide a link, please use them to learn more.

In mIRC sockets are referred to by their names, so we will need to give this connection a unique name. We could use a name such as 'youtubecheck' but then we would only be able to do one at a time. Instead, let us use a randomly made name created by using this: youtubecheck $+ [[$ticks]]

alias youtubelookup {
; We make sure the location was given to us, otherwise we echo an error and stop doing things
if ($0 != 1) { echo -a * /youtubelookup: invalid parameters | [[halt]] }
; We generate our random name and make absolutely certain this name isn't taken. Note since our on text can work for both channels and queries, we use an iif
var %name = youtubelookup $+ $ticks
if ($sock(%name)) { msg [[$iif]](#,#,$nick) Youtube lookup error, name was in use ( $+ %name $+ ) | halt }
;
sockopen %name www.youtube.com 80
; We will need a way to tell which channel or nick to respond to once we get our reply from youtube's servers. We use sockmark for this.
;Sockmark is a simple way to store data related to a socket in text form. Please click the link for more information
[[sockmark]] %name $iif(#,#,$nick) $1
}

==Sending Data==
Now we have opened a connection to youtube's servers.
A [http://en.wikipedia.org/wiki/Protocol_(computing) Protocol] is the rules by which two things communicate. In this case, it tells us what we (the client) and what youtube (the server) should say in response to events. The [http://en.wikipedia.org/wiki/Hypertext_Transfer_Protocol HTTP protocol] says that once connected, the client should send headers, a list of information about what we want the server to send us.

[http://en.wikipedia.org/wiki/List_of_HTTP_headers Headers] look like this:
GET /mypage.html HTTP/1.1
Host: mysite.com
User-Agent: Mozilla/5.0 (Windows; U; Windows NT 6.1; ru; rv:1.9.2.3) Gecko/20100401 Firefox/4.0 (.NET CLR 3.5.30729)
Connection: close

You can look them up at the link, by the basic gist of this is that we want to get the location /mypage.html from mysite.com. Once we get it, we want you to close the connection. We are browsing with Mozilla Firefox 5.0 for Windows. [https://addons.mozilla.org/en-US/firefox/addon/3829/ Live HTTP Headers] is a plugin for firefox which allows you to see the headers firefox sends. If you have trouble viewing a site with your sockets, use every header that firefox sends just in case.

Let us now send our request to youtube once we connect:

on *:SOCKOPEN:youtubelookup*: {
; We set an variable as an alias to write the data to the socket so we don't have to type it every time
var %n = [[sockwrite]] -n [[$sockname]]
; We GET the location we parsed out in our on text event. If you recall, we set this as the second word in our sockmark in the alias above.
%n GET [[$gettok]]($sock($sockname).mark,2,32) HTTP/1.1
; Some IPs have many web sites on them. We need to tell the web server that www.youtube.com is the host we are using.
%n Host: www.youtube.com
; Some web sites only allow certain web browsers, so we lie a bit here and tell youtube we are firefox 5.0.
%n User-Agent: Mozilla/5.0 (Windows; U; Windows NT 6.1; ru; rv:1.9.2.3) Gecko/20100401 Firefox/4.0 (.NET CLR 3.5.30729)
; We make sure youtube closes its connection with us as soon as its sent everything we asked for
%n Connection: close
; This empty line is the HTTP protocol way to tell it that we are done sending our data.
%n
}

==Using the Reply==

Youtube's server will reply to what we asked for. There are many possible replies depending on what the deal is: The page may not be found, and then it will reply to tell us as much. The page may be moved, or the page may be just fine. No matter what the deal is, the server will explain it to us in headers. If the page exists, it will send us the page's HTML (javascript css etc, the stuff the web site is written in) after the header telling us it exists.

Now, we do not receive this whole web page at once! Our internet speeds aren't unlimited, and data must travel, for that reason we can only receive data at most as fast as our connection is, and so we must deal with the data as we receive it. In mIRC the easiest way to do this is to add it all to the end of a binary variable as we receive the data then write it to a file for storage and once we are done receiving data (Once the server closes the connection) then we can work with all of it at once. Let us do this now.

Sockread is triggered every time more data is received.

on *:SOCKREAD:youtubelookup*: {
; If there was an error, $sockerr will contain the error number. We will message the user and tell them about the error, then stop.
if ($sockerr) { msg $gettok($sock($sockname).mark,1,32) There was an error while verifying youtube link: $sock($sockname).wsmsg | [[sockclose]] $sockname | halt }
;
:read
; We will read the data we received
[[sockread]] -f &data
; We will write the data to the end of the file with the same name as the socket. The -1 means the end of the file.
if ($sockbr > 0) { [[bwrite]] $sockname -1 &data }
; $sockbr (sock bytes read) contains the number of bytes (read: ascii letters) that we received this time. We want to keep reading until we can't read anymore!
; Note: Once $sockbr is 0, this doesn't mean the server doesn't have more to send! It just means we haven't gotten any more.
while ($sockbr > 0) { [[goto]] read }
;
}

==Using the Data==
Congratulations! You are done with sockets. We have now asked youtube for information, and received our information. Now, we need to do something with it. This isn't related to sockets, but since I took you this far I'll take you to the end. Remember: We have written all the data we received constantly to a file which has the same name as the socket, now we will read this data, first lets add this bit of practice that will just open the file so we can see it all in all its glory :)

Recall: When the server is done, we told it to close the socket.
on *:SOCKCLOSE:youtubelookup*: { run notepad $sockname }

I used the same link as I did from above to test it, saying "http://www.youtube.com/watch?v=dF184_T_eWw&feature=sub" in a channel I am in. If you did too, you probably saw a few headers setting some cookies, other things, and HTTP/1.1 200 OK telling us this page is fine and it gave it to us.

Then you will see an empty line followed by what may be gibberish to you. This is the web page. It is HTML, CSS, and Javascript. I'm certainly not going to teach you HTML in this tutorial, if you're interested see w3schools.com - what's important is that everything on the web page is represented here in one form or another. What I want my script to do is tell the person who pasted the link the title of the page. Press ctrl+f in notepad and search the document for <title>: You should see this:

<title>YouTube - Congressmen Submit Emergency 3 AM Bill Demanding IHOP Stay Open All Night</title>

Although it will not be as pretty. Youtube and most mass sites have BAD code, they do not care as long as it works. There will be line breaks and spaces everywhere, we are going to fix that. This part is somewhat advanced and is not related to sockets, if you wish to continue you may, but otherwise I encourage you to use what you learned here and try several things; Try web pages that dont exists or redirect and see what they say, once you have what you need read from the file you downloaded and paste the data to a channel or user, just do not forget to delete the file when you are done reading from it!

==Parsing The Data==
on *:SOCKCLOSE:youtubelookup*: {
; The place to send the data
var %target = $gettok($sock($sockname).mark,1,32)
; Read the file into the binary file &data
bread $sockname 1 $file($sockname).size &data
; Gets the position of <title> in the document
var %start = $bfind(&data,1,<title>).text
; Gets the position of </title> in the document
var %end = $bfind(&data,%start,</title>).text
; If we could not find these tags, the file likely is not valid.
if (!%start || !%end) { msg %target Invalid youtube link. | halt }
; get the data in between %start and %end, excluding the 7 letters for <title>
echo -atg Test: $bvar(&data,$calc(%start +7),$calc(%end - %start - 7))
; Remove new lines
breplace &data 10 32
breplace &data 13 32
var %title = $bvar(&data, $calc(%start + 7), $calc(%end - %start - 7)).text
; Tell target
msg %target Youtube Link: %title
; Delete the file
.remove $sockname
}

[[Category:Tutorials]][[Category:Socket]]

Little sockets tutorial

2010-06-10T19:43:52Z

Aca20031:

This tutorial shows how to use [[:Category:Socket|sockets]] to get info from http://checkip.dyndns.org/index.php and how to use that info to set the ip in mirc correct. This can be usefull if you've a router and a bnc.

;this is a little tutorial about sockets
;
;it's about how to connect to http://checkip.dyndns.org/index.php with mirc, then take your ip out
;
;and use that ip to set [[$ip]]
;
;this can be useful if you've a router and a bnc, depending on your mirc settings, mirc will normally
;make $ip your bnc serverip, or your local ip, like 192.168.0.2
;
;

;on connect event, with timer, so if you connect to 3 different servers on start up, it'll only be triggered once :)
[[On_connect|on *:connect]]:{ .[[timer]]myip 1 5 myip }

[[Aliases|alias]] myip {
;if the socket already is open, close it, you can only have one connection with the same name at the same time
[[If-Then-Else|if]] ([[$sock]](myip)) { [[sockclose]] myip }
;to open a socket with name myip to address checkip.dyndns.org on port 80
[[sockopen]] myip checkip.dyndns.org 80
}
;this event is triggered on the moment the sockets is opened
[[On_sockopen|on *:sockopen]]:myip:{
;to tell the server which file you want to receive
[[sockwrite]] -n [[$sockname]] GET /index.php HTTP/1.0
sockwrite -n $sockname Host: checkip.dyndns.org
;this is only needed for a few websites, but it's just more complete to have it ;)
sockwrite -n $sockname user-agent: Mozilla/??
sockwrite -n $sockname Connection: Keep-Alive
sockwrite -n $sockname [[$crlf]]
}
[[On_sockread|on *:sockread]]:myip:{
;same way as in mirc helpfile with the :nextread
if ([[$sockerr]] > 0) [[return]]
:nextread
[[sockread]] %temp
if ([[$sockbr]] == 0) return
;to check if we got the right line, it's pretty easy for this file, but usually more complicated,
;use $gettok or variables to get the right line.
if (<html> [[If-Then-Else#isin|isin]] %temp) {
;%temp will contain something like:
;<html><head><title>Current IP Check</title></head><body>Current IP Address: 217.20.116.184</body></html>
;an easy way to 'strip' it is with $remove
[[var]] %z = [[$remove]](%temp,<html><head><title>Current IP Check</title></head><body>Current IP Address:,</body></html>)

;scon -a is to send a command to all servers mirc is connected to
[[scon]] -a localinfo [[$chr]](10) %z
scon -a [[echo]] 4 -s ip is set to $ip
}
[[Goto_loops|goto]] nextread
}

;If your knowledge about sockets is still [[$null]] or just not enough yet ;), maybe read this tutorial:
; http://www.mircscripts.org/showdoc.php?type=tutorial&id=1128 or check /help Sockets
== See Also ==
* [[Big sockets tutorial]]
[[Category:Tutorials]][[Category:Socket]]

Big sockets tutorial

2010-06-10T19:42:02Z

Aca20031:

This is an advanced socket tutorial covering TCP sockets, and using as an example an http connection. It provides you with an explanation of everything going on, and assumes you have no clue as to what a socket really is. In addition, this tutorial uses [[:Category:Binary_Files|binary variables]] to ensure this works correctly. You may use normal [[variables]] if you know what you are doing an understand what is going on.

In this tutorial we will create a script that goes to youtube.com and finds the title of any link pasted in the channel.

==What Are Sockets, How Do Networks Work?==

First let's de-romanticize sockets. The idea is rather simple but most scripters go into them thinking they are magical and difficult. Sockets (Read: TCP Sockets) are the method used by programs to communicate over a network, a network such as the internet.

A TCP Socket must connect to a computer using two things: an [http://en.wikipedia.org/wiki/IP_address IP Address] which specifies where the computer is in the world, and a port, which is a number between 1 and 65535 that contains the program you wish to communicate with on the computer.

Once a connection is established, you can read (receive data) and write (send data) through it, until it is disconnected.

==Script Setup==

First let us set up our script. We will catch all youtube links in any window and call an [[alias]] "youtubelookup" with the location of the file.
Note: http://www.youtube.com/watch?v=dF184_T_eWw&feature=sub
The HOST (which counts as the IP Address, in a manner of speaking) is www.youtube.com
The LOCATION is /watch?v=dF184_T_eWw&feature=sub
The PROTOCOL is http

on *:TEXT:*youtube.com/*:*: {
; Get the first youtube.com link from the text the users say. We use the $mid just so we don;t have to worry about the http://www.you... crap in our $pos
[[var]] %link = $mid([[$wildtok]]([[$1-]], *youtube.com/*,1,32),10)
; Get the location by returning everything after and including the /
var %location = $mid(%link,$pos(%link,/))
; Call alias youtubelookup
youtubelookup %location
}

Now that the dirty business there is done, lets get to the sockets.

==Making the Connection==

Now we must establish a connection to youtube's servers. I said before that you need an IP and a port, well theres a bit of a catch. The internet has a more practical way than remembering complex IP addresses such as 74.125.95.93, they are called host names. www.youtube.com is a host name. mIRC makes things easy for us, we can give it a host name and a port, or an a ip and a port.

So clearly our host name is www.youtube.com, but what is our port? Some ports are reserved, here is a list of reserved ports: [http://www.iana.org/assignments/port-numbers Reserved Port Numbers]. What you need to know now is that the reserved port for the HTTP protocol, which is what the web is based on in general, is 80. There are others, but 80 is the most common, and the default port for all browsers.

We will use the [[sockopen]] command to connect. In the interest of time I will not explain every command or event, but will instead provide a link, please use them to learn more.

In mIRC sockets are referred to by their names, so we will need to give this connection a unique name. We could use a name such as 'youtubecheck' but then we would only be able to do one at a time. Instead, let us use a randomly made name created by using this: youtubecheck $+ [[$ticks]]

alias youtubelookup {
; We make sure the location was given to us, otherwise we echo an error and stop doing things
if ($0 != 1) { echo -a * /youtubelookup: invalid parameters | [[halt]] }
; We generate our random name and make absolutely certain this name isn't taken. Note since our on text can work for both channels and queries, we use an iif
var %name = youtubelookup $+ $ticks
if ($sock(%name)) { msg [[$iif]](#,#,$nick) Youtube lookup error, name was in use ( $+ %name $+ ) | halt }
;
sockopen %name www.youtube.com 80
; We will need a way to tell which channel or nick to respond to once we get our reply from youtube's servers. We use sockmark for this.
;Sockmark is a simple way to store data related to a socket in text form. Please click the link for more information
[[sockmark]] %name $iif(#,#,$nick) $1
}

==Sending Data==
Now we have opened a connection to youtube's servers.
A [http://en.wikipedia.org/wiki/Protocol_(computing) Protocol] is the rules by which two things communicate. In this case, it tells us what we (the client) and what youtube (the server) should say in response to events. The [http://en.wikipedia.org/wiki/Hypertext_Transfer_Protocol HTTP protocol] says that once connected, the client should send headers, a list of information about what we want the server to send us.

[http://en.wikipedia.org/wiki/List_of_HTTP_headers Headers] look like this:
GET /mypage.html HTTP/1.1
Host: mysite.com
User-Agent: Mozilla/5.0 (Windows; U; Windows NT 6.1; ru; rv:1.9.2.3) Gecko/20100401 Firefox/4.0 (.NET CLR 3.5.30729)
Connection: close

You can look them up at the link, by the basic gist of this is that we want to get the location /mypage.html from mysite.com. Once we get it, we want you to close the connection. We are browsing with Mozilla Firefox 5.0 for Windows. [https://addons.mozilla.org/en-US/firefox/addon/3829/ Live HTTP Headers] is a plugin for firefox which allows you to see the headers firefox sends. If you have trouble viewing a site with your sockets, use every header that firefox sends just in case.

Let us now send our request to youtube once we connect:

on *:SOCKOPEN:youtubelookup*: {
; We set an variable as an alias to write the data to the socket so we don't have to type it every time
var %n = [[sockwrite]] -n [[$sockname]]
; We GET the location we parsed out in our on text event. If you recall, we set this as the second word in our sockmark in the alias above.
%n GET [[$gettok]]($sock($sockname).mark,2,32) HTTP/1.1
; Some IPs have many web sites on them. We need to tell the web server that www.youtube.com is the host we are using.
%n Host: www.youtube.com
; Some web sites only allow certain web browsers, so we lie a bit here and tell youtube we are firefox 5.0.
%n User-Agent: Mozilla/5.0 (Windows; U; Windows NT 6.1; ru; rv:1.9.2.3) Gecko/20100401 Firefox/4.0 (.NET CLR 3.5.30729)
; We make sure youtube closes its connection with us as soon as its sent everything we asked for
%n Connection: close
; This empty line is the HTTP protocol way to tell it that we are done sending our data.
%n
}

==Using the Reply==

Youtube's server will reply to what we asked for. There are many possible replies depending on what the deal is: The page may not be found, and then it will reply to tell us as much. The page may be moved, or the page may be just fine. No matter what the deal is, the server will explain it to us in headers. If the page exists, it will send us the page's HTML (javascript css etc, the stuff the web site is written in) after the header telling us it exists.

Now, we do not receive this whole web page at once! Our internet speeds aren't unlimited, and data must travel, for that reason we can only receive data at most as fast as our connection is, and so we must deal with the data as we receive it. In mIRC the easiest way to do this is to add it all to the end of a binary variable as we receive the data then write it to a file for storage and once we are done receiving data (Once the server closes the connection) then we can work with all of it at once. Let us do this now.

Sockread is triggered every time more data is received.

on *:SOCKREAD:youtubelookup*: {
; If there was an error, $sockerr will contain the error number. We will message the user and tell them about the error, then stop.
if ($sockerr) { msg $gettok($sock($sockname).mark,1,32) There was an error while verifying youtube link: $sock($sockname).wsmsg | [[sockclose]] $sockname | halt }
;
:read
; We will read the data we received
[[sockread]] -f &data
; We will write the data to the end of the file with the same name as the socket. The -1 means the end of the file.
if ($sockbr > 0) { [[bwrite]] $sockname -1 &data }
; $sockbr (sock bytes read) contains the number of bytes (read: ascii letters) that we received this time. We want to keep reading until we can't read anymore!
; Note: Once $sockbr is 0, this doesn't mean the server doesn't have more to send! It just means we haven't gotten any more.
while ($sockbr > 0) { [[goto]] read }
;
}

==Using the Data==
Congratulations! You are done with sockets. We have now asked youtube for information, and received our information. Now, we need to do something with it. This isn't related to sockets, but since I took you this far I'll take you to the end. Remember: We have written all the data we received constantly to a file which has the same name as the socket, now we will read this data, first lets add this bit of practice that will just open the file so we can see it all in all its glory :)

Recall: When the server is done, we told it to close the socket.
on *:SOCKCLOSE:youtubelookup*: { run notepad $sockname }

I used the same link as I did from above to test it, saying "http://www.youtube.com/watch?v=dF184_T_eWw&feature=sub" in a channel I am in. If you did too, you probably saw a few headers setting some cookies, other things, and HTTP/1.1 200 OK telling us this page is fine and it gave it to us.

Then you will see an empty line followed by what may be gibberish to you. This is the web page. It is HTML, CSS, and Javascript. I'm certainly not going to teach you HTML in this tutorial, if you're interested see w3schools.com - what's important is that everything on the web page is represented here in one form or another. What I want my script to do is tell the person who pasted the link the title of the page. Press ctrl+f in notepad and search the document for <title>: You should see this:

<title>YouTube - Congressmen Submit Emergency 3 AM Bill Demanding IHOP Stay Open All Night</title>

Although it will not be as pretty. Youtube and most mass sites have BAD code, they do not care as long as it works. There will be line breaks and spaces everywhere, we are going to fix that. This part is somewhat advanced and is not related to sockets, if you wish to continue you may, but otherwise I encourage you to use what you learned here and try several things; Try web pages that dont exists or redirect and see what they say, once you have what you need read from the file you downloaded and paste the data to a channel or user, just do not forget to delete the file when you are done reading from it!

==Parsing The Data==
on *:SOCKCLOSE:youtubelookup*: {
; The place to send the data
var %target = $gettok($sock($sockname).mark,1,32)
; Read the file into the binary file &data
bread $sockname 1 $file($sockname).size &data
; Gets the position of <title> in the document
var %start = $bfind(&data,1,<title>).text
; Gets the position of </title> in the document
var %end = $bfind(&data,%start,</title>).text
; If we could not find these tags, the file likely is not valid.
if (!%start || !%end) { msg %target Invalid youtube link. | halt }
; get the data in between %start and %end, excluding the 7 letters for <title>
echo -atg Test: $bvar(&data,$calc(%start +7),$calc(%end - %start - 7))
; Remove new lines
breplace &data 10 32
breplace &data 13 32
var %title = $bvar(&data, $calc(%start + 7), $calc(%end - %start - 7)).text
; Tell target
msg %target Youtube Link: %title
; Delete the file
.remove $sockname
}

$asin

2010-03-14T02:01:21Z

Aca20031:

Trigonometric function to return the arcsine (1/y) of an angle.

$asin(N)[.deg]
* N is an angle in radians.
* The .deg property allows N to be given in degrees

==See also==
[[$sin]] for getting the sine of an angle.

[[Category:Text and Number Identifiers]]

$sin

2010-03-14T02:01:00Z

Aca20031:

Trigonometric function to return the sine (y) of an angle.

$sin(N)[.deg]
* N is an angle in radians.
* The .deg property allows N to be given in degrees

==See also==
[[$asin]] for getting the arcsine of an angle.

[[Category:Text and Number Identifiers]]

$acos

2010-03-14T02:00:26Z

Aca20031:

Trigonometric function to return the arccosine (1/x) of an angle.

$acos(N)[.deg]
* N is an angle in radians.
* The .deg property allows N to be given in degrees

==See also==
[[$cos]] for getting the cosine of an angle.

[[Category:Text and Number Identifiers]]

$cos

2010-03-14T02:00:04Z

Aca20031:

Trigonometric function to return the cosine (x) of an angle.

$cos(N)[.deg]
* N is an angle in radians.
* The .deg property allows N to be given in degrees

==See also==
[[$acos]] for getting the arccosine of an angle.

[[Category:Text and Number Identifiers]]

$atan

2010-03-14T01:59:09Z

Aca20031:

Trigonometric function to return the arctangent (y/x) of an angle.

$atan(N)[.deg]
* N is an angle in radians.
* The .deg property allows N to be given in degrees

==See also==
[[$tan]] for getting the tangent of an angle.

[[Category:Text and Number Identifiers]]

$tan

2010-03-14T01:58:51Z

Aca20031:

Trigonometric function to return the tangent (x/y) of an angle.

$tan(N)[.deg]
* N is an angle in radians.
* The .deg property allows N to be given in degrees

==See also==
[[$atan]] for getting the arctangent of an angle

[[Category:Text and Number Identifiers]]

Scope

2009-10-03T19:11:17Z

Aca20031: Scope Precedence

Scope is the term used to refer to a [[:Category:Variables|variable's]] "life-span". mIRC variables have only two scopes.

==Global Scope==
A variable with a global scope is accessable everywhere in mIRC where a variable can be used. This means in the command line, in every script file, alias file, popup, etc. These variables are saved in the Variables tab of the mIRC Scripts editor (alt+r) which are saved to a file (usually vars.ini).

* A global scoped variable is created with [[set]] and destroyed with [[unset]]

===Example===

Suppose the following was called, /test and then /test2.

[[alias]] test {
set %foo bar.
; %foo is available here
}

[[alias]] test2 {
set %bar foo
; %foo is available here after being set with /test
}

%foo will now return bar EVERYWHERE (unless overridden by a local variable)

==Local Scope==

A variable with a local scope is only available within the event, alias, or menu (popup) script in which it is used.

* A local variable is created with [[var]] and is automatically destroyed after leaving scope (exiting the current alias, event or menu). It can also be destroyed by [[unset]].

===Example===

Suppose the following was called using /test
[[alias]] test {
[[var]] %foo = bar.
; %foo is available here
test2 %foo
}

[[alias]] test2 {
[[var]] %bar = foo
; %foo is NOT available here. We can, however, use $1 to refer to %foo because it was passed as a parameter to the alias.
}

==Scope Precedence==

A final note on scope: A local scope will take Precedence over a global scope. This means that if there is a global variable and a local variable with the same name, the local variable's value will be used.

===Example===

Suppose the following was called using /test and /test2

alias test {
set %foo bar.
}

alias test2{
var %foo = Vliedel Smells
[[echo]] -atg %foo
; This will echo "Vliedel Smells" even though %foo is still a global variable with value "bar"
[[unset]] %foo
[[echo]] -atg %foo
; This will echo "bar" because the first unset unset the local-scope variable %foo.
}

==See Also==
* [[var]] - Command used to create a local variables
* [[Local Variables]] - Variables with limited scope
* [[set]] - Command used to create global variables

[[Category:Tutorials]]
[[Category:Variables]]

Scope

2009-10-03T18:54:21Z

Aca20031:

Scope is the term used to refer to a [[:Category:Variables|variable's]] "life-span". mIRC variables have only two scopes.

==Global Scope==
A variable with a global scope is accessable everywhere in mIRC where a variable can be used. This means in the command line, in every script file, alias file, popup, etc. These variables are saved in the Variables tab of the mIRC Scripts editor (alt+r) which are saved to a file (usually vars.ini).

* A global scoped variable is created with [[set]] and destroyed with [[unset]]

===Example===

Suppose the following was called, /test and then /test2.

[[alias]] test {
set %foo bar.
; %foo is available here
}

[[alias]] test2 {
set %bar foo
; %foo is available here after being set with /test
}

%foo will now return bar EVERYWHERE.

==Local Scope==

A variable with a local scope is only available within the event, alias, or menu (popup) script in which it is used.

* A local variable is created with [[var]] and is automatically destroyed after leaving scope (exiting the current alias, event or menu). It can also be destroyed by [[unset]].

===Example===

Suppose the following was called using /test
[[alias]] test {
[[var]] %foo = bar.
; %foo is available here
test2 %foo
}

[[alias]] test2 {
[[var]] %bar = foo
; %foo is NOT available here. We can, however, use $1 to refer to %foo because it was passed as a parameter to the alias.
}

==See Also==
* [[var]] - Command used to create a local variables
* [[Local Variables]] - Variables with limited scope
* [[set]] - Command used to create global variables

[[Category:Tutorials]]
[[Category:Variables]]

Scope

2009-10-03T18:52:13Z

Aca20031: copy paste error...

Scope

2009-10-03T18:48:36Z

Aca20031:

DollarStar

2009-07-31T18:31:52Z

Aca20031:

#REDIRECT [[$*]]

$*

2009-07-31T18:29:52Z

Aca20031: Typo

$* is a hidden shortcut to "looping" [[tokenize|tokenized]] ([[$1-|$N]]) data

$*
* $* only works in one command per tokenization
* $* is very quirky, and should not be used in most cases. Instead, [[While loops]] should be employed.

==Notes==
When using $*, mIRC replaces it with "`~$*" and passes it to all identifiers used. Once it is done, and all identifers have returned, and the command is ready to be executed, mIRC loops and does the command $0 times replacing EVERY instance of "`~$*" with one of the tokens.

==Examples==
(Assume $1 = a, $2 = b, $3 = c)
; Echos "a" then "b" then "c"
echo -a $*

; Echos `. Remember, "`~$*" is ONLY replaced once it is back in the command. You cannot pass it to an identifier, or "`~$*" is used.
echo -a $left($*,1)

==See Also==
* [[tokenize]]
* [[$1-]]

[[Category:Undocumented identifiers]]

$*

2009-07-31T18:29:35Z

Aca20031:

$* is a hidden shortcut to "looping" [[tokenize|tokenized]] ([[$1-|$N]]) dat

$*
* $* only works in one command per tokenization
* $* is very quirky, and should not be used in most cases. Instead, [[While loops]] should be employed.

==Notes==
When using $*, mIRC replaces it with "`~$*" and passes it to all identifiers used. Once it is done, and all identifers have returned, and the command is ready to be executed, mIRC loops and does the command $0 times replacing EVERY instance of "`~$*" with one of the tokens.

==Examples==
(Assume $1 = a, $2 = b, $3 = c)
; Echos "a" then "b" then "c"
echo -a $*

; Echos `. Remember, "`~$*" is ONLY replaced once it is back in the command. You cannot pass it to an identifier, or "`~$*" is used.
echo -a $left($*,1)

==See Also==
* [[tokenize]]
* [[$1-]]

[[Category:Undocumented identifiers]]

Wildcards

2009-07-31T16:51:43Z

Aca20031:

Wildcard characters is the name given to the special meta characters *, &, and ?. These characters are used to "match" strings of text without knowing exactly what will be said.

The characters are as follows:
* * - Matches anything. From nothing at all, to one letter, to one word, to several words.
* & - Matches one word. Does not include the space
* ? - Matches one letter (or other character such as a number or a special symbol)

==Using Wild Cards in Events==

Wild cards in mIRC are used most often in events, such as the [[on text]] event. The [[on text]] event's syntax is as follows:
on <level>:TEXT:<matchtext>:<*><?><#[,#]>:<commands>
(For more information on this event, see the [[on text|on text event page]], as it will not be covered in detail here.)

This event 'triggers' when someone types a line that matches "matchtext". By default, matchtext is a wildcard string. Common uses would be:

* !help - No wildcard characters. Matches ONLY the word "!help." will NOT match "!help topics"
* !help & - The & (word) matching character. Matches !help <anyword>. The word is required. Will NOT match "!help topics please"
* !help* - The * operator matches anything (and nothing). This format will match !help by itself, since * can match nothing. It will also match !helpmeplease or !help me please. It will NOT match ...!help because the * operator only follows !help.
* ?help - The ? operator here matches any character. So it will match "!help" "^help" "&help" etc etc. It will NOT match "help" by itself, or "!help please"

==More Examples==
; Matches !join #anything, for joining channels. Note this will also match !join #channel somethingelse
!join #*

; Matches !join <anything>. Note while this will match !join #foo, it will also match !join notachannel. It will not match !join #channel somethingelse
!join &

; Matches !join #anything. Unlike the use of the * operator, this will NOT match !join #channel somethingelse. It will also match @join #anything, *join #anything, etc.
?join #&

==See Also==
* [[If#iswm|iswm]] - using wild cards in [[If]] statements

[[Category:Tutorials]]