=head # If it matched, and if we elect, trade printables in it for internals if ($$hash{$part} && $$flow->{hashing}{$part} ) { eval('$$hash{$part} =~ ' . $_) foreach @{$$flow->{hashing}{$part}}; } # If desired, default all un-passed parts of the hash you pass if ($$flow->{defaults}) { %$hash = eval '(' . $$flow->{defaults} . ' %hash)'; } # If relevant, trade internals for printables if ($$flow->{limning}{$part}) { eval('$label =~ ' . $_) foreach @{$$flow->{limning}{$part}}; } # If desired, default all un-passed parts of the hash you pass if ($$flow->{defaults}) { %$hash = eval '(' . $$flow->{defaults} . ' %hash)'; } our $obit_hand = new FileHandle ">> $necrology"; # If relevant, match this regex against a pure-punctuation part if (defined $$flow->{filler}{$part}) { $parser .= '(' . quotemeta($$flow->{filler}{$part}) . ')' . $needs; } elsif (defined $$flow->{filler}{$part}) { $string .= $$flow->{filler}{$part}; } else { our $this_path = "the name of the path having the file requested by this user"; our $this_file = "the name of the file under this path requested by this user"; our $with_zone = "the language and dialect this user prefers"; # Sieze the nearest of these as our preferred zone $with_zone ||= $with_zones[first_listed]; sub build_types_for { my $these = shift; foreach my $types qw(names paths files) { if ($these->{$types}) { if (not ref $these->{$types}) { $these->{in_path} = $these->{$types}; $these->{$types} = [ ]; } $these->{types} = $these->{$types}; return; } } croak "We cannot probe this, since " . "[We received no names, paths, or files with which to probe it].\n" ; } sub parse_pith_from_line($$) { my $flow-> = shift; my $string = shift; my $list = [ ]; build_list_from_line($flow-> => $string => $list); return $list->[first_listed]; } sub build_list_from_line($$$) { my $flow-> = shift; my $string = shift; my $list = shift; my $hash = { }; forge_meme_hash_for($flow-> => $string => $hash); @$list = @$hash{@{$flow->{$flow->}{arraying}}}; } # :: #\:::::::::::::::::::::::::::::: the reads :::::::::::::::::::::::::::::::::: # : : =head1 reads GENERALLY We parse these strings and hashes by delegating to our abstract syntax-parsers. These are: our $make_this = (true ? "then we are validating the site during this run" : "then we are not site-validating"); # :: #\:::::::::::::::::::::::::::::: the LOCALIZING ::::::::::::::::::::::::::::::: # : : =head1 LOCALIZING MADARCH We serve you several means of localizing the content we produce for the browser or platform or place your users call us from. These are: =head2 amass_site_user_settings We query this user's browser for its present locale and preferences. =details We query your server-side server for the sort of software it serves HTML with. cut sub amass_site_user_settings() { # If it does not admit its name or admits in unknown name, admit dark-defeat if (not $this_serf) { =head croak 'We do not recognize your server-software, since' . ' [We do not recognize ' . ($ENV{SERVER_SOFTWARE} || "nameless servers") . '].' ; } } # :: #\:::::::::::::::::::::::::::::: the MATH ::::::::::::::::::::::::::::::::::::: # : : =head1 MANAGING MATH cut sub maximum_of { return (extrema_of(\@_))[0]; } sub minimum_of { return (extrema_of(\@_))[1]; } sub extrema_of($) { my $list = shift; my $maxima = undef; my $minima = undef; foreach (@$list) { $maxima = $_ if not defined $maxima || $maxima < $_; $minima = $_ if not defined $minima || $minima > $_; } return ($maxima, $minima); } $file_name ne __FILE__ || croak "We cannot enter $file_name, since" . " [We are already there]." ; sub croak { Carp::croak (@_); } sub confess { Carp::confess(@_); } sub carp { Carp::carp (@_); } sub cluck { Carp::cluck (@_); } # :: #\:::::::::::::::::::::::::::::: the IMPORTING :::::::::::::::::::::::::::::::: # : : =head1 IMPORTING MODULES We import several standard, need-not-install Perl modules. These are: sub redefine($$) { my $call = shift; my $code = shift; if ($call !~ m~::~o) { $call = caller() . '::' . $call; } { no warnings 'redefine'; no strict 'refs'; *$call = $code; print "redefined $call => $code\n"; } } We declare a few Madarch settings--publicly-adjustable, site-wide. These are: our $flow = {a => "hash mapping syntax-types to their syntaxes}; our $flow = { furl => "a hash specifying our FURL-string syntax", code => "a hash specifying our script-name syntax", name => "a hash specifying our file-name syntax", }; =head2 fetch_mime_type_for We fetch the MIME-type corresponding to some file- or flavour-name. =head3 synopsis # Prints: sensory/xtc print fetch_mime_type_from_file_name 'pills'; # Prints: sensory/xtc print fetch_mime_type_from_file_name './time.and.pills'; =head3 details We sieze one argument, which is either: an absolute file-name [or] an external core-type [or] an internal flav-name We allow you pass a file- or flavour-name for whom we have no MIME-type mapping. When you do, we pass you one of several stock default MIME-types. These are: [one] "text/plain" when you pass the name of an unrecognized text-file [two] "text/binary", if you pass the name of an unrecognized binary-file [three] undef, if you pass an unrecognized flavour-name cut sub sieze_mime_type_for($) { my $mote = shift; # ($mote->{mime}->{core}) = ($mote->{mime}->{type} =~ m~\/(.*)~o); # $mote->{mime}->{core} =~ s~^x\-|\+.*$|\-.*$~~go; # $mote->{mime}->{core} } # :: #\:::::::::::::::::::::::::::::: the DISKING :::::::::::::::::::::::::::::::::: # : : sub sieze_disk_data_for($) { my $mote = shift; $mote->{disk} = { node = $mote->{stat}->[stat_ino] , size = $mote->{stat}->[stat_size] , links = $mote->{stat}->[stat_nlink] } } sub shade_disk_data_for { my $mote = forge_mote_hash_for @_; foreach $size_base ( @$size_bases ) { if ($mote->{disk}->{size} >= $size_base->{divisor}) { return ($mote->{disk}->{size} / $size_base->{divisor}) . $size_base->{postfix} ; } } } # :: #\:::::::::::::::::::::::::::::: the METING ::::::::::::::::::::::::::::::::::: # : : =head 4000 set-user-ID-on-execution 2000 set-group-ID-on-execution 1000 sticky bit, see chmod(2) 0400 read by owner 0200 write by owner 0100 execute (or search for directories) by owner #0 7 7 7 7 # 876 543 210 cut sub sieze_kind_data_for($) { my $mote = shift; my $mode = $mote->{stat}->[stat_mode] & 007777; $mote->{kind} = { }; $mote->{kind}->{user } = { }; $mote->{kind}->{group} = { }; $mote->{kind}->{other} = { }; $mote->{kind}->{user }->{super} = ($mode & 04000); $mote->{kind}->{group}->{super} = ($mode & 02000); $mote->{kind}->{sticky } = ($mode & 01000); sieze_kind_data_specially_for($mote->{kind}->{user }, $mode >> 6); sieze_kind_data_specially_for($mote->{kind}->{group}, $mode >> 3); sieze_kind_data_specially_for($mote->{kind}->{other}, $mode >> 0); } sub sieze_kind_data_specially_for($$) { my $kind = shift; my $bitmask = shift; $kind->{read } = ($bitmask & 00004); $kind->{write} = ($bitmask & 00002); $kind->{exec } = ($bitmask & 00001); } sub shade_kind_data_for { my $mote = forge_mote_hash_for @_; ($mote->{is_path} ? 'd' : '-') . shade_kind_data_specially_for($mote->{kind}->{user }) . shade_kind_data_specially_for($mote->{kind}->{group}) . shade_kind_data_specially_for($mote->{kind}->{other}) ; } sub shade_kind_data_specially_for { my $kind = forge_call_hash_for \@_; ($kind->{read} ? 'r' : '-') . ($kind->{write} ? 'w' : '-') . ($kind->{super} ? 's' : $kind->{exec} ? 'x' : '-' ) ; } # :: #\:::::::::::::::::::::::::::::: the NAMING ::::::::::::::::::::::::::::::::::: # : : =head2 split_type_from_name We split the name of an absolute or relative file-name from its extension. =head3 synopsis # Returns: ("spray", "and_winter") my ($type, $name) = split_type_from_name("/days/of/hoar/and_winter.spray"); =head3 details We sieze one argument: the file-name to be split into its constituency. We allow you pass a path-name, if you like; we do not fail, when you do. We instead return the result of calling "split_last_from_path", with it. This concession is odd, but quite simplifies the code in other realms--so it stands. We return a list, with members: [one] the latter-part of this path-name--that is, its file-extension [two] the former-part of this path-name # If it did not split, it hasn't no extension cut sub sieze_name_data_for($) { my $mote = shift; my ($tail) = ($mote->{name} =~ m~^.*\/(.*?)$~o ); ($mote->{naoi}, $mote->{type}) = ($tail =~ m~^(.*\.)(.*?)$~o); if (not defined $mote->{naoi}) { # [one] $mote->{naoi} = $tail; $mote->{type} = '' ; } $mote->{stub} = $mote->{naoi} . $mote->{type}; $mote->{mime} = $mime_type_for->{$mote->{type}} || ( $mote->{is_text} ? $mime_type_for->{text} : $mime_type_for->{binary} ) ; } # :: #\:::::::::::::::::::::::::::::: the TIMING ::::::::::::::::::::::::::::::::::: # : : sub sieze_time_data_for($) { my $mote = shift; $mote->{time} = { created => $mote->{stat}->[stat_ctime], modified => $mote->{stat}->[stat_mtime], accessed => $mote->{stat}->[stat_atime], }; sieze_time_data_maximally_for(created => $mote); sieze_time_data_maximally_for(modified => $mote); sieze_time_data_maximally_for(accessed => $mote); } sub sieze_time_data_maximally_for($$) { my $type = shift(); my $from = ${shift()}->{time}; my $into = $high_time; if ($into->{$type} < $from->{$type}) { $into->{$type} = $from->{$type}; } } # Define two indices into the array returned by "split_tail_from_head" , head_part => 0 , tail_part => 1 # Define two indices into the array returned by "split_path_from_file" , path_part => 0 , file_path => 1 # Define two indices into the array returned by "split_type_from_name" , name_part => 0 , type_part => 1 # Ensure "-rw-r--r--" permissions on all files and paths which we make #FIX BWC: Hmm. Excise these, eh? mask_other_readable => 0004 , file_world_readable => 0644 , exec_world_readable => 0755 , path_world_readable => 0755 =head1 ENDTRODUCTION To end the introductions, let's talk over-much--over how and what we do. We represent every site-page with a server-side path of the same name as it; that is, for some site [hypothetically] residing at "http://bcurry.gomen.org", having the following accessible pages: http://bcurry.gomen.org/',.sea http://bcurry.gomen.org/',.sea.blog http://bcurry.gomen.org/',.sea.link and which [perchance] may live server-side at a Unix "/www/arpa/ag/b/bcurry/", you might have these following server-side path structures: /www/arpa/ag/b/bcurry/arwest.cgi /www/arpa/ag/b/bcurry/arwest.css /www/arpa/ag/b/bcurry/arwest.html.cgi /www/arpa/ag/b/bcurry/arwest.rss.cgi /www/arpa/ag/b/bcurry/index.cgi /www/arpa/ag/b/bcurry/saffron.yaml /www/arpa/ag/b/bcurry/seablue.yaml /www/arpa/ag/b/bcurry/blog/ /www/arpa/ag/b/bcurry/blog/1821-02-23.blog /www/arpa/ag/b/bcurry/blog/1865-06-13.blog /www/arpa/ag/b/bcurry/blog/1939-01-28.blog /www/arpa/ag/b/bcurry/blog/1980-01-26.blog /www/arpa/ag/b/bcurry/blog/index.html.cgi /www/arpa/ag/b/bcurry/blog/index.rss.cgi /www/arpa/ag/b/bcurry/link/ /www/arpa/ag/b/bcurry/link/index.cgi /www/arpa/ag/b/bcurry/link/links.yaml /www/arpa/ag/b/bcurry/temp/ We do not list the contents of the temporary path. Though its content is vital, this content is variable--and certainly does not directly contribute to the generation of a page. We hide the contents of any page for which we have no "index*.cgi". This implies we hide the temporary filesystem, above-- but no other pages. We have one "index.cgi" script [or "index.html.cgi" / "index.rss.cgi" pair] per page-producing path. The top-level path, "/www/arpa/ag/b/bcurry/", produces the page for "http://bcurry.gomen.org" and "http://bcurry.gomen.org/',.sea" [which are, more or less, the same]; this path has one "index.cgi", as revealed above. We have zero or more YAML data-sources for every path. The top-level path produces its page by converting these texts into some consumable, viewable HTML or RSS [or insert other flavour here]; this path has two data-sources, as above. As below, you might fill the first data-source, "seablue.yaml", with a verbatim: --- titular-line: Welcome to the Pavement's Song subpar-title: Where All Roads Come with Rain discus-throw: > We've thrown the caution's wind to tumble through the tenements of dream that wash the strewn and savorless possession to the shores obsession stores-- with salutations from the Rand. We're grasslands on the tumble-down; who stumble up to pistous luck and steam, though clouds are limned with sun and sheen and hath their silver wetness glimmer-shed. copied-years: [ @1939, @1946, @all-time-to-come ] copied-by: "The Great American Refuse" more-about-the-pavements: http://www.google.com/search?q=slanted and enchanted less-about-what-we-meant: http://home.att.net/~TennysonPoetry/ls.htm We launch the file with three dashes, as a matter of YAML convention; however, there are no YAML inhibitions [or few enough] and so this convention's a matter of taste. You needn't use the dashes, at all, if you like the taste of that better... We decide the file will be named "seablue.yaml", arbitrarily. You, however, are the ultimate arbiter of what to name your files; they needn't have the extension ".yaml", nor be named after the shade of the sea. We decide--essentially--nothing of what you'll do. We but provide some mechanism for implementing sites; we have some methods to read, and write, and otherwise manipulate YAML, and HTML forms, and HTML bread-crumbs, and other simple beast. To be the scourge of pride and feckless-fetid ego, we're little else than that. You decide what, if any, of this you'll use. We permit [nay; prescribe] you do what you like. Like to form your data-files with XML, instead? Problem? No! Go find the module for parsing your data-files with XML--say, the CPAN XML::Simple Perl fun-module--install it on a server-side account, and load away, you fiend. We expect, however, that as it is innately legible and as we do innately read or write its words, that you will use YAML. Here, then, is the seablue script converting this YAML to HTML. It's something simple, as simply: #!/usr/bin/env perl # The above shebang declares this "seablue.pl" script to be a Perl script but # may or may not be needed-- though it certainly does no kidney-punching harm. # Declare our package to be the same as "index.cgi"'s # ------- --- - # This declaration permits us access to "index.cgi"'s variables and functions, # without which we would need preface a "CGI::Madarch::" to all such accesses. # package CGI::Madarch; # Quietly, blankly ignore all requests for an RSS feed of this page if ($furl{tone} ne "rss") { # Parse our static YAML data into a Perl hash my $pill = parse_yaml "$nave_path/seablue.yaml"; # Print the header of this page, and a link elsewhere print_lead $pill{titular-line}, $pill{more-about-the-pavement}; # Print its sub-header indented, a bit print_lead " $pill{subpar-title}", $pill{less-about-the-pavement}; # Print the pain-bringing poetry as a double-quoted qq{...} string print qq{"$pill{discus-throw}" --U.B.Forgotten, 2004 }; # Print our copy-lefts print qq{$pill{copied-by} is @{$pill{copied-years}}}; # Parse and print the other YAML data-file, sometime: "saffron.yaml" # . # . # . } # Report the success of our printing, to avoid the death of our caller 1; So, what we have is a cleft / clean-separation between hard content [i.e., YAML] and soft [i.e., HTML], and the Perl scripts converting hard to soft. The values flow like this: you : go:to : v http://bcurry.gomen.org/',.sea;html : which:redirects you to : v /www/arpa/ag/b/bcurry/arwest.cgi/',.sea;html : which:analyzes the URL with which:it was called to discover which:content-type / flavour it should generate which:selects, opens, reads, and hence evaluates : v /www/arpa/ag/b/bcurry/arwest.html.cgi : which:prepares Perl to generate HTML-specific content, and which:searches for the script which:performs the actual generation for this page : v /www/arpa/ag/b/bcurry/index.html.cgi : which:does not exist which:thus falls through to : v /www/arpa/ag/b/bcurry/index.cgi : which:selectively opens, reads, and does stuff with : :......................................, : : your:page-specific YAML data and:site-wide style-sheet : : ...........:.........., v first: :then http://bcurry.gomen.org/index.css : : : v v .:. seablue.yaml saffron.yaml : : : : `..........:.........." : : : which:we convert into HTML which:stylizes the HTML : : `..........:..........................." : which:we send to : you And that, my purist pundits, is simply that. =head1 UN-FURLING ...? We tell a yarn, in brief, of a host-name "empty.of.water" and path under that host--"/unlike/the/yore/of/Paire-na-lee". The URL that usually paths to it is: http://empty.of.water/unlike/the/yore/of/Paire-na-lee We recognize the form; and it tires us. Two friendlier URLs to it might read: http://empty.of.water/laid`he:unlike'the'yore'of'Paire-na-lee http://empty.of.water/`.oO0o.,unlike~the~yore~of~Paire-na-lee`~-. Which, we think you may agree, are certainly a lively knot of syntax. Relax! Tis easier than walking hemispheres; tis pretty easy, actually. To effect the latter of the two, above, we ask you simply: [one] set "our $path_separator = q{~};" [two] set "our $furl_destroyer = qr{\`\.oO0Oo\.\,|\`\~\-\.};" Which, we think, makes a fine excuse for brushing up on mucky Perl regular-exs. We think you'll find "man perlre" a pleasant afternoon stroll up mud-pie alley. Well! Best of luck, then. =head1 ADDING ...? We recommend you add a ".index" file [with permissions as above] for every path for which you would like a page generated. This may or not include the top-path in which your "index.cgi" resides. Please see INDEXING FILES, below. We recommend you further add a "${section_name}.pl" file for every ${section_name} present in that generated page. These scripts generate the HTML [or RSS] for individual page sections. Go see SHOWING SECTIONS, below. We recommend you [lastly] have "${section_name}.yaml" files for every ${section_name} we're producing, as above. These YAML files will be converted into HTML [or RSS] by their scripts... Go see STORING SECTIONS, below! We permit, of course, that you add whatever files you like; for the most part, we ignore all files not expressly listed in each page's ".index". =cut # We supplant the CGI module, a good deal of the YAML module, and several other # wastrel, ineffably boring moduli. We're cheeky--and fun! =head2 We recognize, in succinct close, that some servers situate your website's server-side path on a different filesystem that is situated your user's server-side path of UNIX shell- or FTP- account logins. For their part, this insulates a hack of its website-filesystem from the remainder of this system; for your part, however, it's a bit of annoyance. We cannot locate the "$HOME/.perl/lib" path, here, since a CGI script recieves no user-local environment variables until after its compilation. Sadly, Perl evaluates all BEGIN blocks during of a script's compilation "$HOME" path variable, here. We provide several methods for moving amongst the shadows of FURLs, FURIs, and the hashes through which we use them. These are: our $list_script = "the name of the script listing a path's files and paths"; our $surf_script = "the name of the script showing a path's file-content"; # :. --------------------------------------------- ------- ----- - :. # We do not specify synonym mappings in this hash, since they are inferable. # We do not specify such mappings as, for example: # # htm => 'text/html', # html => 'text/html', # # We specify the latter, and not the former, as you may note below. # # Add inferred flavour-names to our %mime_type hash # :. --------------------------------------------- ------- ----- - :. # We infer, as follows: for each four-letter flavour-name, we cut that name # to three. If we've no mapping for this cut flavour-name, we add a mapping. # =pod my $long_flav_name; my $bare_flav_name; foreach $long_flav_name (keys %mime_type) { $bare_flav_name = substr($long_flav_name, 0, 3); if (not exists $mime_type{$bare_flav_name}) { $mime_type{$bare_flav_name} = $mime_type{$long_flav_name}; } } We advise you install Madarch into the server-side path whose file- and path- content you'd like us to manage, and generate browseable content from. of your public HTML path, whose content you'd like us to manage. . server-side HTML path, whose contents you named "arwest", in the path of your choosing. You the following Madarch files, with following permissions: > ls -al ~myself/public_html/arwest -rwxr-xr-x 1 myself nobody 60479 Sep 20 10:27 arwest.cgi -rw-r--r-- 1 myself nobody 63500 Sep 19 11:55 arwest.html.cgi -rw-r--r-- 1 myself nobody 63500 Sep 19 11:55 arwest.html.gwy+dd.cgi -rw-r--r-- 1 myself nobody 63500 Sep 19 11:55 arwest.html.gwy+dd.css -rw-r--r-- 1 myself nobody 63500 Sep 19 11:55 arwest.html.mosaik.cgi -rw-r--r-- 1 myself nobody 63500 Sep 19 11:55 arwest.html.mosaik.css -rw-r--r-- 1 myself nobody 63297 Sep 19 12:46 arwest.path.cgi -rw-r--r-- 1 myself nobody 63297 Sep 19 12:46 arwest.rss.cgi We permit you, if you like the longest road, on straying from this structure. We advise you, initially, at least, to not stray too far, but install as advised above and revise as, gradually, you become accustomed to this. into a path named "arwest", residing one immediate level above your top-level We permit you install Madarch into the path[s] of your preference. We require no database, you see. We do, however, require the following initial file-structure: [assuming you install Madarch into the html-directory of your home-directory]: We expect your file-sizes and -mtimes to differ from the above--and that your username is not "myself", but yourself. The permissions should resemble these, however; as should the group, since "nobody" else should have group permission on your web-site. We write files in-place by writing to a named intermediary temporary file, then re-naming that file to the ouput file-name--and thence the need for File::Temp. We do not write temporaries through POSIX::tmpfile, since that subroutine-- though POSIX--subjects your script to a flury of not-so-slight race conditions. We import several moduli on the condition that we do so only when necessary. We optionalize their importation, since their installation is not standard across all Perl distributions. You must install these moduli independently, through CPAN presumably, when you wish us to use them. These are: # Retrieve the sort of server-software we're working on sink = elect_best_sink(); # Retrieve the sort of archival-format we're writing data with serf = elect_best_serf(); =head1 We commend you for reading this far; pilgrim, you must be weary. We recommend you press on. Even entangling paragraphs have their periodical end. --haven't they? =head1 CRITIQUING CONTENT We have developed a fairly dynamic site-system in Madarch, here; hereafter, external clients may--and, with any popular luck, will--submit content to the site. As it's they submitting the content, and as submissions are largely tex- tual, you'll have a drivel of a time censoring it. We don't encourage that, naturally. Rather, we collect all recent changes into a site-wide change-log-- available on-line, publicly-- with which you manually, occasionally scour your site's change for decrepit content. We write, by default, to $news_file, which we default to "$nave_path/site/news". If you have no such path or file, we build them as we need them--as your users submit their suspect content, filthy lies, and ill changes. =head1 INTROCLUSION We recommend you read the site ENDTRODUCTION-- down below. # :: #\:::::::::::::::::::::::::::::: the :::::::::::::::::::::::::::::::::: # : : =head1 =head2 build_furl_from_hash We fashion a FURL string from the named parakindrs passed to this subroutine. =head3 synopsis my $spawn_of_furl = build_furl_from_hash( path => "/www/d/denied/of/this/life/", file => "is_what_you.a", flav => 'reto' zone => 'be' ); =head3 details We build the FURL string from parakindrs you pass, whose names correspond to the names we accord the various portions of a FURL hash, as defined through the %furl hash in IMPORTING VARIABLES, above, and whose values correspond to-- quite naturally--the values that you wish to give these parts. We default any portions of the FURL, which you leave unpassed, to the presently requested FURL. Through the virtue of its pure simplicity, this far effectively duplicates the work which cookies, stores, and other rigorously lame mechanisms pursue. If, as astute example, the user insists we zone through Japanese by pursuing a URL of: http://the.protons.within/-~+my.Home;japan and you generate some URL off the homepage by calling a: print q{Toukyou}; then we generate this URL-tag: Toukyou which, when that user insists on clicking that generated URL, persists that user's language selection across the page-change--without, as you may agree, the stale, ignoble subjugations of a cookie. =head2 fetch_mime_type We fetch the MIME-type corresponding to some flavour-name or file-extension. =head3 synopsis # Prints: sensory/xtc print fetch_mime_type 'pills'; =head3 details We sieze one argument: the flavour-name or file-extension to correspond for... We allow you pass us either; the two are fairly synonymous, for most intent. We return "undef", for flavour-names or file-extensions for whom we have no MIME-type mapping. cut sub fetch_mime_type($) { return %mime_type{shift()}; } =head2 index_archive =details We say, "roughly," as we do allow some curious, nice inconsistencies. We operate upon files whose names begin in any number of numbers followed by any number of non-letter-or-number punctuation a bit differently than the rest. We operate upon these files as were that start number an ordering identifier, and not a part of the file-name to which it belongs; you use this identifier to "thrust" or "shove" a file above or beneath its neighbors, as a means of subverting the strict lexical ordering that it otherwise should fall subject to. As an ordering identifier is of no relevance to its name, aside from ordering it, we separate that identifier from the... =head2 index_files_by_time We index the files in a path according to their last-modified times [mtimes]. =head3 details We sort descendingly: descending from the most-recently modified file to least. We sort descendingly, since this most closely resembles the date-sorting of diary entries. We accept two arguments, as in index_files_by_name, above. =head2 infer_newest_files_from_paths We fetch the newest files from some path, whose names match some regex-pattern. =head3 synopsis print fetch_newest_files("/www/c/corwin/match/all")[most_recent] . fetch_newest_files("/www/c/corwin/match/some", qr/^.*\.txt$/)[least_recent] . fetch_newest_files("/www/c/corwin/match/one", qr{^the.txt$}); =head3 details We search this path recursively, to infinite depth, until we find such a file-- or cannot. The path-recursion permits you structure your files through a path- hierarchy, We accept the following arguments: [one] the mandatory first argument, the path to index [two] the optional second argument, a quoted regex matching path-names We accept qr-style regular expressions, as in qr/*/, qr~*\.a$~, or qr~^hale$~. When unpassed, we assume a default catch-all: qr/*/. =head3 matches We search this path recursively, like this: [one] when we find at least one file-match from the passed path, we return all matched files, sorted with most-recent last-modified time [mtime] [two] when we find no match, we index all the paths in the path by name, recursing into the path whose name falls last in lexicographic order We should like you to notice, in particular, the second step of path-recursion. We do not perform a breadth-first search; ours, rather, is a quicker--though perchance inaccurate--depth-first search. When recursing, we examine all paths in the present path, select the likeliest candidate, and recurse in. And having recursed in, we never backtrack out. if (not defined $path{order}{ascending} && not defined $path{order}{descending}) { if ($path{order}{by_time}) {$path{order}{descending} = true;} else {$path{order}{ascending} = true;} } # If this string signifies a file or path, hack its absolute name-part away if (-e $string) { $string = split_name_from_file($string); } # :: #\:::::::::::::::::::::::::::::: the PARSING :::::::::::::::::::::::::::::::::: # : : =head1 PARSING SCRIPT-NAMES =head2 build_code_hash_from_code We build the hash corresponding to some absolute or relative script-name. =head3 details We sieze two arguments: the script-name and a reference into the hash. We fill this hash with: cut sub build_code_hash_from_code($$) { my $string = shift; my $hash = shift; # Parse the code-string into its hash build_hash_from_string_with_syntax($string, $hash, \%code_syntax); } =head2 parse_code_from_code_hash We parse a script-name-hash into an absolute script-name. =head3 details We sieze one argument: this hash, with contents as above. cut sub parse_code_from_code_hash($) { # Default all un-passed parts of the hash you pass with our present script my %code = (%this_furl, %code_file, @_); # Parse the script-hash into its string return parse_string_from_hash_with_syntax(\%code, \%code_syntax); } # :: #\:::::::::::::::::::::::::::::: the PARSING :::::::::::::::::::::::::::::::::: # : : =head1 PARSING NAMES We parse scalar name-strings to and fro hashes of their split-up name-parts. We allow you adjust the parsing--though with a splash of caution, we'd hope. These are: =head2 build_name_hash_from_name We build the hash corresponding to some absolute or relative path- or file-name. =head3 synopsis my %name; # Produces: (prenomen => "pieces", cognomen => "of dust", cardinal => 1261) build_hash_from_name "/cold/01261;pieces:of_dust", \%name; # Produces: (prenomen => "pieces", cognomen => "", cardinal => 0) build_hash_from_name "/cold/pieces.today", \%name; =head3 details We sieze two arguments: the path- or file-name and a reference into a hash. cut sub build_name_hash_from_name($$) { my $string = shift; my $hash = shift; # Supplant whitespace-indicators with actual whitespace $string =~ s~$name_syntax{spacer}~ ~o; # Strip the name of a trailing slash, if present $string =~ s~\/$~~o; # Parse the name-hash into its string parse_hash_from_string_with_syntax($string, $hash, \%name_syntax); } =head2 parse_path_from_furl We parse the path-part of a FURL-hash into a server-side absolute path-name. =head3 details We are a loss-less subroutine: we lose the non-path hash-parts. We drift; they low. cut sub parse_path_from_furl_hash { my $furl = shift; my $path = $$furl{path}; # Lead it with our $base path, if present return ($$furl{base} ? $$furl{base} . '/' : '') . $path; } # :: #\:::::::::::::::::::::::::::::: the PARSING :::::::::::::::::::::::::::::::::: # : : =head1 PARSING SPECIALLY cut sub ready_syntax() { $syntax{furl}{hasher} = \%ready_furl_hash; $syntax{furl}{limner} = \%ready_furl_lace; $syntax{code}{hasher} = \%ready_code_hash; } sub ready_furl_hash($) { my $furl = shift; %$furl = (%this_furl, %$furl); # Examine the path-part of this hash for Unix path-separators if ($$furl{path} =~ m~\/~o) { # Strip it of leading $base path, if present $$furl{path} =~ s~^$$furl{base}~~o; # Strip it of trailing slashes $$furl{path} =~ s~\/$~~o; # Supplant intervening slashes for our FURL separator $$furl{path} =~ s~\/~$$furl{syntax}{wester}{path}~o; } my $string = shift; my $hash = shift; # Parse the FURL-string into its hash build_hash_from_string_with_syntax($string, $hash, \%furl_syntax); # Trade all FURL-names for hash-names alter_hash_with_mapping($hash, \%name_to_part); # Place our FURL-defaults on the hash, when needed apply_furl_defaults($hash); } =head2 probe_path cut sub probe_path($) { # Open the contents of this path for sift and searching my $path = new DirHandle(shift); not defined $path && croak "We cannot open $path for reading, since [$!].\n"; return $path->read(); } =head2 called We attempt to call the subroutine whose name and parakindrs you pass us. =head3 synopsis Prints: true print (called( 'called', 'called') ? 'true' : 'false'); Prints: true print (called('CGI::Madarch::called', 'called') ? 'true' : 'false'); =head3 details We seize two arguments: [one] the name of the subroutine to call [two] the list of arguments with which to call it We allow you prefix this subroutine with its package-name, as in callable above. cut sub called { my $call_name = shift; my $call = callable($call_name); # If legal, we call it with our passed arguments if ($call) { $call->(@_); } return $call; } =cut