Page MenuHomeCode

autoload.tcl
No OneTemporary

autoload.tcl

This document is not UTF8. It was detected as Shift JIS and converted to UTF8 for display.
#!/usr/local/bin/tclsh8.5
#
# php-autoload-generator
# (c) S饕astien Santoro aka Dereckson, 2010, some rights reserved.
# Released under BSD license
#
# Last version of the code can be fetch at:
# http://bitbucket.org/dereckson/php-autoload-generator
#
# This code generator write a __autoload() PHP method, when you don't have a
# consistent pattern for classes naming and don't want to register several
# autoloader with spl_autoload_register().
#
# Parses your classes folder & reads each file to check if it contains classes.
#
#
# Configuration
#
#A list of regexp, one per directory to ignore
set config(directoriesToIgnore) {Smarty SmartLine}
#The output to produce before the lines
set config(templateBefore) "<?php
/**
* This magic method is called when a class can't be loaded
*/
function __autoload (\$className) {
//Classes"
#The output to produce after the
set config(templateAfter) "
//Loader
if (array_key_exists(\$className, \$classes)) {
require_once(\$classes\[\$className]);
}
}
?>"
#The line format, for %%lines%%
set config(templateClassLine) { $classes['%%class%%'] = '%%file%%';}
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
#
# Helpers methods
#
#Find .php script
proc find_scripts {directory} {
set dirs {}
foreach i [lsort [glob -nocomplain -dir $directory *]] {
if {[file type $i] == "directory" && ![is_ignored_directory $i]} {
lappend dirs $i
} elseif {[file extension $i] == ".php"} {
find_classes $i
}
}
foreach subdir $dirs {
#Adds a white line as a separator, then the classes in this dir
puts " "
find_scripts $subdir
}
}
#Called when we've got a winner
proc add_class {script class} {
global config
set line $config(templateClassLine)
regsub -all -- "%%class%%" $line $class line
regsub -all -- "%%file%%" $line $script line
puts $line
}
#Find classes in the file
#Thanks to Richard Suchenwirth for its glob-r code snippet this proc is forked
proc find_classes {file} {
set fp [open $file]
while {[gets $fp line] >= 0} {
set pos1 [string first "class " $line]
set pos2 [string first " \{" $line $pos1]
set pos3 [string first " implements" $line $pos1]
set pos4 [string first " extends" $line $pos1]
if {$pos1 > -1 && $pos2 > -1} {
if {$pos4 > -1} {
#We test implements first, as if a class implements and extends
#the syntax is class Plane extends Vehicle implements FlyingItem
set pos $pos4
} elseif {$pos3 > -1} {
set pos $pos3
} else {
set pos $pos2
}
set class [string range $line [expr $pos1 + 6] [expr $pos - 1]]
add_class $file $class
}
}
close $fp
}
#Check if the directory is ignored
proc is_ignored_directory {directory} {
global config
foreach re $config(directoriesToIgnore) {
if [regexp $re $directory] {return 1}
}
return 0
}
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
#
# Procedural code
#
if {$argc > 0} {
set directory [lindex $argv 0]
} {
set directory .
}
puts $config(templateBefore)
find_scripts $directory
puts $config(templateAfter)

File Metadata

Mime Type
text/plain
Expires
Sat, Feb 22, 15:27 (8 h, 10 m ago)
Storage Engine
blob
Storage Format
Raw Data
Storage Handle
21650
Default Alt Text
autoload.tcl (3 KB)

Event Timeline